(in-package :cl-user) (defpackage #:assboard.engine (:use :cl :assboard.utils) (:export #:command-error #:process-command #:format-new-posting)) (in-package #:assboard.engine) (defvar *posting-hash-salt* "[TEST]" "Key for HMAC for new post to get id-hash") (defvar *posting-hash-length* 8 "id-hash length") (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 get-post-hash (body author) "Get part of body+author HMAC to use id-hash." (let ((hmac (crypto:make-hmac (trivial-utf-8:string-to-utf-8-bytes *posting-hash-salt*) :sha512))) (crypto:update-hmac hmac (trivial-utf-8:string-to-utf-8-bytes (concatenate 'string body author))) (subseq (cl-base64:usb8-array-to-base64-string (crypto:hmac-digest hmac) :uri t) 0 *posting-hash-length*))) (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))) (hash (get-post-hash body author)) (posting (pomo:make-dao 'data::posting :author author :hash hash :title title :body body)) (posting-edition (pomo:make-dao 'data::posting-edition :posting-id (data::posting-id posting) :title title :body body :raw-id (data::raw-id raw)))) (values posting posting-edition))) (defun format-new-posting (title body) (format nil "NEW POST: ~A~%~%~A" title body)) (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) ;; Remove possible CRLF (setq clearsigned (replace-all clearsigned '(#\Return #\Linefeed) (string #\Linefeed))) ;; 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 'data::raw :clearsigned clearsigned :fingerprint fgp :timestamp timestamp))) (funcall handler command raw))))) (type-error (e) (log:error e) (error 'not-valid-command-error))))