Functional HTTP signatures

… using extenal binary of OpenSSL. Not ideal, but
it works for now!
This commit is contained in:
Jaidyn Ann 2024-06-06 23:53:43 -05:00
parent b66c166aff
commit 7adda41c71

View File

@ -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"))
("outbox" . ,(str:concat user-root "/outbox.json"))
("inbox" . ,(str:concat user-root "/inbox"))
("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)
(let* ((json (note-json from to text))
(inbox-uri (quri:uri inbox))
(defun note-headers (inbox from to json)
(let* ((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
(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))))
(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)))
(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)
:headers (note-headers 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)))
@ -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)))))