Functional HTTP signatures

… using extenal binary of OpenSSL. Not ideal, but
it works for now!

src/activitypub-servist.lisp

@@ -1,4 +1,4 @@
-;;; Copyright © 2023 Jaidyn Levesque <jadedctrl@posteo.at>
+;;; Copyright © 2023-2024 Jaidyn Levesque <jadedctrl@posteo.at>
 ;;;
 ;;; This program is free software: you can redistribute it and/or
 ;;; modify it under the terms of the GNU Affero General Public License
@@ -22,7 +22,7 @@
 
 (defun users ()
   "List of the server's usernames."
-  '("servisto"))
+  '("servistchjo"))
 
 
 (defun userhosts ()
@@ -38,6 +38,10 @@
     (".well-known/host-meta" . http-host-meta)))
 
 
+(defvar *privkey* (alexandria:read-file-into-string #p"enc/privkey.pem"))
+(defvar *pubkey* (alexandria:read-file-into-string #p"enc/pubkey.pem"))
+
+
 
 ;; ————————————————————————————————————————
 ;; Host-info response
@@ -126,7 +130,7 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
 (defun http-user-dir (env path-items params)
   (let ((user (car path-items)))
     ;; In case of request for the user's actor.
-    (if (member user (users) :test 'string=)
+    (if (member user (users) :test 'equal)
         `(200 (:content-type "application/activity+json")
               (,(user-actor env user))))))
 
@@ -139,12 +143,15 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
       (yason:encode-alist
        `(("@context" . ("https://www.w3.org/ns/activitystreams"
                         "https://litepub.social/litepub/context.jsonld"))
+         ("endpoints" . ,(alexandria:plist-hash-table (list "sharedInbox" "https://etc.xwx.moe/inbox")))
+         ("url" . ,user-root)
          ("id" . ,user-root)
          ("type" . "Person")
          ("preferredUsername" . ,username)
          ("name" . "Servistiĉo")
-         ("inbox" . ,(str:concat user-root "/inbox.json"))
+         ("inbox" . ,(str:concat user-root "/inbox"))
-         ("outbox" . ,(str:concat user-root  "/outbox.json"))
+         ("outbox" . ,(str:concat user-root  "/outbox"))
+         ("discoverable" . t)
          ("summary" . "Mi estas simpla roboto, kiu montras ke iomete ekfunkcias activitypub-servist.
 … ĉu mi rajtas demeti la servistinan kostumon, nun?
 Mi ne estas knabino!!")
@@ -152,7 +159,7 @@ Mi ne estas knabino!!")
           . ,(alexandria:plist-hash-table
               (list
                "type" "Image"
-               "url" "https://xwx.moe/etc/servisticho-profilbildo.png")))
+               "url" "https://xwx.moe/etc/servisticho-profilbildo.jpg")))
          ("image"
           . ,(alexandria:plist-hash-table
               (list
@@ -196,27 +203,29 @@ Mi ne estas knabino!!")
     (:hour 2) #\: (:min 2) #\: (:sec 2) " " :timezone))
 
 
-(defun note-headers (inbox from to text)
+(defun note-headers (inbox from to json)
-  (let* ((json (note-json from to text))
+  (let* ((inbox-uri (quri:uri inbox))
-         (inbox-uri (quri:uri inbox))
          (digest-header (str:concat "SHA-256=" (string-sha256sum json)))
          (date-header
            (let ((local-time:*default-timezone* local-time:+gmt-zone+))
              (local-time:format-timestring
               nil (local-time:now)
               :format +date-header-datetime-format+)))
-         (signed-headers (str:unlines
+         (signed-headers
-                          (list
+           (concatenate
-                           (str:concat "(request target): post " (quri:uri-path inbox-uri))
+            'string
-                           (str:concat "host: " (quri:uri-host inbox-uri))
+            (format nil "(request-target): post ~A~%" (quri:uri-path inbox-uri))
-                           (str:concat "date: " date-header)
+            (format nil "host: ~A~%" (quri:uri-host inbox-uri))
-                           (str:concat "digest: " digest-header))))
+            (format nil "date: ~A~%" date-header)
+            (format nil "digest: ~A" digest-header)))
          (signature (base64:usb8-array-to-base64-string
                      (ironclad:sign-message (openssl-shell-import-key-pair *privkey*)
-                                            (string-to-ub8-vector signed-headers))))
+                                            (string-to-ub8-vector
+                                             (string-sha256sum signed-headers)))))
+         (signature (openssl-shell-sign-string *privkey* signed-headers))
          (signature-header (str:concat "keyId=\"" from "#main-key\","
-                                       "headers=\"(request-target) host date digest\","
                                        "algorithm=\"rsa-sha256\","
+                                       "headers=\"(request-target) host date digest\","
                                        "signature=\"" signature "\"")))
     `(("Date" . ,date-header)
       ("Digest" . ,digest-header)
@@ -228,8 +237,10 @@ Mi ne estas knabino!!")
 
 
 (defun send-note (inbox from to text)
-  (dexador:post inbox :content (note-json from to text)
+  (let* ((json (note-json from to text))
-                      :headers (note-headers inbox from to text)))
+         (headers (note-headers inbox from to json)))
+    (dexador:post inbox :content json
+                        :headers headers)))
 
 
 
@@ -249,7 +260,7 @@ Mi ne estas knabino!!")
 ;; ————————————————————————————————————————
 (defun server (env)
   "Returns the response data for Clack, given the request data `env`."
-  (setq *logs* (append *logs* (list env)))
+  (setq *logs* (append *logs* (list env (babel:octets-to-string (alexandria:read-stream-content-into-byte-vector (getf env :raw-body))))))
   (let* ((path (pathname-sans-parameters (getf env :request-uri)))
          (params (pathname-parameters (getf env :request-uri)))
          (response-function
@@ -264,7 +275,7 @@ Mi ne estas knabino!!")
         (funcall 'http-404 env path-sans-response-root params))))
 
 
-(defun start-server (&optional (config '(:domain "etc.xwx.moe")))
+(defun start-server (&optional (config '(:domain "localhost" :port 8080)))
   "Start the server."
   (clack:clackup (lambda (env)
                    (server (append env config)))
@@ -457,3 +468,16 @@ returned values: An Ironclad private key, and an Ironclad public key."
              :rsa
              :n (getf key-values :n)
              :e (getf key-values :e)))))
+
+
+(defun openssl-shell-sign-string (private-pem-string string)
+  "Use the OpenSSL binary on the host system to RSS-SHA256 sign a STRING with a
+private key."
+  (alexandria:write-string-into-file private-pem-string #p"private.pem" :if-exists :overwrite)
+  (apply #'str:concat
+         (inferior-shell:run/lines
+          `(inferior-shell:pipe
+            (printf ,string)
+            (openssl dgst -sha256 -sign private.pem -)
+            (base64)))))
+