assboard/engine.lisp

(in-package :cl-user)
(defpackage #:assboard.engine
  (:use :cl :assboard.utils)
  (:export #:not-valid-pgp-error))
(in-package #:assboard.engine)

(defvar *command-valid-for* 600 "Seconds of validity for command timestamp")

(defun sync-keys-with-trustlist ()
  (let ((keys (assboard.pgp:list-fingerprints))
        (trustlist (assboard.wot:get-trustlist)))
    ;; Drop no-longer-trusted keys
    (loop for fgp in keys
       unless (find fgp trustlist :test #'equal :key #'car)
       do (assboard.pgp:delete-key fgp))
    ;; Download new trusted keys
    (loop for (fgp . username) in trustlist
       unless (find fgp keys :test #'equal)
       do (assboard.pgp:recv-key fgp))))

(define-condition command-error (error) ())
(define-condition not-valid-pgp-error (command-error) ())
(define-condition not-valid-command-error (command-error) ())
(define-condition not-valid-signature-error (command-error) ())
(define-condition not-valid-timestamp-error (command-error) ())

(defun cmd/new-post (cmd raw)
  (let* ((fgp (assboard.data::raw-fingerprint raw))
         (author (or (cdr (assoc fgp
                                 assboard.wot:*trustlist-cache*
                                 :test #'equal))
                     fgp))
         (title-end (position #\Newline cmd))
         (title (subseq cmd 10 title-end))
         (body (subseq cmd (+ title-end 2)))
         (posting
          (pomo:make-dao 'assboard.data::posting
                         :author author
                         :title title
                         :body body))
         (posting-edition
          (pomo:make-dao 'assboard.data::posting-edition
                         :posting-id (assboard.data::posting-id posting)
                         :title title
                         :body body
                         :raw-id (assboard.data::raw-id raw))))
    (values posting posting-edition)))

(defun cmd/close-post (cmd raw))

(defun cmd/update-post (cmd raw))

(defparameter +commands+
  (list (cons "NEW POST: " #'cmd/new-post)
        (cons "CLOSE POST: " #'cmd/close-post)
        (cons "UPDATE POST: " #'cmd/update-post)))

(defun get-command-handler (command)
  (cdr (find command +commands+ :key #'car
             :test #'(lambda (s w) (starts-with w s)))))

(defun process-command (clearsigned)
  ;; Simple vanity check
  (unless (starts-with "-----BEGIN PGP SIGNED MESSAGE-----" clearsigned)
    (error 'not-valid-pgp-error))
  (handler-case
      (let* ((start (+ 2 (search '(#\Newline #\Newline) clearsigned)))
             (end (1- (search "-----BEGIN PGP SIGNATURE-----" clearsigned)))
             (command (subseq clearsigned start end))
             (handler (get-command-handler command)))
        ;; Command check
        (unless handler
          (error 'not-valid-command-error))
        ;; Signature validation
        (multiple-value-bind (fgp unixtime)
            (assboard.pgp:verify clearsigned)
          (unless fgp
            (error 'not-valid-signature-error))
          (let ((timestamp (local-time:unix-to-timestamp unixtime)))
            ;; Timestamp check
            (unless (< (abs (local-time:timestamp-difference
                             (local-time:now)
                             timestamp))
                       *command-valid-for*)
              (error 'not-valid-timestamp-error))
            ;; All checks performed, store raw command text and process it
            (let ((raw (pomo:make-dao 'assboard.data::raw
                                      :clearsigned clearsigned
                                      :fingerprint fgp
                                      :timestamp timestamp)))
              (funcall handler command raw)))))
    (type-error (e)
      (princ e)
      (error 'not-valid-command-error))))