Reformatting & system definition; no func. change
This commit is contained in:
parent
906d2b0624
commit
f2366f7858
|
|
@ -0,0 +1,3 @@
|
|||
(defsystem "activitypub-servist"
|
||||
:depends-on ("alexandria" "clack" "purl" "str" "webtentacle" "yason")
|
||||
:components ((:file "activitypub-servist")))
|
||||
|
|
@ -15,14 +15,32 @@
|
|||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||
;;
|
||||
|
||||
(ql:quickload '(alexandria asn1 clack cl-base64 ironclad purl str trivia trivial-utf-8 webtentacle yason))
|
||||
|
||||
(defpackage #:activitypub-servist
|
||||
(:use #:cl)
|
||||
(:export :server :start-server))
|
||||
|
||||
(in-package #:activitypub-servist)
|
||||
|
||||
;;(ql:quickload '(alexandria asn1 clack cl-base64 ironclad purl str trivia trivial-utf-8 webtentacle yason))
|
||||
|
||||
|
||||
;; List of the server's usernames.
|
||||
(defun users () '("rod@localhost" "mum@localhost"))
|
||||
(defun users ()
|
||||
"List of the server's usernames."
|
||||
'("rod@localhost" "mum@localhost"))
|
||||
|
||||
;; Alist of the server's paths and their response functions.
|
||||
(defun directories () '(("u/" . http-dir) (".well-known/webfinger" . http-webfinger)))
|
||||
|
||||
(defun directories ()
|
||||
"Alist of the server's paths and their response functions."
|
||||
'(("u/" . http-dir) (".well-known/webfinger" . http-webfinger)))
|
||||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Webfinger response
|
||||
;; ————————————————————————————————————————
|
||||
(defun http-webfinger (env path-items params)
|
||||
(webtentacle:server env (lambda (resource) (resource-info-func resource)) nil))
|
||||
|
||||
|
||||
(defun resource-userhost (resource)
|
||||
|
|
@ -79,12 +97,10 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
type "application/activity+json"))))))
|
||||
|
||||
|
||||
;; The default 404 response.
|
||||
(defun http-404 (env path-items params)
|
||||
'(404 (:content-type "text/plain")
|
||||
("404, you goddamn fool!")))
|
||||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; User info response(s)
|
||||
;; ————————————————————————————————————————
|
||||
;; Respond to requests within the /u/* directory.
|
||||
(defun http-user-dir (env path-items params)
|
||||
(let ((user (car path-items)))
|
||||
|
|
@ -94,12 +110,36 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
(,(user-actor env user))))))
|
||||
|
||||
|
||||
(defun http-webfinger (env path-items params)
|
||||
(webtentacle:server env (lambda (resource) (resource-info-func resource)) nil))
|
||||
(defun user-actor (config username)
|
||||
"The JSON of a user's actor."
|
||||
(let* ((user-root (str:concat "https://" (getf config :domain) "/u/" username)))
|
||||
(yason:with-output-to-string* ()
|
||||
(yason:encode-alist
|
||||
`(("@context" . ("https://www.w3.org/ns/activitystreams"
|
||||
"https://w3id.org/security/v1"))
|
||||
("id" . ,user-root)
|
||||
("type" . "Person")
|
||||
("preferredUsername" . ,username)
|
||||
("inbox" . ,(str:concat user-root "/inbox.json"))
|
||||
("outbox" . ,(str:concat user-root "/outbox.json")))))))
|
||||
|
||||
|
||||
;; Returns the response data for Clack, given the request data `env`.
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Misc. responses
|
||||
;; ————————————————————————————————————————
|
||||
(defun http-404 (env path-items params)
|
||||
"The default 404 response."
|
||||
'(404 (:content-type "text/plain")
|
||||
("404, you goddamn fool!")))
|
||||
|
||||
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; Invocation
|
||||
;; ————————————————————————————————————————
|
||||
(defun server (env)
|
||||
"Returns the response data for Clack, given the request data `env`."
|
||||
(let* ((path (pathname-sans-parameters (getf env :request-uri)))
|
||||
(params (pathname-parameters (getf env :request-uri)))
|
||||
(response-function
|
||||
|
|
@ -113,8 +153,8 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
(funcall 'http-404 env path-sans-response-root params))))
|
||||
|
||||
|
||||
;; Start the server.
|
||||
(defun start-server (&optional (config '(:domain "localhost")))
|
||||
"Start the server."
|
||||
(clack:clackup (lambda (env)
|
||||
(server (append env config)))
|
||||
:server 'woo
|
||||
|
|
@ -122,29 +162,17 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
:port 8080))
|
||||
|
||||
|
||||
|
||||
;; The JSON of a user's actor.
|
||||
(defun user-actor (config username)
|
||||
(let* ((user-root (str:concat "https://" (getf config :domain) "/u/" username)))
|
||||
(yason:with-output-to-string* ()
|
||||
(yason:encode-alist
|
||||
`(("@context" . ("https://www.w3.org/ns/activitystreams"
|
||||
"https://w3id.org/security/v1"))
|
||||
("id" . ,user-root)
|
||||
("type" . "Person")
|
||||
("preferredUsername" . ,username)
|
||||
("inbox" . ,(str:concat user-root "/inbox.json"))
|
||||
("outbox" . ,(str:concat user-root "/outbox.json")))))))
|
||||
|
||||
|
||||
|
||||
;; Given an associative list and a path decomposed into a list of
|
||||
;; its components, return the item with the closest according
|
||||
;; pathname as key. If the exact path isn't a valid key, it will
|
||||
;; try all parent directories.
|
||||
;; E.g., "/bear/apple/momma/" could match either "/bear/apple/momma"
|
||||
;; or "/bear/apple/" or "/bear/", but not "/bear" (not a directory).
|
||||
|
||||
;; ————————————————————————————————————————
|
||||
;; 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
|
||||
pathname as key. If the exact path isn't a valid key, it will
|
||||
try all parent directories.
|
||||
E.g., “/bear/apple/momma/” could match either “/bear/apple/momma”
|
||||
or “/bear/apple/” or “/bear/”, but not “/bear” (not a directory)."
|
||||
(let ((path (str:join #\/ path-items)))
|
||||
(if (eq path-items nil)
|
||||
(assoc "" alist :test 'string=)
|
||||
|
|
@ -158,15 +186,15 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
(+ depth 1))))))
|
||||
|
||||
|
||||
;; Removes parameters from a URI pathname, returning the bare path.
|
||||
;; "/path/a/b?a=1&b=3" → "/path/a/b"
|
||||
(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)))
|
||||
|
||||
|
||||
;; 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"))
|
||||
(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”))"
|
||||
(mapcar
|
||||
(lambda (pair)
|
||||
(let ((pair-items (str:split #\= pair)))
|
||||
|
|
@ -175,7 +203,7 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
|
|||
(str:split #\& (cadr (str:split #\? path)))))
|
||||
|
||||
|
||||
;; Split a pathname into a list of its components.
|
||||
;; "/u/bear/apple.txt" → '("u" "bear" "apple.txt")
|
||||
(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))
|
||||
Ŝarĝante…
Reference in New Issue