activitypub-servist.lisp

@@ -1,4 +1,4 @@
-;;; Copyright © 2023-2024 Jaidyn Levesque <jadedctrl@posteo.at>
+;;; Copyright © 2023 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."
-  '("servistchjo"))
+  '("servisto"))
 
 
 (defun userhosts ()
@@ -38,10 +38,6 @@
     (".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
@@ -130,7 +126,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 'equal)
+    (if (member user (users) :test 'string=)
         `(200 (:content-type "application/activity+json")
               (,(user-actor env user))))))
 
@@ -143,15 +139,12 @@ 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"))
-         ("outbox" . ,(str:concat user-root  "/outbox"))
-         ("discoverable" . t)
+         ("inbox" . ,(str:concat user-root "/inbox.json"))
+         ("outbox" . ,(str:concat user-root  "/outbox.json"))
          ("summary" . "Mi estas simpla roboto, kiu montras ke iomete ekfunkcias activitypub-servist.
 … ĉu mi rajtas demeti la servistinan kostumon, nun?
 Mi ne estas knabino!!")
@@ -159,7 +152,7 @@ Mi ne estas knabino!!")
           . ,(alexandria:plist-hash-table
               (list
                "type" "Image"
-               "url" "https://xwx.moe/etc/servisticho-profilbildo.jpg")))
+               "url" "https://xwx.moe/etc/servisticho-profilbildo.png")))
          ("image"
           . ,(alexandria:plist-hash-table
               (list
@@ -203,29 +196,27 @@ Mi ne estas knabino!!")
     (:hour 2) #\: (:min 2) #\: (:sec 2) " " :timezone))
 
 
-(defun note-headers (inbox from to json)
-  (let* ((inbox-uri (quri:uri inbox))
+(defun note-headers (inbox from to text)
+  (let* ((json (note-json from to text))
+         (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
-           (concatenate
-            'string
-            (format nil "(request-target): post ~A~%" (quri:uri-path inbox-uri))
-            (format nil "host: ~A~%" (quri:uri-host inbox-uri))
-            (format nil "date: ~A~%" date-header)
-            (format nil "digest: ~A" digest-header)))
+         (signed-headers (str:unlines
+                          (list
+                           (str:concat "(request target): post " (quri:uri-path inbox-uri))
+                           (str:concat "host: " (quri:uri-host inbox-uri))
+                           (str:concat "date: " date-header)
+                           (str:concat "digest: " digest-header))))
          (signature (base64:usb8-array-to-base64-string
                      (ironclad:sign-message (openssl-shell-import-key-pair *privkey*)
-                                            (string-to-ub8-vector
-                                             (string-sha256sum signed-headers)))))
-         (signature (openssl-shell-sign-string *privkey* signed-headers))
+                                            (string-to-ub8-vector signed-headers))))
          (signature-header (str:concat "keyId=\"" from "#main-key\","
-                                       "algorithm=\"rsa-sha256\","
                                        "headers=\"(request-target) host date digest\","
+                                       "algorithm=\"rsa-sha256\","
                                        "signature=\"" signature "\"")))
     `(("Date" . ,date-header)
       ("Digest" . ,digest-header)
@@ -237,10 +228,8 @@ Mi ne estas knabino!!")
 
 
 (defun send-note (inbox from to text)
-  (let* ((json (note-json from to text))
-         (headers (note-headers inbox from to json)))
-    (dexador:post inbox :content json
-                        :headers headers)))
+  (dexador:post inbox :content (note-json from to text)
+                      :headers (note-headers inbox from to text)))
 
 
 
@@ -260,7 +249,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 (babel:octets-to-string (alexandria:read-stream-content-into-byte-vector (getf env :raw-body))))))
+  (setq *logs* (append *logs* (list env)))
   (let* ((path (pathname-sans-parameters (getf env :request-uri)))
          (params (pathname-parameters (getf env :request-uri)))
          (response-function
@@ -275,7 +264,7 @@ Mi ne estas knabino!!")
         (funcall 'http-404 env path-sans-response-root params))))
 
 
-(defun start-server (&optional (config '(:domain "localhost" :port 8080)))
+(defun start-server (&optional (config '(:domain "etc.xwx.moe")))
   "Start the server."
   (clack:clackup (lambda (env)
                    (server (append env config)))
@@ -468,16 +457,3 @@ 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)))))
-