Formatting tweaks (No functional change)
This commit is contained in:
parent
566b5e696c
commit
94ff3fa326
|
|
@ -1,17 +1,19 @@
|
|||
;;; 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
|
||||
;;; as published by the Free Software Foundation, either version 3 of
|
||||
;;; the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU Affero General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Affero General Public License
|
||||
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;; activitypub-servist: An ActivityPub server framework.
|
||||
|
||||
;; 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
|
||||
;; as published by the Free Software Foundation, either version 3 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU Affero General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU Affero General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
(defpackage #:activitypub-servist
|
||||
(:use #:cl #:activitypub-servist/signatures)
|
||||
|
|
@ -24,13 +26,11 @@
|
|||
"List of the server's usernames."
|
||||
'("servistchjo"))
|
||||
|
||||
|
||||
(defun userhosts ()
|
||||
"List of the server's usernames + hostname."
|
||||
(mapcar (lambda (username) (str:concat username "@" "etc.xwx.moe"))
|
||||
(users)))
|
||||
|
||||
|
||||
(defun directories ()
|
||||
"Alist of the server's paths and their response functions."
|
||||
'(("u/" . http-user-dir)
|
||||
|
|
@ -43,9 +43,8 @@
|
|||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Host-info response
|
||||
;; ————————————————————————————————————————
|
||||
;;; Host-info response
|
||||
;;; ————————————————————————————————————————
|
||||
(defun http-host-meta (&optional env path-items params)
|
||||
`(200 (:content-type "application/xrd+xml; charset=utf-8")
|
||||
(,(str:concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
|
||||
|
|
@ -58,13 +57,11 @@
|
|||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Webfinger response
|
||||
;; ————————————————————————————————————————
|
||||
;;; Webfinger response
|
||||
;;; ————————————————————————————————————————
|
||||
(defun http-webfinger (env path-items params)
|
||||
(webtentacle:server env (lambda (resource) (resource-info-func resource)) nil))
|
||||
|
||||
|
||||
(defun resource-userhost (resource)
|
||||
"Given an account URI in webfinger-friendly format, return the corresponding)))
|
||||
username and host in a list. Whether or not these are valid… that’s your
|
||||
|
|
@ -88,7 +85,6 @@ Ex: acct:mom@bird.com → '(“mom” “bird.com”)"
|
|||
(pathname-name resource)
|
||||
(purl:url-host resource)))))
|
||||
|
||||
|
||||
(defun resource-valid-p (resource)
|
||||
"Given a webfinger-style “resource”"
|
||||
(let* ((userhost (resource-userhost resource))
|
||||
|
|
@ -98,7 +94,6 @@ Ex: acct:mom@bird.com → '(“mom” “bird.com”)"
|
|||
(string-equal (string-downcase a)
|
||||
(string-downcase b))))))
|
||||
|
||||
|
||||
(defun resource-info-func (resource)
|
||||
"Given a webfinger RESOURCE, return a property-list of data on the given user…
|
||||
if they exist, that is.
|
||||
|
|
@ -121,20 +116,17 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
rel "http://ostatus.org/schema/1.0/subscribe"))))))
|
||||
|
||||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; User info response(s)
|
||||
;; ————————————————————————————————————————
|
||||
;; Respond to requests within the /u/* directory.
|
||||
;;; User info response(s)
|
||||
;;; ————————————————————————————————————————
|
||||
(defun http-user-dir (env path-items params)
|
||||
"Respond to requests within the /u/* directory."
|
||||
(let ((user (car path-items)))
|
||||
;; In case of request for the user's actor.
|
||||
(if (member user (users) :test 'equal)
|
||||
`(200 (:content-type "application/activity+json")
|
||||
(,(user-actor env user))))))
|
||||
|
||||
|
||||
(defun user-actor (config username)
|
||||
"The JSON of a user's actor."
|
||||
(let* ((user-root (str:concat "https://" (getf config :domain) "/u/" username))
|
||||
|
|
@ -175,9 +167,8 @@ Mi ne estas knabino!!")
|
|||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Sending a note
|
||||
;; ————————————————————————————————————————
|
||||
;;; Sending a note
|
||||
;;; ————————————————————————————————————————
|
||||
(defun note-json (from to text)
|
||||
"The JSON of a user's actor."
|
||||
(let* ((user-root from)
|
||||
|
|
@ -198,12 +189,10 @@ Mi ne estas knabino!!")
|
|||
"content" text
|
||||
"to" (if (listp to) to (list to))))))))))
|
||||
|
||||
|
||||
(defvar +date-header-datetime-format+
|
||||
'(:short-weekday ", " (:day 2) " " :short-month " " (:year 4) " "
|
||||
(:hour 2) #\: (:min 2) #\: (:sec 2) " " :timezone))
|
||||
|
||||
|
||||
(defun note-headers (inbox from to json)
|
||||
(let* ((inbox-uri (quri:uri inbox))
|
||||
(digest-header (str:concat "SHA-256=" (string-sha256sum json)))
|
||||
|
|
@ -236,7 +225,6 @@ Mi ne estas knabino!!")
|
|||
("Accept" . "application/activity+json")
|
||||
("Content-Type" . "application/activity+json"))))
|
||||
|
||||
|
||||
(defun send-note (inbox from to text)
|
||||
(let* ((json (note-json from to text))
|
||||
(headers (note-headers inbox from to json)))
|
||||
|
|
@ -244,11 +232,9 @@ Mi ne estas knabino!!")
|
|||
:headers headers)))
|
||||
|
||||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Misc. responses
|
||||
;; ————————————————————————————————————————
|
||||
;;; Misc. responses
|
||||
;;; ————————————————————————————————————————
|
||||
(defun http-404 (env path-items params)
|
||||
"The default 404 response."
|
||||
'(404 (:content-type "text/plain")
|
||||
|
|
@ -256,9 +242,10 @@ Mi ne estas knabino!!")
|
|||
|
||||
(defvar *logs* '())
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Invocation
|
||||
;; ————————————————————————————————————————
|
||||
|
||||
|
||||
;;; Invocation
|
||||
;;; ————————————————————————————————————————
|
||||
(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))))))
|
||||
|
|
@ -275,7 +262,6 @@ Mi ne estas knabino!!")
|
|||
(or (funcall (cdr response-function) env path-sans-response-root params)
|
||||
(funcall 'http-404 env path-sans-response-root params))))
|
||||
|
||||
|
||||
(defun start-server (&optional (config '(:domain "localhost" :port 8080)))
|
||||
"Start the server."
|
||||
(clack:clackup (lambda (env)
|
||||
|
|
@ -286,9 +272,8 @@ Mi ne estas knabino!!")
|
|||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Utils.
|
||||
;; ————————————————————————————————————————
|
||||
;;; Utils.
|
||||
;;; ————————————————————————————————————————
|
||||
(defun assoc-by-path (alist path-items &optional (depth 0))
|
||||
"Given an associative list and a path decomposed into a list of
|
||||
its components, return the item with the closest according
|
||||
|
|
@ -308,13 +293,11 @@ or “/bear/apple/” or “/bear/”, but not “/bear” (not a directory)."
|
|||
(cdr (reverse path-items)))
|
||||
(+ depth 1))))))
|
||||
|
||||
|
||||
(defun pathname-sans-parameters (path)
|
||||
"Removes parameters from a URI pathname, returning the bare path.
|
||||
“/path/a/b?a=1&b=3” → “/path/a/b”"
|
||||
(car (str:split #\? path)))
|
||||
|
||||
|
||||
(defun pathname-parameters (path)
|
||||
"Convert the parameters of a URI pathname into an associative list.
|
||||
“/path/a/b?a=1&b=2&c=3” → ((“a” . “1”) (“b” . “2”) (“c” . “3”))"
|
||||
|
|
@ -325,14 +308,11 @@ or “/bear/apple/” or “/bear/”, but not “/bear” (not a directory)."
|
|||
(cadr pair-items))))
|
||||
(str:split #\& (cadr (str:split #\? path)))))
|
||||
|
||||
|
||||
(defun pathname-components (pathname)
|
||||
"Split a pathname into a list of its components.
|
||||
“/u/bear/apple.txt” → '(“u” “bear” “apple.txt”)"
|
||||
(str:split #\/ pathname :omit-nulls 't))
|
||||
|
||||
|
||||
|
||||
(defun sequence-hexadecimal-string (sequence)
|
||||
(reduce #'str:concat
|
||||
(loop for number across
|
||||
|
|
|
|||
|
|
@ -1,17 +1,19 @@
|
|||
;;; 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
|
||||
;;; as published by the Free Software Foundation, either version 3 of
|
||||
;;; the License, or (at your option) any later version.
|
||||
;;;
|
||||
;;; This program is distributed in the hope that it will be useful,
|
||||
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU Affero General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU Affero General Public License
|
||||
;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;;; activitypub-servist/signatures: Handle AP-compatible HTTP signatures.
|
||||
|
||||
;; 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
|
||||
;; as published by the Free Software Foundation, either version 3 of
|
||||
;; the License, or (at your option) any later version.
|
||||
;;
|
||||
;; This program is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU Affero General Public License for more details.
|
||||
;;
|
||||
;; You should have received a copy of the GNU Affero General Public License
|
||||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
|
||||
(defpackage #:activitypub-servist/signatures
|
||||
(:use #:cl)
|
||||
|
|
|
|||
Ŝarĝante…
Reference in New Issue