Don’t assume resources are acct URIs

This commit is contained in:
Jaidyn Ann 2023-07-28 07:19:22 -05:00
parent 5a2562fd07
commit fec297861b

View File

@ -20,17 +20,16 @@
(in-package #:webtentacle) (in-package #:webtentacle)
(defun user-json (&key user host aliases properties links) (defun resource-json (&key subject aliases properties links)
"Given the USERs information, return the applicable Webfinger JSON. "Given the RESOURCEs information, return the applicable Webfinger JSON.
Details of the values of USER, HOST, ALIASES, PROPERTIES, and LINKS can be found Details of the values of RESOURCE, ALIASES, PROPERTIES, and LINKS can be found
in the docstring of SERVER." in the docstring of SERVER."
(let ((yason:*symbol-key-encoder* #'yason:encode-symbol-as-lowercase) (let ((yason:*symbol-key-encoder* #'yason:encode-symbol-as-lowercase)
(yason:*symbol-encoder* #'yason:encode-symbol-as-lowercase)) (yason:*symbol-encoder* #'yason:encode-symbol-as-lowercase))
(yason:with-output-to-string* () (yason:with-output-to-string* ()
(yason:with-object () (yason:with-object ()
(yason:encode-object-element (when subject
"subject" (yason:encode-object-element "subject" subject))
(concatenate 'string "acct:" user "@" host))
(when (and aliases (listp aliases)) (when (and aliases (listp aliases))
(yason:encode-object-element "aliases" aliases)) (yason:encode-object-element "aliases" aliases))
(when (and properties (listp properties)) (when (and properties (listp properties))
@ -54,12 +53,11 @@ in the docstring of SERVER."
links))))))) links)))))))
(defun fake-info-func (user host) (defun fake-info-func (resource)
"A testing function. This is a USER-INFO-FUNC function that outputs garbage." "A testing function. This is a RESOURCE-INFO-FUNC function that outputs garbage."
(let ((profile (str:concat "https://example.example/users/" user))) (let ((profile (str:concat "https://example.example/users/" resource)))
(list (list
:user user :subject resource
:host host
:aliases (list profile "https://example.example/users/old-user") :aliases (list profile "https://example.example/users/old-user")
:links :links
`((href ,profile `((href ,profile
@ -71,23 +69,6 @@ in the docstring of SERVER."
type "application/activity+json"))))) type "application/activity+json")))))
(define-condition invalid-acct-uri (error) ()
(:documentation "Thrown when a user@host acct URI is expected, but is lacking a user or host potion."))
(defun resource-user-host (resource)
"Given a queried RESOURCE, return a list of its contained user and host."
(let* ((sans-acct (if (str:starts-with-p "acct:" resource)
(subseq resource 5)
resource))
(user-host (str:split #\@ sans-acct)))
(if (or (not (eq (length user-host) 2))
(str:emptyp (car user-host))
(str:emptyp (cadr user-host)))
(error 'invalid-acct-uri :message "Invalid acct resource")
user-host)))
(defun filter-link-rels (rels link-plists) (defun filter-link-rels (rels link-plists)
"Given a list of link property-lists, filter out links whose rel properties "Given a list of link property-lists, filter out links whose rel properties
arent a member of the RELS list. arent a member of the RELS list.
@ -102,18 +83,18 @@ in RELS will remain."
link-plists)) link-plists))
(defun filter-user-info-rels (rels user-info) (defun filter-resource-info-rels (rels resource-info)
"Filter the :LINKS property-lists properties from a USER-INFO property-list, "Filter the :LINKS property-lists properties from a RESOURCE-INFO property-list,
by their relations. by their relations.
If RELS is nil, nothing is filtered out. If RELS is nil, nothing is filtered out.
If RELS is a list of strings, only links with rel properties matching a member If RELS is a list of strings, only links with rel properties matching a member
in RELS will remain." in RELS will remain."
(setf (getf user-info :links) (filter-link-rels rels (getf user-info :links))) (setf (getf resource-info :links) (filter-link-rels rels (getf resource-info :links)))
user-info) resource-info)
(defun clack-response (user-info-func resource &rest rels) (defun clack-response (resource-info-func resource &rest rels)
"Given a USER-INFO-FUNC (as per the specification of SERVERs docstring), and "Given a RESOURCE-INFO-FUNC (as per the specification of SERVERs docstring), and
the RESOURCE and RELS parameters from a Webfinger HTTP request, return the the RESOURCE and RELS parameters from a Webfinger HTTP request, return the
response JSON in Clacks format. response JSON in Clacks format.
This can be used if you dont want to wrap your server with SERVER, and would This can be used if you dont want to wrap your server with SERVER, and would
@ -125,34 +106,35 @@ rather handle the Webfinger path yourself."
(format (format
nil "~A" nil "~A"
(handler-case (handler-case
(if (not resource) (cond ((or (not resource) (str:emptyp resource))
"\"No resource specified\"" "\"No resource specified\"")
(or (apply #'user-json ;; If not a URI (or even an acct URI without the “acct:”)
(filter-user-info-rels ((and (not (str:containsp ":" resource))
(not (str:containsp "@" resource)))
"\"Resource not a URI\"")
('t
(or (apply #'resource-json
(filter-resource-info-rels
rels rels
(apply user-info-func (funcall resource-info-func resource)))
(resource-user-host resource)))) "\"Couldn't find resource\"")))
"\"Couldn't find user\""))
(invalid-acct-uri ()
"\"Invalid acct URI\"")
(error (any-error) (error (any-error)
(format nil "\"Server error: ~A\"" any-error))))))) (format nil "\"Server error: ~A\"" any-error)))))))
(defun server (env user-info-func &optional (clack-app nil)) (defun server (env resource-info-func &optional (clack-app nil))
"Start handling Webfinger requests, wrapping around the given CLACK-APP body "Start handling Webfinger requests, wrapping around the given CLACK-APP body
function. function.
USER-INFO-FUNC should be a function that will return user information to be RESOURCE-INFO-FUNC should be a function that will return resource information to
served by Webfinger. be served by Webfinger.
USER-INFO-FUNC should take two parameters: Username and host, both strings. RESOURCE-INFO-FUNC should take one parameter, the resource string.
It should return a property-list with some of the following properties: It should return a property-list with some of the following properties:
* :USER * :SUBJECT
* :HOST
* :ALIASES * :ALIASES
* :PROPERTIES * :PROPERTIES
* :LINKS * :LINKS
You need at minimum :USER and :HOST, all else is optional. You need at minimum :SUBJECT, all else is optional.
:ALIASES is a simple list of URLs. :ALIASES is a simple list of URLs.
:PROPERTIES is a simple property-list of whatever you want. :PROPERTIES is a simple property-list of whatever you want.
@ -177,7 +159,7 @@ value being the corresponding title; for example,
(if (string= (quri:uri-path uri) "/.well-known/webfinger") (if (string= (quri:uri-path uri) "/.well-known/webfinger")
;; We only want to handle the *exact* webfinger path ;; We only want to handle the *exact* webfinger path
(apply #'clack-response (apply #'clack-response
(append (list user-info-func (append (list resource-info-func
(cdr (assoc "resource" params :test #'string=))) (cdr (assoc "resource" params :test #'string=)))
;; We want all “rel” parameters, not just the first one ;; We want all “rel” parameters, not just the first one
(mapcar (mapcar
@ -191,11 +173,11 @@ value being the corresponding title; for example,
'(512 (:content-type "text/plain") ("HECK")))))) '(512 (:content-type "text/plain") ("HECK"))))))
(defun start-server (user-info-func) (defun start-server (resource-info-func)
"Run a Webfinger HTTP server, given a USER-INFO-FUNC (see SERVERs docstring). "Run a Webfinger HTTP server, given a RESOURCE-INFO-FUNC (see SERVERs docstring).
This is useful if you want to delegate Webfinger-handling to this library with a This is useful if you want to delegate Webfinger-handling to this library with a
reverse-proxy. reverse-proxy.
It is also useful for debugging this library." It is also useful for debugging this library."
(clack:clackup (clack:clackup
(lambda (env) (lambda (env)
(funcall #'server env user-info-func)))) (funcall #'server env resource-info-func))))