From f2366f78586c4d7ee6fea02a57e9df7b3732e011 Mon Sep 17 00:00:00 2001 From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com> Date: Fri, 1 Sep 2023 22:20:13 -0500 Subject: [PATCH] Reformatting & system definition; no func. change --- activitypub-servist.asd | 3 + ...ub-server.lisp => activitypub-servist.lisp | 114 +++++++++++------- 2 files changed, 74 insertions(+), 43 deletions(-) create mode 100644 activitypub-servist.asd rename activitypub-server.lisp => activitypub-servist.lisp (67%) diff --git a/activitypub-servist.asd b/activitypub-servist.asd new file mode 100644 index 0000000..41c10e7 --- /dev/null +++ b/activitypub-servist.asd @@ -0,0 +1,3 @@ +(defsystem "activitypub-servist" + :depends-on ("alexandria" "clack" "purl" "str" "webtentacle" "yason") + :components ((:file "activitypub-servist"))) diff --git a/activitypub-server.lisp b/activitypub-servist.lisp similarity index 67% rename from activitypub-server.lisp rename to activitypub-servist.lisp index 4782d42..bfdabd5 100644 --- a/activitypub-server.lisp +++ b/activitypub-servist.lisp @@ -15,14 +15,32 @@ ;; along with this program. If not, see . ;; -(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))