Initial

.gitignore

@@ -0,0 +1,2 @@
+*.fasl
+.gnupg/

assboard.asd

@@ -0,0 +1,32 @@
+#|
+  Author: Innokenty Enikeev (me@enikesha.net)
+|#
+
+(in-package :cl-user)
+(defpackage assboard-asd
+  (:use :cl :asdf))
+(in-package :assboard-asd)
+
+(defsystem assboard
+  :version "0.1"
+  :author "Innokenty Enikeev"
+  :license ""
+  :depends-on (
+               :cl-postgres+local-time
+               :local-time
+               :postmodern
+               :drakma
+               :yason
+               :cl-who
+               :restas
+               :cl-date-time-parser
+               :log4cl)
+  :components ((:file "utils")
+               (:file "gpg" :depends-on ("utils"))
+               (:file "asswot" :depends-on ("utils"))
+               (:file "data" :depends-on ("utils"))
+               (:file "web" :depends-on ("utils"
+                                         "data"
+                                         "gpg"
+                                         "asswot")))
+  :description "assWoT-based job board")

data.lisp

@@ -0,0 +1,73 @@
+(in-package :cl-user)
+
+(defpackage #:assboard.data
+  (:nicknames :data)
+  (:use :cl :postmodern))
+
+(in-package :assboard.data)
+
+;; Install local-time timestamp reader
+(local-time:set-local-time-cl-postgres-readers)
+
+(defvar *db-host* "127.0.0.1" "database host name")
+(defvar *db-user* "assboard" "database user")
+(defvar *db-pass* "assboard" "database pass")
+(defvar *db-name* "assboard" "database name")
+
+(defun start-db-connection (&optional (database *db-name*)
+                              (database-user *db-user*)
+                              (database-password *db-pass*)
+                              (host *db-host*))
+  "Start the database connection. Reconnects if there is an unconnected
+database in *database* which matches the database parameter in the function, it will
+be reconnected. Returns boolean on whether the global *database* is now connected."
+  (unless *database*
+    (setf *database*
+          (postmodern:connect database database-user database-password
+                              host :pooled-p t))))
+
+(defclass posting ()
+  ((id :col-type serial :reader posting-id)
+   (author :col-type string :accessor posting-author :initarg :author)
+   (status :col-type string :accessor posting-status :initarg :status :col-default "open")
+   (title :col-type string :accessor posting-title :initarg :title)
+   (body :col-type string :accessor posting-body :initarg :body)
+   (maintainer :col-type (or string db-null) :accessor posting-maintainer)
+   (created-on :col-type timestamptz :reader posting-created-on :col-default (:now))
+   (updated-on :col-type timestamptz :accessor posting-updated-on :col-default (:now)))
+  (:metaclass dao-class)
+  (:keys id))
+
+(deftable posting
+  (!dao-def)
+  (!index 'status)
+  (!index 'author)
+  (!index 'maintainer))
+
+(defclass raw ()
+  ((id :col-type serial :reader raw-id)
+   (crearsigned :col-type string :initarg :clearsigned)
+   (fingerprint :col-type string :reader raw-fingerprint :initarg :fingerprint)
+   (timestamp :col-type timestamptz :initarg :timestamp)
+   (created-on :col-type timestamptz :col-default (:now))
+   (remote-ip :col-type (or string db-null) :initform (ignore-errors (hunchentoot:real-remote-addr)))
+   (remote-ua :col-type (or string db-null) :initform (ignore-errors (hunchentoot:user-agent))))
+  (:metaclass dao-class)
+  (:keys id))
+
+(deftable raw
+  (!dao-def))
+
+(defclass posting-edition ()
+  ((id :col-type serial :reader posting-edition-id)
+   (posting-id :col-type integer :initarg :posting-id)
+   (title :col-type string :initarg :title)
+   (body :col-type string :initarg :body)
+   (raw-id :col-type integer :initarg :raw-id))
+  (:metaclass dao-class)
+  (:keys id))
+
+(deftable posting-edition
+  (!dao-def)
+  (!foreign 'posting :posting-id :primary-key)
+  (!foreign 'raw :raw-id :primary-key))

engine.lisp

@@ -0,0 +1,94 @@
+(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))))

pgp.lisp

@@ -0,0 +1,60 @@
+(in-package :cl-user)
+(defpackage #:assboard.pgp
+  (:use :cl :assboard.utils)
+  (:export #:list-fingerprints
+           #:recv-key
+           #:delete-key
+           #:verify))
+(in-package #:assboard.pgp)
+
+(defvar *gpg-program* "/usr/bin/gpg" "gpg command")
+(defvar *gpg-homedir* (make-pathname :name ".gnupg"
+                                     :defaults +project-path+)
+  "gpg homedir (key storage)")
+(defvar *gpg-keyserver* "pgpkeys.mit.edu" "Keyserver to use")
+
+(defun extract-fingerprint (line)
+  (let* ((last (1- (length line)))
+         (first (1+ (position #\: line :from-end t :end last))))
+    (subseq line first last)))
+
+(defun run-gpg (args &key input)
+  (with-output-to-string (s)
+    (sb-ext:run-program *gnupg-program*
+                        (append
+                         (list "--homedir" (namestring *gnupg-homedir*)
+                               "--status-fd" "1"
+                               "--logger-fd" "2"
+                               "--no-tty")
+                         args)
+                        :input input
+                        :output s
+                        :error nil)))
+
+(defun list-fingerprints ()
+  (loop-lines (run-gpg '("--with-colons"
+                         "--with-fingerprint"
+                         "--list-keys"))
+     if (starts-with "fpr:" line)
+     collect (extract-fingerprint line)))
+
+(defun recv-key (fingerprint)
+  (loop-lines (run-gpg (list "--keyserver" *gpg-keyserver*
+                             "--recv-keys" fingerprint))
+     if (starts-with "[GNUPG:] IMPORT_OK" line)
+     do (return t)))
+
+(defun delete-key (fingerprint)
+  (not (loop-lines (run-gpg (list "--batch"
+                                  "--delete-keys" fingerprint))
+          if (starts-with "[GNUPG:] DELETE_PROBLEM" line)
+          do (return t))))
+
+(defun verify (clearsigned)
+  (with-input-from-string (input clearsigned)
+    (loop-lines (run-gpg '("--verify") :input input)
+       if (starts-with "[GNUPG:] VALIDSIG" line)
+       do (return (values (subseq line (1+ (position #\Space line :from-end t)))
+                          (parse-integer line
+                                         :start 70
+                                         :end (position #\Space line :start 70)))))))

utils.lisp

@@ -0,0 +1,35 @@
+(in-package :cl-user)
+
+(defpackage #:assboard.utils
+  (:use :cl)
+  (:export
+   #:+project-path+
+   #:starts-with
+   #:loop-lines))
+(in-package :assboard.utils)
+
+(defmacro aget (key alist)
+  `(cdr (assoc ,key ,alist :test #'equal)))
+
+(defmethod yason:encode ((symbol symbol) &optional (stream *standard-output*))
+  (yason:encode (s-sql:to-sql-name symbol) stream))
+
+(defparameter +project-path+
+  (asdf:component-pathname (asdf:find-system '#:assboard)))
+
+(defun starts-with (with-what str)
+  (let ((len (min (length str) (length with-what))))
+    (equal (subseq str 0 len)
+           with-what)))
+
+(defun vec-to-hash (vec key-fn)
+  (loop for val across vec
+     with result = (make-hash-table :test #'equal :size (length vec))
+     do (setf (gethash (funcall key-fn val) result) val)
+     finally (return result)))
+
+(defmacro loop-lines (s &body body)
+  `(with-input-from-string (stream ,s)
+     (loop for line = (read-line stream nil :eof nil)
+        until (eq line :eof)
+          ,@body)))

web.lisp

@@ -0,0 +1,111 @@
+(in-package :cl-user)
+
+(restas:define-module #:assboard.web
+  (:use :cl :hunchentoot :assboard.utils))
+
+(in-package #:assboard.web)
+
+;; Parameters
+(setf (who:html-mode) :html5)
+
+
+(defclass renderer () ())
+(restas::register-pkgmodule-traits
+ 'assboard.web
+ :render-method (lambda () (make-instance 'assboard.web::renderer)))
+
+;; Rendering
+(defgeneric finalize-page (data)
+  (:documentation "Final rendering step"))
+(defgeneric render-route-data (route data)
+  (:documentation "Process route-specific data"))
+
+(defmethod finalize-page ((data list))
+  (who:with-html-output-to-string (out nil :prologue t)
+    (:html
+     (:head
+      (:meta :charset "utf-8")
+      (:meta :http-equiv "X-UA-Compatible" :content "IE=edge")
+      (:meta :name "viewport" :content "width=device-width, initial-scale=1")
+      (:title (who:str (getf data :title)))
+      (:link :rel "stylesheet" :href (restas:genurl 'static/css :file "styles.css")))
+     (:body
+      (who:str (getf data :menu))
+      (who:str (getf data :content))))))
+
+(defmethod render-route-data (route data)
+  (list*
+   :title (getf data :title "AssBoard")
+   data))
+
+(defmethod restas:render-object ((designer renderer) (object list))
+  (let ((full-data (render-route-data (restas:route-symbol restas:*route*)
+                                      object)))
+    (finalize-page full-data)))
+
+(defun posts-list (posts)
+  (who:with-html-output-to-string (out)
+    (:ul
+     (loop for post in posts
+        :do (who:htm
+             (:li
+              (:a :href (restas:genurl 'posting :id (data::posting-id post))
+                  (who:str (data::posting-title post)))
+              " by "
+              (:a :href (restas:genurl 'author
+                                       :author (data::posting-author post))
+                  (who:str (data::posting-author post)))))))))
+
+(defmethod render-route-data ((route (eql 'index)) (posts list))
+  (list
+   :title "AssBoard"
+   :content
+   (who:with-html-output-to-string (out)
+     (:h1 "AssBoard open postings")
+     (who:str (posts-list posts)))))
+
+(restas:define-route index ("")
+  (pomo:query-dao
+   'data::posting
+   (:select 'id 'author 'status 'title 'maintainer 'created-on
+            :from 'posting)))
+
+(defmethod restas:render-object ((designer renderer) (object data::posting))
+  (finalize-page
+   (list
+    :title (format nil "~A by ~A @ AssBoard"
+                   (data::posting-title object)
+                   (data::posting-author object))
+    :content
+    (who:with-html-output-to-string (out)
+      (:h1 (who:str (data::posting-title object)))
+      (:p (who:str (data::posting-body object)))))))
+
+(restas:define-route posting ("posting/:id/")
+  (let ((post (pomo:get-dao 'data::posting id)))
+    (if post post
+        hunchentoot:+HTTP-NOT-FOUND+)))
+
+(defmethod render-route-data ((route (eql 'author)) (data list))
+  (list
+   :title (format nil "~A's postings @ AssBoard" (getf data :author))
+   :content
+   (who:with-html-output-to-string (out)
+     (:h1 (who:str (getf data :author)) "'s postings")
+     (who:str (posts-list (getf data :posts))))))
+
+(restas:define-route author ("author/:author/")
+  (let ((posts (pomo:query-dao
+                'data::posting
+                (:select 'id 'author 'status 'title 'maintainer 'created-on
+                         :from 'posting
+                         :where (:= 'author author)))))
+    (if posts
+        (list :author author :posts posts)
+        hunchentoot:+HTTP-NOT-FOUND+)))
+
+(restas:define-route static/css ("css/:file" :content-type "text/css")
+  (let ((css-path (merge-pathnames "css/" +project-path+)))
+    (merge-pathnames file css-path)))
+
+

wot.lisp

@@ -0,0 +1,25 @@
+(in-package :cl-user)
+(defpackage #:assboard.wot
+  (:use :cl :assboard.utils)
+  (:export #:get-trustlist
+           #:*trustlist-cache*))
+(in-package #:assboard.wot)
+
+(defparameter +trustlist-url+ "http://files.bitcoin-assets.com/wot/trustlist.txt" "Precompiled list of L1/L2 assbot's trustees")
+
+(defvar *trustlist-cache* nil "Latest fetched trustlist")
+
+(defun get-fingerprint-and-username (line)
+  (cons
+   (subseq line 0 40)
+   (subseq line (1+ (position #\Space line :start 41)))))
+
+(defun get-trustlist ()
+  (let ((stream
+         (drakma:http-request +trustlist-url+
+                              :external-format-in :utf-8
+                              :want-stream t)))
+    (setf *trustlist-cache*
+          (loop for line = (read-line stream nil)
+             while line
+             collect (get-fingerprint-and-username line)))))