The `org' directory is no longer necessary

7 files changed, 804 insertions, 0 deletions

diff --git a/jakob/builder/atom.scm b/jakob/builder/atom.scm
new file mode 100644
index 0000000..f145443
--- /dev/null
+++ b/jakob/builder/atom.scm
@@ -0,0 +1,109 @@
+;;; Copyright © 2019 - 2023 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob builder atom)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt post)
+  #:use-module (haunt site)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 match)
+  #:use-module (jakob builder blog)
+  #:use-module (jakob utils)
+  #:use-module (jakob utils sxml)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (web uri)
+  #:export (atom-feed))
+
+;; Slight hack to use relative URLs in the Atom feed for Tor and i2p mirrors.
+(define %disable-compliance (make-parameter (getenv "DISABLE_ATOM_COMPLIANCE")))
+
+(define (format-date date)
+  "Format DATE into a date-time production as defined in RFC 3339"
+  (let* ((formatted       (date->string date "~4"))
+         (up-to-tz-minute (string-drop-right formatted 2))
+         (tz-minute       (string-take-right formatted 2)))
+    (string-concatenate `(,up-to-tz-minute ":" ,tz-minute))))
+
+(define (format-relative-path site path)
+  "Return an absolute URI for PATH"
+  (if (%disable-compliance)
+      path
+      (let ((path (if (not (string-prefix? "/" path))
+                      (format #f "/~a" path)
+                      path)))
+        (uri->string
+         (build-uri 'https ;; (site-scheme site)
+                    #:host (site-domain site)
+                    #:path path)))))
+
+(define* (post->atom-entry site post #:key (blog-prefix ""))
+  "Convert POST into an Atom <entry> XML node."
+  (let ((uri (or (post-ref post 'crosspost)
+                 (post-uri post))))
+    `(entry
+      (title ,(post-ref post 'title))
+      (id ,(format-relative-path site uri))
+      (author
+       (name ,(post-ref post 'author))
+       ,(let ((email (post-ref post 'email)))
+          (if email `(email ,email) '())))
+      (updated ,(format-date (post-date post)))
+      (link (@ (href ,uri) (rel "alternate")))
+      (summary (@ (type "html"))
+               ,(sxml->html-string
+                 (append (first-paragraph post)
+                         (if (post-ref post 'crosspost)
+                             `((p "...")
+                               (p "This is a crosspost. Click "
+                                  ,(hyperlink (post-ref post 'crosspost) "here")
+                                  " to read the rest of the article."))
+                             '()))))
+      ,@(map (lambda (enclosure)
+               `(link (@ (rel "enclosure")
+                         (title ,(enclosure-title enclosure))
+                         (href ,(enclosure-url enclosure))
+                         (type ,(enclosure-mime-type enclosure))
+                         ,@(map (match-lambda
+                                  ((key . value)
+                                   (list key value)))
+                                (enclosure-extra enclosure)))))
+             (post-ref-all post 'enclosure)))))
+
+(define* (atom-feed #:key
+                    (file-name "feed.xml")
+                    (subtitle "Recent Posts")
+                    (filter posts/reverse-chronological)
+                    (max-entries 20)
+                    (blog-prefix ""))
+  "Minor modification to the 'atom-feed' builder in '(haunt builder atom)' to
+add support for cross-posts. See the docstring in that manual for details on the
+use of this function."
+  (lambda (site posts)
+    (serialized-artifact file-name
+                         `(feed (@ (xmlns "http://www.w3.org/2005/Atom"))
+                                (title ,(site-title site))
+                                (id ,(format-relative-path site file-name))
+                                (subtitle ,subtitle)
+                                (updated ,(format-date (current-date)))
+                                (link (@ (href ,(format-relative-path site file-name))
+                                         (rel "self")))
+                                (link (@ (href ,(format-relative-path site ""))))
+                                ,@(map (cut post->atom-entry site <>
+                                            #:blog-prefix blog-prefix)
+                                       (take-up-to max-entries (filter posts))))
+                         (@@ (haunt builder atom) sxml->xml*))))
diff --git a/jakob/builder/blog.scm b/jakob/builder/blog.scm
new file mode 100644
index 0000000..e03c3e2
--- /dev/null
+++ b/jakob/builder/blog.scm
@@ -0,0 +1,201 @@
+;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob builder blog)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt post)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (jakob dynamic capabilities comment-form)
+  #:use-module (jakob theme)
+  #:use-module (jakob utils)
+  #:use-module (jakob utils pagination)
+  #:use-module (jakob utils sxml)
+  #:use-module (jakob utils tags)
+  #:use-module (jakob utils comments)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
+  #:use-module (web uri)
+  #:export (post-uri
+            blog))
+
+;;; Commentary:
+;;;
+;;; In favor of greater flexibility, Haunt's default 'blog' builder was not used
+;;; for this site. This modules implements a similar builder, 'blog', with
+;;; pagination and support for tag navigation.
+;;;
+;;; Code:
+
+
+;;;
+;;; Rendering.
+;;;
+
+(define (build-comment-url post)
+  (format #f "/api/comment-form/~a" (post-slug post)))
+
+(define (render-article post)
+  "Return the SHTML for POST's contents."
+  #<(main
+     (h1 ,(post-ref post 'title))
+     (p ,(date->string (post-date post) "~B ~d, ~Y")
+        " ❖ "
+        "Tags: "
+        ,@(intersperse
+           (map (lambda (tag)
+                  (hyperlink (tag-uri %tag-prefix tag) tag))
+                (post-ref post 'tags))
+           ", "))
+     ,(when (post-ref post 'crosspost)
+        `(p (strong "This is a summary ")
+            "of a post that was published elsewhere. "
+            "To read the full post, visit "
+            ,(hyperlink (post-ref post 'crosspost) "this link")
+            "."))
+     (div (@ (data-pagefind-body #t))
+       (article ,(post-sxml post))
+       (section
+        (@ (id "webmention"))
+        (h2 "Comments for this page")
+        (ul (@ (class "webmention-container"))
+            ,@(render-comment-view (fetch-comments (post-identifier post)) (fetch-webmentions (post-identifier post))))
+        (div (@ (id "comment-form-primary") (hidden #t))
+             ,(render-dynamic-comment-form (post-identifier post)))
+        (p (@ (id "comment-form-alt"))
+           "Click " ,(hyperlink (build-comment-url post) "here") " to write a comment on this post.")
+        (form
+         (@ (id "webmention-form")
+            (action "https://webmention.io/jakob.space/webmention")
+            (method "post"))
+         (label "Or, if you've written about this "
+                ,(hyperlink "https://indieweb.org/responses" "elsewhere")
+                ", you can send me a Webmention:")
+         (div (@ (id "webmention-input-group"))
+          (input (@ (name "source") (type "url") (placeholder "https://...")))
+          (input (@ (value "Send") (type "submit")))))
+        ,(script "section-folds.js")
+        ,(script "comment-reaction.js")))))
+
+(define (render-preview post)
+  "Return the SHTML for a preview of POST."
+  (let ((crosspost-uri (post-ref post 'crosspost))
+        (local-uri (post-uri post)))
+    #<(section
+       (h2 ,(hyperlink (or crosspost-uri local-uri) (post-ref post 'title)))
+       (p ,(date->string (post-date post) "~B ~d, ~Y")
+          ,(when crosspost-uri
+             (list " ↻ " (hyperlink local-uri "Crosspost")))
+          " ❖ Tags: "
+          ,@(intersperse
+             (map (lambda (tag)
+                    (hyperlink (tag-uri %tag-prefix tag) tag))
+                  (post-ref post 'tags))
+             ", "))
+       ,(first-paragraph post)
+       (p ,(hyperlink (or crosspost-uri local-uri) "read more →")))))
+
+
+;;;
+;;; Creation of permalink pages for individual lposts.
+;;;
+
+;; Subdirectory for permalink pages.
+(define %prefix "/blog")
+
+(define (post-identifier post)
+  "Return the 'slug' that identifies POST."
+  (let* ((file-name (post-file-name post))
+         (splice-start (1+ (string-rindex file-name (cut char=? <> #\/))))
+         (splice-end (string-rindex file-name (cut char=? <> #\.)))
+         (slug (substring file-name splice-start splice-end)))
+    slug))
+
+(define (post-uri post)
+  "Return the path of POST relative to the site's root."
+  (string-append %prefix "/" (post-identifier post) ".html"))
+
+(define (post->page post)
+  "Return a Haunt page for POST."
+  (define meta-tags (call-with-input-string (post-ref post 'meta-tags) read))
+  (define scripts (call-with-input-string (post-ref post 'scripts) read))
+  (serialized-artifact (post-uri post)
+                       (theme #:title (post-ref post 'title)
+                              #:description (description-from-post post)
+                              #:keywords (post-ref post 'tags)
+                              #:meta (if (not (eof-object? meta-tags)) meta-tags '())
+                              #:scripts (if (not (eof-object? scripts)) scripts '())
+                              #:content (render-article post))
+                       sxml->html))
+
+
+;;;
+;;; Navigation based on post tags.
+;;;
+
+;; Subdirectory for post listings conditioned on post tags.
+(define %tag-prefix "/blog/tag")
+
+(define (tags->pages posts)
+  "Return a list of pages for each tag used in POSTS, with said pages containing
+only the posts tagged with that tag."
+  (flat-map (match-lambda
+              ((tag . posts)
+               (items->pages render-preview posts
+                             (format #f "Posts tagged with \"~a\"" tag)
+                             (tag-uri %tag-prefix tag ""))))
+            (group-by-tag (sort posts (lambda (a b)
+                    (time<? (date->time-monotonic (post-date a)) (date->time-monotonic (post-date b))))) (cut post-ref <> 'tags))))
+
+(define (all-tags posts)
+  "Return a page summarizing tag usage across POSTS."
+  (define content
+    `((h1 "All Tags")
+      (ul (@ (id "tag-cloud"))
+          ,@(map (match-lambda
+                   ((tag count)
+                    (hyperlink (tag-uri %tag-prefix tag)
+                               `(li ,(format #f "~a (~a)" tag count)))))
+                 (count-tags posts (cut post-ref <> 'tags))))))
+  (serialized-artifact "tag.html"
+                       (theme #:title "All Tags"
+                              #:content content)
+                       sxml->html))
+
+
+;;;
+;;; Builder.
+;;;
+
+(define (blog)
+  "Return a Haunt build procedure to create permalinks and post listings for all
+of the 'post' objects associated with the site."
+  (lambda (site posts)
+    (append
+     ;; Permalinks.
+     (map post->page posts)
+
+     ;; Main post navigation.
+     (items->pages render-preview (posts/reverse-chronological posts)
+                   "Recent Posts" "index"
+                   #:enable-search #t)
+
+     ;; Tag-based navigation.
+     (list (all-tags posts))
+     (tags->pages posts))))
diff --git a/jakob/builder/blogroll.scm b/jakob/builder/blogroll.scm
new file mode 100644
index 0000000..59ce221
--- /dev/null
+++ b/jakob/builder/blogroll.scm
@@ -0,0 +1,136 @@
+;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob builder blogroll)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 match)
+  #:use-module (jakob theme)
+  #:use-module (jakob utils)
+  #:use-module (jakob utils sxml)
+  #:use-module (jakob utils tags)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:export (blogroll))
+
+;;; Commentary:
+;;;
+;;; This module manages pages for listing the blogs that I personally follow and
+;;; articles that I enjoyed reading.
+;;;
+;;; Code:
+
+
+;;;
+;;; Type for entries.
+;;;
+
+(define-record-type <entry>
+  (make-entry name uri tags comments)
+  entry?
+  (name     entry-name)
+  (uri      entry-uri)
+  (tags     entry-tags)
+  (comments entry-comments))
+
+(define entry
+  (match-lambda
+    ((name uri tags) (make-entry name uri tags #f))
+    ((name uri tags comments) (make-entry name uri tags comments))))
+
+
+;;;
+;;; Rendering.
+;;;
+
+(define* (render-preview name uri tags tag-prefix #:optional comments)
+  "Return an SHTML preview of an entry with the given parameters."
+  `(section
+    ,@(cons*
+       `(h2 ,(hyperlink uri name))
+       `(p
+         ,(intersperse
+           (map (lambda (tag)
+                  (hyperlink (tag-uri tag-prefix tag) tag))
+                tags)
+           ", "))
+       (or comments '()))))
+
+(define (render-tag-cloud prefix entries)
+  "Return SHTML listing the tags of ENTRIES in PREFIX with the number of times
+each tag is used."
+  `(ul (@ (id "tag-cloud"))
+       ,@(map (match-lambda
+                ((tag count)
+                 (hyperlink (tag-uri prefix tag)
+                            `(li ,(format #f "~a (~a)" tag count)))))
+              (count-tags entries entry-tags))))
+
+(define* (render-entries title prefix entries #:optional tag)
+  "Return an SHTML document listing ENTRIES in PREFIX, with a header of TITLE."
+  #<(main
+    (h1 ,(if tag
+             (format #f "~a - Tagged with \"~a\"" title tag)
+             title))
+    ,(unless tag (render-tag-cloud prefix entries))
+    ,(unless tag `(hr))
+    ,@(map (lambda (entry)
+             (render-preview (entry-name entry)
+                             (entry-uri entry)
+                             (entry-tags entry)
+                             prefix
+                             (entry-comments entry)))
+           entries)))
+
+(define (entries->pages title prefix entries)
+  "Return a page listing ENTRIES in PREFIX with a header of TITLE, as well as
+pages for each of the tags used in ENTRIES."
+  (cons
+   (serialized-artifact (string-append prefix "/index.html")
+                        (theme #:title title
+                               #:content (render-entries title prefix entries))
+                        sxml->html)
+   (map (match-lambda
+          ((tag . entries)
+           (serialized-artifact (tag-uri prefix tag)
+                                (theme #:title title
+                                       #:content (render-entries title prefix entries tag))
+                                sxml->html)))
+        (group-by-tag entries entry-tags))))
+
+
+
+;;;
+;;; Builder.
+;;;
+
+(define %blogroll
+  (list "Blogroll"
+        "/blogroll"
+        (map entry (primitive-load "data/blogroll.scm"))))
+
+(define %bookmarks
+  (list "Bookmarks"
+        "/bookmark"
+        (map entry (primitive-load "data/bookmarks.scm"))))
+
+(define (blogroll)
+  (lambda (site posts)
+    (flatten
+     (map (cut apply entries->pages <>)
+          (list %blogroll %bookmarks)))))
diff --git a/jakob/builder/cookbook.scm b/jakob/builder/cookbook.scm
new file mode 100644
index 0000000..7a916ca
--- /dev/null
+++ b/jakob/builder/cookbook.scm
@@ -0,0 +1,67 @@
+;;; Copyright © 2019 - 2024 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;;
+;; TODO
+;;
+;;; Code:
+
+(define-module (jakob builder cookbook)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt post)
+  #:use-module (haunt reader)
+  #:use-module (haunt site)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-11)
+  #:export (flat-pages))
+
+(define* (cookbook directory #:key template prefix)
+  ;; TODO: Document me
+  (lambda (site posts)
+    ;; Recursively scan the directory and generate a page for each
+    ;; file found.
+    (define (enter? file-name stat memo) #t)
+    (define (noop file-name stat memo) memo)
+    (define keep? (site-file-filter site))
+    (define (leaf file-name stat memo)
+      (if (keep? file-name) (cons file-name memo) memo))
+    (define (err file-name stat errno memo)
+      (error "flat page directory scanning failed" file-name errno))
+    (define src-files
+      (file-system-fold enter? leaf noop noop noop err '() directory))
+    ;; (define (strip-extension file-name)
+    ;;   (basename file-name
+    ;;             (string-append "." (file-extension file-name))))
+    ;; (map (lambda (file-name)
+    ;;        (match (reader-find (site-readers site) file-name)
+    ;;          (reader
+    ;;           (let-values (((metadata body) (reader-read reader file-name)))
+    ;;             (let* ((dir (substring (dirname file-name)
+    ;;                                    (string-length directory)))
+    ;;                    (out (string-append (or prefix "/") dir
+    ;;                                        (if (string-null? dir) "" "/")
+    ;;                                        (strip-extension file-name) ".html"))
+    ;;                    (title (or (assq-ref metadata 'title) "Untitled")))
+    ;;               (serialized-artifact out (template site title body)
+    ;;                                    sxml->html))))
+    ;;          (#f (error "no reader available for page" file-name))))
+    ;;      src-files)
+    ))
diff --git a/jakob/builder/flat-pages.scm b/jakob/builder/flat-pages.scm
new file mode 100644
index 0000000..e467219
--- /dev/null
+++ b/jakob/builder/flat-pages.scm
@@ -0,0 +1,86 @@
+;;; Haunt --- Static site generator for GNU Guile
+;;; Copyright © 2015 David Thompson <davet@gnu.org>
+;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
+;;; Copyright © 2024 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This file is part of Haunt.
+;;;
+;;; Haunt is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Haunt 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Haunt.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Simple static web pages.
+;;
+;;; Code:
+
+(define-module (jakob builder flat-pages)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (haunt post)
+  #:use-module (haunt reader)
+  #:use-module (haunt site)
+  #:use-module (haunt utils)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-11)
+  #:export (flat-pages))
+
+(define* (flat-pages directory #:key
+                     (strict #f)
+                     template
+                     prefix)
+  "Return a procedure that parses the files in DIRECTORY and returns a
+list of HTML pages, one for each file.  The files are parsed using the
+readers configured for the current site.  The structure of DIRECTORY
+is preserved in the resulting pages and may be optionally nested
+within the directory PREFIX.
+
+The content of each flat page is inserted into a complete HTML
+document by the TEMPLATE procedure.  This procedure takes three
+arguments: the site object, the page title string, and an SXML tree of
+the page body.  It returns one value: a new SXML tree representing a
+complete HTML page that presumably wraps the page body."
+  (lambda (site posts)
+    ;; Recursively scan the directory and generate a page for each
+    ;; file found.
+    (define (enter? file-name stat memo) #t)
+    (define (noop file-name stat memo) memo)
+    (define keep? (site-file-filter site))
+    (define (leaf file-name stat memo)
+      (if (keep? file-name) (cons file-name memo) memo))
+    (define (err file-name stat errno memo)
+      (error "flat page directory scanning failed" file-name errno))
+    (define src-files
+      (file-system-fold enter? leaf noop noop noop err '() directory))
+    (define (strip-extension file-name)
+      (basename file-name
+                (string-append "." (file-extension file-name))))
+    (define results
+      (map (lambda (file-name)
+             (match (reader-find (site-readers site) file-name)
+               (#f (when strict
+                     (error "no reader available for page" file-name))
+                   #f)
+               (reader
+                (let-values (((metadata body) (reader-read reader file-name)))
+                  (let* ((dir (substring (dirname file-name)
+                                         (string-length directory)))
+                         (out (string-append (or prefix "/") dir
+                                             (if (string-null? dir) "" "/")
+                                             (strip-extension file-name) ".html"))
+                         (title (or (assq-ref metadata 'title) "Untitled")))
+                    (serialized-artifact out (template site title body)
+                                         sxml->html))))))
+           src-files))
+    (filter artifact? results)))
diff --git a/jakob/builder/htaccess.scm b/jakob/builder/htaccess.scm
new file mode 100644
index 0000000..77d50fe
--- /dev/null
+++ b/jakob/builder/htaccess.scm
@@ -0,0 +1,50 @@
+;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob builder htaccess)
+  #:use-module (haunt artifact)
+  #:use-module (ice-9 match)
+  #:export (htaccess))
+
+;; Good resource:
+;; <https://perishablepress.com/stupid-htaccess-tricks/#ess4>
+
+(define* (htaccess-writer contents #:optional (port (current-output-port)))
+  (display (string-join contents "\n") port)
+  (newline port))
+
+(define* (htaccess #:key
+                   (error-documents '())
+                   (redirects '()))
+  "Create an .htaccess file at the site's root.
+
+ERROR-DOCUMENTS specifies the file name of the page to display for a specific
+HTTP error code: a list of (error-code . file-name) pairs.
+
+REDIRECTS specifies file names to show for certain requests: a list of (pattern
+. file-name) pairs."
+  (define contents
+    `(,@(map (match-lambda
+               ((code . file-name)
+                (format #f "ErrorDocument ~a ~a" code file-name)))
+             error-documents)
+      ,@(map (match-lambda
+               ((pattern . file-name)
+                (format #f "RewriteRule ~a ~a" pattern file-name)))
+             redirects)))
+
+  (lambda (site posts)
+    (serialized-artifact ".htaccess" contents htaccess-writer)))
diff --git a/jakob/builder/outbox.scm b/jakob/builder/outbox.scm
new file mode 100644
index 0000000..9bd5f75
--- /dev/null
+++ b/jakob/builder/outbox.scm
@@ -0,0 +1,155 @@
+;;; Copyright © 2019 - 2020 Jakob L. Kreuze <zerodaysfordays@sdf.org>
+;;;
+;;; This program is free software; you can redistribute it and/or
+;;; modify it under the terms of the GNU 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
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (jakob builder outbox)
+  #:use-module (haunt artifact)
+  #:use-module (haunt html)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (jakob theme)
+  #:use-module (jakob utils pagination)
+  #:use-module (jakob utils sxml)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-19)
+  #:export (outbox))
+
+;;; Commentary:
+;;;
+;;; My implementation of an "outbox" for sending comments via Webmention [1] to
+;;; sites that support it.
+;;;
+;;; [1]: https://webmention.net/
+;;;
+;;; Code:
+
+;; Prefix for all pages representing Webmention interactions.
+(define %outbox-prefix "/outbox")
+
+
+;;;
+;;; Profile.
+;;;
+
+(define %h-card
+  `(div (@ (class "u-author h-card"))
+        (img (@ (class "u-photo")
+                (src "/static/image/profile-picture.jpg")
+                (width "40")))
+        (a (@ (class "u-url p-name")
+              (href "http://jakob.space"))
+           "Jakob L. Kreuze")))
+
+
+;;;
+;;; Common rendering code.
+;;;
+
+(define (datetime uri date)
+  `(p (a (@ (class "u-url") (href ,uri))
+         (time (@ (class "dt-published")
+                  (datetime ,(date->string date "~4")))
+               ,(date->string date "~B ~e, ~Y")))))
+
+
+;;;
+;;; Record type for replies -- by far, my most frequently-used type of
+;;; Webmention response.
+;;;
+
+(define-record-type <reply>
+  (make-reply content date target-uri target-handle)
+  reply?
+  (content reply-content)
+  (date reply-date)
+  (target-uri reply-target-uri)
+  (target-handle reply-target-handle))
+
+(define (reply-uri reply)
+  (let* ((date (date->string (reply-date reply) "~Y-~m-~d-~H:~M:~S"))
+         (target (reply-target-handle reply))
+         (slug (format #f "reply-~a-~a" target date)))
+    (string-append %outbox-prefix "/" slug ".html")))
+
+(define reply
+  (match-lambda
+    ((target-uri target-handle date-string content)
+     (let ((date (string->date date-string "~Y-~m-~dT~H:~M:~S~z")))
+       (make-reply content date target-uri target-handle)))))
+
+
+;;;
+;;; Reply rendering.
+;;;
+
+(define (render-reply reply)
+  (let ((content (cons* (car (reply-content reply))
+                        `(@ (class "e-content"))
+                        (cdr (reply-content reply)))))
+    `(div (@ (class "h-entry"))
+          ,%h-card
+          (p "In reply to: "
+             (a (@ (class "u-in-reply-to")
+                   (href ,(reply-target-uri reply)))
+                ,(reply-target-handle reply)))
+          ,content
+          ,(datetime (reply-uri reply) (reply-date reply)))))
+
+(define (render-preview reply)
+  (let* ((simple-text? (eqv? 'p (car (reply-content reply))))
+         (truncated? (and simple-text?
+                          (> (length (cdr (reply-content reply))) 80)))
+         (preview (if simple-text?
+                      (if truncated?
+                          (format #f "~a..."
+                                  (substring (cdr (reply-content reply))
+                                             0 80))
+                          (cdr (reply-content reply)))
+                      "[No preview available...]")))
+    `(section
+      (h2 ,(hyperlink
+            (reply-uri reply)
+            (format #f "Reply directed towards ~a on ~a"
+                    (reply-target-handle reply)
+                    (date->string (reply-date reply) "~B ~e, ~Y"))))
+      (p ,preview))))
+
+(define (reply->page reply)
+  (let ((title (format #f "Reply to ~a" (reply-target-handle reply))))
+    (serialized-artifact (reply-uri reply)
+                         (theme #:title title
+                                ;; #:description (first-paragraph post)
+                                ;; #:keywords (post-ref post 'tags)
+                                #:content (render-reply reply))
+                         sxml->html)))
+
+
+;;;
+;;; Builder.
+;;;
+
+(define (outbox)
+  (let ((replies (map reply (primitive-load "data/replies.scm"))))
+    (lambda (site posts)
+      (append
+       ;; Permalinks.
+       (map reply->page replies)
+
+       ;; Outbox listing.
+       (items->pages render-preview
+                     (reverse replies)
+                     "Webmentions"
+                     (string-append %outbox-prefix "/" "index")
+                     #:items-per-page 50)))))