diff options
-rw-r--r-- | Makefile.am | 3 | ||||
-rw-r--r-- | weipub/feed.scm | 69 |
2 files changed, 71 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index a4521a7..a78de76 100644 --- a/Makefile.am +++ b/Makefile.am @@ -23,7 +23,8 @@ godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/site-ccache SOURCES = \ weipub/config.scm \ weipub/database.scm \ - weipub/accounts.scm + weipub/accounts.scm \ + weipub/feed.scm info_TEXINFOS = doc/weipub.texi diff --git a/weipub/feed.scm b/weipub/feed.scm new file mode 100644 index 0000000..57a0f96 --- /dev/null +++ b/weipub/feed.scm @@ -0,0 +1,69 @@ +;;; weipub - Teeny tiny activitypub thing +;;; Copyright © 2022 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; 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 +;;; <http://www.gnu.org/licenses/>. + +(define-module (weipub feed) + #:use-module (weipub config) + #:use-module (weipub accounts) + #:use-module (sxml simple) + #:use-module (sxml xpath) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:export (atom-entry->message + atom-feed->entries)) + +(define-record-type <atom-entry> + (make-atom-entry author published url content) + atom-entry? + (author atom-entry-author) + (published atom-entry-published) + (url atom-entry-url) + (content atom-entry-content)) + +(define (sxml->atom-entry sxml) + (let ((author + (and=> ((sxpath '(atom:author atom:name *text*)) sxml) first)) + (published + (and=> ((sxpath '(atom:published *text*)) sxml) first)) + (url + (and=> ((sxpath '(atom:link @ href *text*)) sxml) first)) + (content + (and=> ((sxpath '(atom:content *text*)) sxml) first))) + (make-atom-entry author published url content))) + +(define (atom-feed->entries port) + "Read an atom feed XML from PORT and return a list of atom entries." + (let ((sxml (xml->sxml port + #:namespaces '((atom . "http://www.w3.org/2005/Atom"))))) + (map sxml->atom-entry + ((sxpath '(// atom:entry)) sxml)))) + +(define* (atom-entry->message entry #:key from to) + `(("@context" . "https://www.w3.org/ns/activitystreams") + ("id" . ,(format #false + "~a?create=true&v=1" (atom-entry-url entry))) + ("type" . "Create") + ("actor" . ,(account-url from)) + ("to" . #("https://www.w3.org/ns/activitystreams#Public")) + ("cc" . ,(vector to)) + ("object" + . (("id" . ,(format #false "~a?v=1" (atom-entry-url entry))) + ("type" . "Note") + ("published" . ,(atom-entry-published entry)) + ("attributedTo" . ,(account-url from)) + ("content" . ,(atom-entry-content entry)) + ("to" . #("https://www.w3.org/ns/activitystreams#Public")) + ("attachment" . #()))))) |