(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))))