diff --git a/activitypub-server.lisp b/activitypub-server.lisp index a8b304f..4782d42 100644 --- a/activitypub-server.lisp +++ b/activitypub-server.lisp @@ -15,17 +15,68 @@ ;; along with this program. If not, see . ;; -(ql:quickload '(alexandria clack str yason)) +(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" "mum")) +(defun users () '("rod@localhost" "mum@localhost")) ;; Alist of the server's paths and their response functions. -(defun directories () '(("u/" . http-user-dir) - (".well-known/webfinger" . http-webfinger))) +(defun directories () '(("u/" . http-dir) (".well-known/webfinger" . http-webfinger))) -;; (defparameter *s* (start-server '(:domain "etc.xwx.moe"))) + +(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 +business! +Ex: acct:mom@bird.com → '(“mom” “bird.com”)" + (cond + ;; A @bird@mom-style resource + ((str:containsp "@" resource) + (let* ((sans-acct (if (str:starts-with-p "acct:" resource) + (subseq resource 5) + resource)) + (sans-@ (if (str:starts-with-p "@" sans-acct) + (subseq sans-acct 1) + sans-acct))) + (destructuring-bind (user host) + (str:split "@" sans-@) + (cons user host)))) + ;; A URL-style resource + ((str:containsp "/u/" resource) + (cons + (pathname-name resource) + (purl:url-host resource))))) + + +(defun resource-valid-p (resource) + "Given a webfinger-style “resource”" + (let* ((userhost (resource-userhost resource)) + (userhost-str (funcall #'str:concat (car userhost) "@" (cdr userhost)))) + (member userhost-str (users) + :test (lambda (a b) + (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. +This is used by the WEBTENTACLE webfinger server; you can see information on +the plist in the docstring for its WEBTENTACLE:SERVER function." + (let* ((userhost (resource-userhost resource)) + (profile (str:concat "https://" (cdr userhost) "/users/" resource))) + (when (resource-valid-p resource) + (list + :subject resource + :links + `((href ,profile + rel "http://webfinger.net/rel/profile-page" + type "text/html" + properties (:apple 3 :bear 4)) + (href ,profile + rel "self" + type "application/activity+json")))))) ;; The default 404 response. @@ -43,17 +94,8 @@ (,(user-actor env user)))))) -;; Respond to /.well-known/webfinger?resource=acct:* requests. (defun http-webfinger (env path-items params) - (let* ((resource (cdr (assoc "resource" params :test 'string=))) - (userhost (str:split #\@ (str:replace-all "acct:" "" resource)))) - (if (and userhost - (string= (cadr userhost) (getf env :domain)) - (member (car userhost) (users) :test 'string=)) - `(200 (:content-type "application/json") - (,(user-webfinger env (car userhost)))) - '(404 (:content-type "application/json") - ("Couldn't find user"))))) + (webtentacle:server env (lambda (resource) (resource-info-func resource)) nil)) ;; Returns the response data for Clack, given the request data `env`. @@ -74,13 +116,13 @@ ;; Start the server. (defun start-server (&optional (config '(:domain "localhost"))) (clack:clackup (lambda (env) - (funcall 'server - (append env config))) + (server (append env config))) :server 'woo :address "0.0.0.0" :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))) @@ -95,26 +137,6 @@ ("outbox" . ,(str:concat user-root "/outbox.json"))))))) -;; Webfinger JSON — for requesting data on actors' addresses, etc. -(defun user-webfinger (config username) - (yason:with-output-to-string* () - (yason:encode - (alexandria:alist-hash-table - `(("subject" - . ,(str:concat "acct:" username "@" (getf config :domain))) - ("links" - ,(alexandria:alist-hash-table - `(("rel" . "self") - ("type" . "application/activity+json") - ("href" - . ,(str:concat "https://" (getf config :domain) - "/u/" username)))) - ,(alexandria:alist-hash-table - `(("rel" . "http://ostatus.org/schema/1.0/subscribe") - ("template" - . ,(str:concat "https://" (getf config :domain) - "/ostatus/subscribe?acct={uri}")))))))))) - ;; Given an associative list and a path decomposed into a list of ;; its components, return the item with the closest according @@ -157,4 +179,3 @@ ;; "/u/bear/apple.txt" → '("u" "bear" "apple.txt") (defun pathname-components (pathname) (str:split #\/ pathname :omit-nulls 't)) -