Initial import

private/auth.rkt

@@ -0,0 +1,317 @@
+#lang racket/base
+
+(require crypto
+         crypto/libcrypto
+         db
+         racket/list
+         racket/string
+         web-server/http/cookie-parse
+         "config.rkt"
+         "database.rkt")
+
+(provide (struct-out wiki-user)
+         (struct-out wiki-session)
+         authenticate-user
+         create-session!
+         delete-session!
+         session-from-request
+         csrf-valid?
+         role-at-least?
+         list-users
+         administrator-exists?
+         create-user!
+         upsert-user!
+         update-user!
+         delete-user!)
+
+(struct wiki-user (id username display-name role enabled?) #:transparent)
+(struct wiki-session (user csrf-token expires-at token) #:transparent)
+
+(crypto-factories (list libcrypto-factory))
+
+(define role-order
+  (hash 'reader 10
+        'editor 20
+        'admin 30))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check whether a user has a required role level.
+; pre    : required-role is reader, editor or admin; user is a wiki-user or #f.
+; post   : No external state has been changed.
+; result : #t when the user has the required role level, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (role-at-least? user required-role)
+  (and user
+       (>= (hash-ref role-order (wiki-user-role user) 0)
+           (hash-ref role-order required-role 100))))
+
+(define (bytes->hex value)
+  (apply string-append
+         (for/list ([byte (in-bytes value)])
+           (define hex (number->string byte 16))
+           (if (= (string-length hex) 1)
+               (string-append "0" hex)
+               hex))))
+
+(define (random-token [size 32])
+  (bytes->hex (crypto-random-bytes size)))
+
+(define (token-hash token)
+  (bytes->hex (digest 'sha256 (string->bytes/utf-8 token))))
+
+(define (password-hash password)
+  (pwhash '(pbkdf2 hmac sha256)
+          (string->bytes/utf-8 password)
+          '((iterations 600000))))
+
+(define (password-valid? password stored-hash)
+  (with-handlers ((exn:fail? (λ (_e) #f)))
+    (pwhash-verify #f (string->bytes/utf-8 password) stored-hash)))
+
+(define (row->user row)
+  (wiki-user (vector-ref row 0)
+             (vector-ref row 1)
+             (vector-ref row 2)
+             (string->symbol (vector-ref row 3))
+             (vector-ref row 4)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Authenticate an enabled wiki user.
+; pre    : username and password are strings.
+; post   : The user database has only been read.
+; result : A wiki-user on success, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (authenticate-user config username password)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (define row
+       (query-maybe-row
+        db
+        "SELECT id, username, display_name, role, enabled, password_hash FROM users WHERE username = $1"
+        username))
+     (cond
+       ((not row) #f)
+       ((not (vector-ref row 4)) #f)
+       ((not (password-valid? password (vector-ref row 5))) #f)
+       (else
+        (wiki-user (vector-ref row 0)
+                   (vector-ref row 1)
+                   (vector-ref row 2)
+                   (string->symbol (vector-ref row 3))
+                   #t))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a login session for a user.
+; pre    : user is an enabled wiki-user.
+; post   : A hashed session token and CSRF token have been stored in PostgreSQL.
+; result : A wiki-session containing the client session token.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (create-session! config user)
+  (define token (random-token))
+  (define csrf-token (random-token 24))
+  (define now (current-seconds))
+  (define expires-at (+ now (wiki-config-session-seconds config)))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec db
+                 "INSERT INTO sessions(token_hash, user_id, csrf_token, created_at, expires_at) VALUES ($1, $2, $3, $4, $5)"
+                 (token-hash token)
+                 (wiki-user-id user)
+                 csrf-token
+                 now
+                 expires-at)))
+  (wiki-session user csrf-token expires-at token))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Delete a login session.
+; pre    : token is a session token string or #f.
+; post   : The matching stored session has been deleted when token was supplied.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (delete-session! config token)
+  (when token
+    (call-with-wiki-database
+     config
+     (λ (db)
+       (query-exec db
+                   "DELETE FROM sessions WHERE token_hash = $1"
+                   (token-hash token))))))
+
+(define (session-cookie-token req)
+  (define cookie
+    (findf (λ (candidate)
+             (string=? (client-cookie-name candidate) "racket-wiki-session"))
+           (request-cookies req)))
+  (if cookie
+      (client-cookie-value cookie)
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve an authenticated session from a request cookie.
+; pre    : req is a web-server request.
+; post   : The user and session tables have only been read.
+; result : A non-expired wiki-session for an enabled user, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (session-from-request config req)
+  (define token (session-cookie-token req))
+  (if token
+      (call-with-wiki-database
+       config
+       (λ (db)
+         (define row
+           (query-maybe-row
+            db
+            #<<SQL
+SELECT u.id, u.username, u.display_name, u.role, u.enabled,
+       s.csrf_token, s.expires_at
+FROM sessions s
+JOIN users u ON u.id = s.user_id
+WHERE s.token_hash = $1 AND s.expires_at > $2 AND u.enabled = TRUE
+SQL
+            (token-hash token)
+            (current-seconds)))
+         (if row
+             (wiki-session
+              (wiki-user (vector-ref row 0)
+                         (vector-ref row 1)
+                         (vector-ref row 2)
+                         (string->symbol (vector-ref row 3))
+                         (vector-ref row 4))
+              (vector-ref row 5)
+              (vector-ref row 6)
+              token)
+             #f)))
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate a CSRF token for a session.
+; pre    : session is a wiki-session or #f and csrf-token is a string or #f.
+; post   : No external state has been changed.
+; result : #t when the supplied token belongs to the session, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (csrf-valid? session csrf-token)
+  (and session
+       csrf-token
+       (string=? csrf-token (wiki-session-csrf-token session))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List wiki users.
+; pre    : The user database is initialized.
+; post   : The user table has only been read.
+; result : A username-sorted list of wiki-user values.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (list-users config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (for/list ([row (in-list (query-rows db
+                                         "SELECT id, username, display_name, role, enabled FROM users ORDER BY username"))])
+       (row->user row)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check whether at least one enabled administrator exists.
+; pre    : The user database is initialized.
+; post   : The user table has only been read.
+; result : #t when an enabled administrator exists, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (administrator-exists? config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (> (query-value db
+                     "SELECT COUNT(*) FROM users WHERE role = 'admin' AND enabled = TRUE")
+        0))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a wiki user.
+; pre    : username is unused and role/status are supported symbols.
+; post   : The new user and password hash have been stored.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (create-user! config username display-name password role status)
+  (define now (current-seconds))
+  (define enabled (eq? status 'enabled))
+  (define hash (password-hash password))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec
+      db
+      "INSERT INTO users(username, display_name, password_hash, role, enabled, created_at, updated_at) VALUES ($1, $2, $3, $4, $5, $6, $7)"
+      username
+      display-name
+      hash
+      (symbol->string role)
+      enabled
+      now
+      now))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create or reset a wiki user by username.
+; pre    : role/status are supported symbols.
+; post   : The named user exists with the supplied display name, password, role and status.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (upsert-user! config username display-name password role status)
+  (define now (current-seconds))
+  (define enabled (eq? status 'enabled))
+  (define hash (password-hash password))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec
+      db
+      #<<SQL
+INSERT INTO users(username, display_name, password_hash, role, enabled, created_at, updated_at)
+VALUES ($1, $2, $3, $4, $5, $6, $7)
+ON CONFLICT(username) DO UPDATE SET
+  display_name = excluded.display_name,
+  password_hash = excluded.password_hash,
+  role = excluded.role,
+  enabled = excluded.enabled,
+  updated_at = excluded.updated_at
+SQL
+      username display-name hash (symbol->string role) enabled now now))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Update a wiki user.
+; pre    : id identifies a user and role/status are supported symbols.
+; post   : Display name, role and status are updated; a non-empty password replaces the password hash.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (update-user! config id display-name role status [password #f])
+  (define enabled (eq? status 'enabled))
+  (define now (current-seconds))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (if (and password (not (string=? password "")))
+         (query-exec db
+                     "UPDATE users SET display_name = $1, role = $2, enabled = $3, password_hash = $4, updated_at = $5 WHERE id = $6"
+                     display-name
+                     (symbol->string role)
+                     enabled
+                     (password-hash password)
+                     now
+                     id)
+         (query-exec db
+                     "UPDATE users SET display_name = $1, role = $2, enabled = $3, updated_at = $4 WHERE id = $5"
+                     display-name
+                     (symbol->string role)
+                     enabled
+                     now
+                     id)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Delete a wiki user.
+; pre    : id identifies a possible user.
+; post   : The user and cascading sessions have been deleted when present.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (delete-user! config id)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec db "DELETE FROM users WHERE id = $1" id))))

private/config.rkt

@@ -0,0 +1,73 @@
+#lang racket/base
+
+(require racket/path
+         racket/runtime-path)
+
+(provide (struct-out wiki-config)
+         make-wiki-config
+         default-wiki-config
+         static-directory
+         uploads-directory
+         deleted-directory
+         data-static-directory
+         vendor-directory
+         database-config-path
+         language-config-path)
+
+(struct wiki-config (data-dir
+                     port
+                     listen-ip
+                     secure-cookie?
+                     site-title
+                     session-seconds
+                     language)
+  #:transparent)
+
+(define-runtime-path static-directory "../static")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a wiki configuration.
+; pre    : data-dir is a path string, port is a port number and listen-ip is
+;         an IP address string, "*" or #f.
+; post   : No files or settings have been changed.
+; result : A wiki-config value with a complete data directory path.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (make-wiki-config #:data-dir [data-dir "wiki-data"]
+                          #:port [port 8080]
+                          #:listen-ip [listen-ip "127.0.0.1"]
+                          #:secure-cookie? [secure-cookie? #f]
+                          #:site-title [site-title "Racket Wiki"]
+                          #:session-seconds [session-seconds (* 12 60 60)]
+                          #:language [language "en"])
+  (define normalized-listen-ip
+    (if (equal? listen-ip "*")
+        #f
+        listen-ip))
+  (wiki-config (path->complete-path data-dir)
+               port
+               normalized-listen-ip
+               secure-cookie?
+               site-title
+               session-seconds
+               language))
+
+(define (default-wiki-config)
+  (make-wiki-config))
+
+(define (uploads-directory config)
+  (build-path (wiki-config-data-dir config) "uploads"))
+
+(define (deleted-directory config)
+  (build-path (wiki-config-data-dir config) "deleted"))
+
+(define (data-static-directory config)
+  (build-path (wiki-config-data-dir config) "static"))
+
+(define (vendor-directory config)
+  (build-path (data-static-directory config) "vendor"))
+
+(define (database-config-path config)
+  (build-path (wiki-config-data-dir config) "database.rktd"))
+
+(define (language-config-path config)
+  (build-path (wiki-config-data-dir config) "language.rktd"))

private/database.rkt

@@ -0,0 +1,126 @@
+#lang racket/base
+
+(require db
+         racket/file
+         racket/port
+         "config.rkt"
+         "migrations.rkt")
+
+(provide (struct-out database-settings)
+         database-settings-exist?
+         read-database-settings
+         write-database-settings!
+         test-database-settings!
+         call-with-wiki-database
+         initialize-database!
+         initialize-database-with-settings!
+         database-ready?)
+
+(struct database-settings (server port database user password ssl) #:transparent)
+
+(define (database-settings-exist? config)
+  (file-exists? (database-config-path config)))
+
+(define (settings->datum settings)
+  (hash 'server (database-settings-server settings)
+        'port (database-settings-port settings)
+        'database (database-settings-database settings)
+        'user (database-settings-user settings)
+        'password (database-settings-password settings)
+        'ssl (database-settings-ssl settings)))
+
+(define (datum->settings value)
+  (database-settings (hash-ref value 'server "localhost")
+                     (hash-ref value 'port 5432)
+                     (hash-ref value 'database "racket_wiki")
+                     (hash-ref value 'user "")
+                     (hash-ref value 'password "")
+                     (hash-ref value 'ssl 'no)))
+
+(define (read-database-settings config)
+  (and (database-settings-exist? config)
+       (call-with-input-file (database-config-path config)
+         (λ (in)
+           (datum->settings (read in))))))
+
+(define (write-database-settings! config settings)
+  (make-directory* (wiki-config-data-dir config))
+  (call-with-output-file (database-config-path config)
+    (λ (out)
+      (write (settings->datum settings) out)
+      (newline out))
+    #:exists 'truncate/replace)
+  (with-handlers ((exn:fail? (λ (_e) (void))))
+    (file-or-directory-permissions (database-config-path config) #o600))
+  (void))
+
+(define (connect settings)
+  (define password
+    (if (string=? (database-settings-password settings) "")
+        #f
+        (database-settings-password settings)))
+  (postgresql-connect #:server (database-settings-server settings)
+                      #:port (database-settings-port settings)
+                      #:database (database-settings-database settings)
+                      #:user (database-settings-user settings)
+                      #:password password
+                      #:ssl (database-settings-ssl settings)))
+
+(define (test-database-settings! settings)
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (query-value db "SELECT 1"))
+   (λ () (disconnect db)))
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run a procedure with a fresh PostgreSQL connection.
+; pre    : PostgreSQL settings have been saved and proc accepts one connection.
+; post   : The connection is closed after proc returns or raises.
+; result : The value returned by proc.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (call-with-wiki-database config proc)
+  (define settings (read-database-settings config))
+  (unless settings
+    (error 'call-with-wiki-database "PostgreSQL is not configured"))
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (proc db))
+   (λ () (disconnect db))))
+
+(define (initialize-on-connection! db config)
+  (migrate-database! db config)
+  (query-exec db "DELETE FROM sessions WHERE expires_at <= $1" (current-seconds))
+  (void))
+
+(define (initialize-database-with-settings! settings config)
+  (define db (connect settings))
+  (dynamic-wind
+   void
+   (λ () (initialize-on-connection! db config))
+   (λ () (disconnect db))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Initialize the PostgreSQL schema used by racket-wiki.
+; pre    : Valid PostgreSQL settings have been saved.
+; post   : All wiki tables and indexes exist and expired sessions are removed.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (initialize-database! config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (initialize-on-connection! db config))))
+
+(define (database-ready? config)
+  (and (database-settings-exist? config)
+       (with-handlers ((exn:fail? (λ (_e) #f)))
+         (call-with-wiki-database
+          config
+          (λ (db)
+            (and (query-value db "SELECT to_regclass('public.users') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.pages') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.page_versions') IS NOT NULL")
+                 (query-value db "SELECT to_regclass('public.sessions') IS NOT NULL")))))))

private/http-util.rkt

@@ -0,0 +1,128 @@
+#lang racket/base
+
+(require json
+         racket/string
+         web-server/http
+         web-server/http/json
+         web-server/http/xexpr)
+
+(provide json-response
+         json-error
+         html-response
+         redirect-response
+         request-json
+         request-header/string
+         bytes-response
+         extension->mime)
+
+(define security-headers
+  (list (make-header #"X-Content-Type-Options" #"nosniff")
+        (make-header #"Referrer-Policy" #"same-origin")
+        (make-header #"Content-Security-Policy"
+                     #"default-src 'self'; img-src 'self' data:; style-src 'self' 'unsafe-inline'; script-src 'self'; connect-src 'self'; object-src 'none'; base-uri 'self'; form-action 'self'; frame-ancestors 'none'")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a JSON HTTP response with the standard security headers.
+; pre    : value is JSON encodable and headers contains HTTP headers.
+; post   : No external state has been changed.
+; result : An HTTP response value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (json-response value #:code [code 200] #:headers [headers '()])
+  (response/jsexpr value
+                   #:code code
+                   #:headers (append security-headers headers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a JSON error response.
+; pre    : code is an HTTP status code and message is displayable JSON text.
+; post   : No external state has been changed.
+; result : An HTTP JSON response containing ok = #f and the error message.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (json-error code message)
+  (json-response (hash 'ok #f 'error message) #:code code))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create an HTML response from an X-expression.
+; pre    : value is a valid X-expression and headers contains HTTP headers.
+; post   : No external state has been changed.
+; result : An HTTP HTML response with the standard security headers.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (html-response value #:code [code 200] #:headers [headers '()])
+  (response/xexpr value
+                  #:code code
+                  #:headers (append security-headers headers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a no-cache HTTP redirect response.
+; pre    : location is an absolute-path URL string for this server and headers
+;          contains optional response headers.
+; post   : No external state has been changed.
+; result : An HTTP 303 response with a Location header and the supplied headers.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (redirect-response location #:headers [headers '()])
+  (response/full 303
+                 #"See Other"
+                 (current-seconds)
+                 #"text/plain; charset=utf-8"
+                 (append security-headers
+                         headers
+                         (list (make-header #"Location"
+                                            (string->bytes/utf-8 location))
+                               (make-header #"Cache-Control" #"no-store")))
+                 (list #"")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Decode the JSON request body.
+; pre    : req is a web-server request whose body is empty or valid JSON.
+; post   : The request has only been inspected.
+; result : The decoded JSON value, or an empty hash for an empty body.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (request-json req)
+  (define body (request-post-data/raw req))
+  (if body
+      (bytes->jsexpr body)
+      (hash)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read a request header as UTF-8 text.
+; pre    : req is a web-server request and name is a header name string.
+; post   : The request has only been inspected.
+; result : The header value as a string, or #f when absent.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (request-header/string req name)
+  (define found
+    (headers-assq* (string->bytes/utf-8 name)
+                   (request-headers/raw req)))
+  (and found
+       (bytes->string/utf-8 (header-value found))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create an HTTP response containing bytes.
+; pre    : bytes is the response body, mime is a MIME byte string and headers contains HTTP headers.
+; post   : No external state has been changed.
+; result : An HTTP response value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (bytes-response bytes mime #:headers [headers '()])
+  (response/full 200
+                 #f
+                 (current-seconds)
+                 mime
+                 (append security-headers headers)
+                 (list bytes)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Map a supported filename extension to a MIME type.
+; pre    : filename is a string.
+; post   : No external state has been changed.
+; result : A MIME byte string; application/octet-stream when the extension is unknown.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (extension->mime filename)
+  (define lower (string-downcase filename))
+  (cond
+    ((regexp-match? #px"[.]png$" lower) #"image/png")
+    ((regexp-match? #px"[.](jpg|jpeg)$" lower) #"image/jpeg")
+    ((regexp-match? #px"[.]gif$" lower) #"image/gif")
+    ((regexp-match? #px"[.]webp$" lower) #"image/webp")
+    ((regexp-match? #px"[.]pdf$" lower) #"application/pdf")
+    ((regexp-match? #px"[.]txt$" lower) #"text/plain; charset=utf-8")
+    (else #"application/octet-stream")))

private/migrations.rkt

@@ -0,0 +1,244 @@
+#lang racket/base
+
+(require db
+         racket/file
+         racket/path
+         racket/string
+         "config.rkt"
+         "todo.rkt")
+
+(provide current-schema-version
+         database-schema-version
+         migrate-database!)
+
+(define current-schema-version 3)
+
+(define schema-1-statements
+  (list
+   #<<SQL
+CREATE TABLE IF NOT EXISTS users (
+  id BIGSERIAL PRIMARY KEY,
+  username TEXT NOT NULL UNIQUE,
+  display_name TEXT NOT NULL,
+  password_hash TEXT NOT NULL,
+  role TEXT NOT NULL CHECK(role IN ('reader', 'editor', 'admin')),
+  enabled BOOLEAN NOT NULL DEFAULT TRUE,
+  created_at BIGINT NOT NULL,
+  updated_at BIGINT NOT NULL
+)
+SQL
+   #<<SQL
+CREATE TABLE IF NOT EXISTS sessions (
+  token_hash TEXT PRIMARY KEY,
+  user_id BIGINT NOT NULL REFERENCES users(id) ON DELETE CASCADE,
+  csrf_token TEXT NOT NULL,
+  created_at BIGINT NOT NULL,
+  expires_at BIGINT NOT NULL
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS sessions_expires_idx ON sessions(expires_at)"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS pages (
+  id BIGSERIAL PRIMARY KEY,
+  slug TEXT NOT NULL UNIQUE,
+  title TEXT NOT NULL,
+  markdown TEXT NOT NULL,
+  tags TEXT NOT NULL DEFAULT '[]',
+  current_version BIGINT NOT NULL DEFAULT 1,
+  created_at BIGINT NOT NULL,
+  updated_at BIGINT NOT NULL,
+  created_by TEXT NOT NULL,
+  updated_by TEXT NOT NULL,
+  archived BOOLEAN NOT NULL DEFAULT FALSE,
+  archived_at BIGINT,
+  archived_by TEXT,
+  search_document TSVECTOR NOT NULL
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS pages_search_idx ON pages USING GIN(search_document)"
+   "CREATE INDEX IF NOT EXISTS pages_title_idx ON pages(lower(title))"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS page_versions (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  version BIGINT NOT NULL,
+  title TEXT NOT NULL,
+  markdown TEXT NOT NULL,
+  tags TEXT NOT NULL DEFAULT '[]',
+  author TEXT NOT NULL,
+  action TEXT NOT NULL,
+  summary TEXT NOT NULL,
+  created_at BIGINT NOT NULL,
+  UNIQUE(page_id, version)
+)
+SQL
+   "CREATE INDEX IF NOT EXISTS page_versions_page_idx ON page_versions(page_id, version DESC)"
+   #<<SQL
+CREATE TABLE IF NOT EXISTS attachments (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  original_name TEXT NOT NULL,
+  stored_name TEXT NOT NULL,
+  size BIGINT NOT NULL,
+  uploaded_at BIGINT NOT NULL,
+  uploaded_by TEXT NOT NULL,
+  UNIQUE(page_id, stored_name)
+)
+SQL
+   ))
+
+(define (table-exists? db name)
+  (if (query-maybe-value db "SELECT to_regclass($1) IS NOT NULL" (string-append "public." name))
+      #t
+      #f))
+
+(define (ensure-schema-table! db)
+  (query-exec db
+              #<<SQL
+CREATE TABLE IF NOT EXISTS wiki_schema (
+  version INTEGER PRIMARY KEY,
+  applied_at BIGINT NOT NULL
+)
+SQL
+              ))
+
+(define (database-schema-version db)
+  (if (table-exists? db "wiki_schema")
+      (query-value db "SELECT COALESCE(MAX(version), 0) FROM wiki_schema")
+      0))
+
+(define (record-schema-version! db version)
+  (query-exec db
+              "INSERT INTO wiki_schema(version, applied_at) VALUES ($1, $2) ON CONFLICT (version) DO NOTHING"
+              version
+              (current-seconds)))
+
+(define (recognize-schema-1? db)
+  (and (table-exists? db "users")
+       (table-exists? db "sessions")
+       (table-exists? db "pages")
+       (table-exists? db "page_versions")
+       (table-exists? db "attachments")))
+
+(define (install-schema-1! db)
+  (for ((statement (in-list schema-1-statements)))
+    (query-exec db statement))
+  (ensure-schema-table! db)
+  (record-schema-version! db 1))
+
+(define (recognize-or-install-schema-1! db)
+  (cond
+    ((table-exists? db "wiki_schema")
+     (void))
+    ((recognize-schema-1? db)
+     (ensure-schema-table! db)
+     (record-schema-version! db 1))
+    (else
+     (install-schema-1! db))))
+
+(define (legacy-mime-type stored-name)
+  (define lower (string-downcase stored-name))
+  (cond
+    ((regexp-match? #px"[.]png$" lower) "image/png")
+    ((regexp-match? #px"[.](jpg|jpeg)$" lower) "image/jpeg")
+    ((regexp-match? #px"[.]gif$" lower) "image/gif")
+    ((regexp-match? #px"[.]webp$" lower) "image/webp")
+    ((regexp-match? #px"[.]pdf$" lower) "application/pdf")
+    ((regexp-match? #px"[.]txt$" lower) "text/plain; charset=utf-8")
+    (else "application/octet-stream")))
+
+(define (migrate-1->2! db config)
+  (query-exec db "ALTER TABLE attachments ADD COLUMN IF NOT EXISTS mime_type TEXT")
+  (query-exec db "ALTER TABLE attachments ADD COLUMN IF NOT EXISTS content BYTEA")
+  (define rows
+    (query-rows db
+                #<<SQL
+SELECT a.id, p.slug, a.stored_name, a.content
+FROM attachments a
+JOIN pages p ON p.id = a.page_id
+ORDER BY a.id
+SQL
+                ))
+  (for ((row (in-list rows)))
+    (define attachment-id (vector-ref row 0))
+    (define slug (vector-ref row 1))
+    (define stored-name (vector-ref row 2))
+    (define content (vector-ref row 3))
+    (unless (bytes? content)
+      (define path (build-path (uploads-directory config) slug stored-name))
+      (unless (file-exists? path)
+        (error 'migrate-database!
+               "schema 1 -> 2 cannot migrate attachment ~a: missing file ~a"
+               stored-name
+               (path->string path)))
+      (define bytes (file->bytes path))
+      (query-exec db
+                  "UPDATE attachments SET content = $1, mime_type = $2, size = $3 WHERE id = $4"
+                  bytes
+                  (legacy-mime-type stored-name)
+                  (bytes-length bytes)
+                  attachment-id)))
+  (query-exec db "UPDATE attachments SET mime_type = 'application/octet-stream' WHERE mime_type IS NULL")
+  (query-exec db "ALTER TABLE attachments ALTER COLUMN mime_type SET NOT NULL")
+  (query-exec db "ALTER TABLE attachments ALTER COLUMN content SET NOT NULL")
+  (record-schema-version! db 2))
+
+
+(define (replace-page-todos! db page-id markdown)
+  (query-exec db "DELETE FROM todo_items WHERE page_id = $1" page-id)
+  (for ((item (in-list (extract-todos markdown))))
+    (query-exec db
+                #<<SQL
+INSERT INTO todo_items(page_id, item_number, line_number, text)
+VALUES ($1, $2, $3, $4)
+SQL
+                page-id
+                (hash-ref item 'number)
+                (hash-ref item 'line)
+                (hash-ref item 'text))))
+
+(define (migrate-2->3! db)
+  (query-exec db
+              #<<SQL
+CREATE TABLE IF NOT EXISTS todo_items (
+  id BIGSERIAL PRIMARY KEY,
+  page_id BIGINT NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
+  item_number INTEGER NOT NULL,
+  line_number INTEGER NOT NULL,
+  text TEXT NOT NULL,
+  UNIQUE(page_id, item_number)
+)
+SQL
+              )
+  (query-exec db "CREATE INDEX IF NOT EXISTS todo_items_page_idx ON todo_items(page_id, item_number)")
+  (for ((row (in-list (query-rows db "SELECT id, markdown FROM pages WHERE archived = FALSE"))))
+    (replace-page-todos! db (vector-ref row 0) (vector-ref row 1)))
+  (record-schema-version! db 3))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Bring a racket-wiki PostgreSQL database to the current schema.
+; pre    : db is a writable PostgreSQL connection and config identifies the
+;          data directory used by older racket-wiki versions.
+; post   : Every required migration has been applied in order and recorded.
+; result : The resulting schema version.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (migrate-database! db config)
+  (call-with-transaction
+   db
+   (λ ()
+     (recognize-or-install-schema-1! db)
+     (define version (database-schema-version db))
+     (when (< version 1)
+       (error 'migrate-database! "unable to determine the existing wiki database schema"))
+     (when (= version 1)
+       (migrate-1->2! db config))
+     (define after-attachments (database-schema-version db))
+     (when (= after-attachments 2)
+       (migrate-2->3! db))
+     (define resulting-version (database-schema-version db))
+     (when (> resulting-version current-schema-version)
+       (error 'migrate-database!
+              "database schema ~a is newer than this racket-wiki supports (~a)"
+              resulting-version
+              current-schema-version))
+     resulting-version)))

private/setup.rkt

@@ -0,0 +1,337 @@
+#lang racket/base
+
+(require crypto
+         net/uri-codec
+         racket/path
+         racket/string
+         web-server/http
+         "auth.rkt"
+         "config.rkt"
+         "database.rkt"
+         "http-util.rkt"
+         "vendor.rkt"
+         "../translate.rkt")
+
+(provide setup-complete?
+         setup-handler)
+
+(define setup-lock (make-semaphore 1))
+
+(define (bytes->hex value)
+  (apply string-append
+         (for/list ((byte (in-bytes value)))
+           (define hex (number->string byte 16))
+           (if (= (string-length hex) 1)
+               (string-append "0" hex)
+               hex))))
+
+(define setup-form-token
+  (bytes->hex (crypto-random-bytes 32)))
+
+(define (admin-ready? config)
+  (and (database-ready? config)
+       (with-handlers ((exn:fail? (λ (_e) #f)))
+         (administrator-exists? config))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check whether the wiki has everything required for normal use.
+; pre    : The data directory is accessible.
+; post   : PostgreSQL configuration/schema and vendor files have only been inspected.
+; result : #t when PostgreSQL, an administrator and browser libraries are ready.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (setup-complete? config)
+  (and (database-ready? config)
+       (admin-ready? config)
+       (vendor-files-ready? config)))
+
+(define (request-form req)
+  (define body (request-post-data/raw req))
+  (if body
+      (form-urlencoded->alist (bytes->string/utf-8 body))
+      '()))
+
+(define (form-value form key [default ""])
+  (define found (assoc key form))
+  (if (and found (cdr found))
+      (cdr found)
+      default))
+
+(define setup-style
+  #<<CSS
+html { box-sizing: border-box; font-family: system-ui, -apple-system, BlinkMacSystemFont, "Segoe UI", sans-serif; color: #172033; background: #f4f6f8; }
+*, *::before, *::after { box-sizing: inherit; }
+body { margin: 0; min-height: 100vh; display: grid; place-items: center; padding: 32px; }
+.setup { width: min(700px, 100%); background: white; border: 1px solid #d7dde5; border-radius: 14px; padding: 34px; box-shadow: 0 12px 40px rgba(22, 32, 51, 0.08); }
+h1 { margin: 0 0 10px; font-size: 2rem; }
+h2 { margin: 28px 0 8px; font-size: 1.15rem; }
+p { line-height: 1.55; }
+.status { margin: 24px 0; padding: 0; list-style: none; border-top: 1px solid #e3e7ed; }
+.status li { display: flex; justify-content: space-between; gap: 20px; padding: 12px 0; border-bottom: 1px solid #e3e7ed; }
+.ready { color: #286b3d; font-weight: 600; }
+.pending { color: #8b5d00; font-weight: 600; }
+.fields { display: grid; grid-template-columns: 1fr 140px; gap: 0 14px; }
+.fields .wide { grid-column: 1 / -1; }
+label { display: block; margin: 12px 0; font-weight: 600; }
+input, select { display: block; width: 100%; margin-top: 6px; padding: 10px 12px; font: inherit; border: 1px solid #aeb7c4; border-radius: 6px; background: white; }
+button { margin-top: 18px; padding: 10px 18px; font: inherit; font-weight: 600; cursor: pointer; }
+.error { margin: 18px 0; padding: 12px 14px; background: #fff1f1; border: 1px solid #e8b7b7; border-radius: 6px; color: #8b1f1f; white-space: pre-wrap; }
+.note { color: #5b6472; font-size: 0.94rem; }
+code { background: #f2f4f7; padding: 2px 5px; border-radius: 4px; }
+@media (max-width: 620px) { .fields { grid-template-columns: 1fr; } .fields .wide { grid-column: auto; } }
+CSS
+  )
+
+(define (status-row label ready? ready-text pending-text)
+  `(li
+    (span ,label)
+    (span ((class ,(if ready? "ready" "pending")))
+          ,(if ready? ready-text pending-text))))
+
+(define (setting-value settings getter default)
+  (if settings (getter settings) default))
+
+
+(define (language-field config [form '()])
+  (define language (form-value form 'language (current-language config)))
+  `((label
+     ,(tr config 'language)
+     (select ((name "language"))
+       (option ((value "en") ,@(if (string-ci=? language "en") '((selected "selected")) '())) ,(tr config 'language-en))
+       (option ((value "nl") ,@(if (string-ci=? language "nl") '((selected "selected")) '())) ,(tr config 'language-nl))))))
+
+(define (database-fields config [form '()])
+  (define settings (read-database-settings config))
+  (define ssl-text
+    (form-value form
+                'db-ssl
+                (symbol->string (setting-value settings database-settings-ssl 'no))))
+  (define ssl (string->symbol ssl-text))
+  `((h2 ,(tr config 'postgresql))
+    (div ((class "fields"))
+      (label
+       ,(tr config 'server)
+       (input ((name "db-server")
+               (value ,(form-value form 'db-server (setting-value settings database-settings-server "localhost")))
+               (required "required"))))
+      (label
+       ,(tr config 'port)
+       (input ((name "db-port")
+               (type "number")
+               (min "1")
+               (max "65535")
+               (value ,(form-value form 'db-port (number->string (setting-value settings database-settings-port 5432))))
+               (required "required"))))
+      (label ((class "wide"))
+       ,(tr config 'database)
+       (input ((name "db-database")
+               (value ,(form-value form 'db-database (setting-value settings database-settings-database "racket_wiki")))
+               (required "required"))))
+      (label ((class "wide"))
+       ,(tr config 'user)
+       (input ((name "db-user")
+               (autocomplete "username")
+               (value ,(form-value form 'db-user (setting-value settings database-settings-user "")))
+               (required "required"))))
+      (label ((class "wide"))
+       ,(tr config 'password)
+       (input ((name "db-password")
+               (type "password")
+               (autocomplete "current-password")
+               (value ""))))
+      (label ((class "wide"))
+       ,(tr config 'tls-ssl)
+       (select ((name "db-ssl"))
+         (option ((value "no") ,@(if (eq? ssl 'no) '((selected "selected")) '())) ,(tr config 'ssl-no))
+         (option ((value "optional") ,@(if (eq? ssl 'optional) '((selected "selected")) '())) ,(tr config 'ssl-optional))
+         (option ((value "yes") ,@(if (eq? ssl 'yes) '((selected "selected")) '())) ,(tr config 'ssl-required)))))))
+
+(define (admin-fields config [form '()])
+  `((h2 ,(tr config 'administrator))
+    (label
+     ,(tr config 'administrator-username)
+     (input ((name "username")
+             (autocomplete "username")
+             (value ,(form-value form 'username ""))
+             (required "required"))))
+    (label
+     ,(tr config 'display-name)
+     (input ((name "display-name")
+             (autocomplete "name")
+             (value ,(form-value form 'display-name ""))
+             (placeholder "Optional; defaults to username"))))
+    (label
+     ,(tr config 'administrator-password)
+     (input ((name "password")
+             (type "password")
+             (autocomplete "new-password")
+             (required "required"))))
+    (label
+     ,(tr config 'repeat-password)
+     (input ((name "password-confirm")
+             (type "password")
+             (autocomplete "new-password")
+             (required "required"))))))
+
+(define (setup-page config [message #f] [form '()])
+  (define db-ready? (database-ready? config))
+  (define administrator-ready? (admin-ready? config))
+  (define vendor-ready? (vendor-files-ready? config))
+  `(html
+    (head
+     (meta ((charset "utf-8")))
+     (meta ((name "viewport") (content "width=device-width, initial-scale=1")))
+     (title ,(string-append "Setup - " (wiki-config-site-title config)))
+     (style ,setup-style))
+    (body
+     (main ((class "setup"))
+       (h1 ,(tr config 'setup-title))
+       (p ,(tr config 'setup-description))
+       (ul ((class "status"))
+         ,(status-row (tr config 'postgresql) db-ready? (tr config 'ready) (tr config 'required))
+         ,(status-row (tr config 'administrator-account) administrator-ready? (tr config 'ready) (tr config 'required))
+         ,(status-row (tr config 'frontend-libraries) vendor-ready? (tr config 'ready) (tr config 'will-download)))
+       ,@(if message
+             `((div ((class "error")) ,message))
+             '())
+       (form ((method "post") (action "/setup"))
+         (input ((type "hidden") (name "setup-token") (value ,setup-form-token)))
+         ,@(language-field config form)
+         ,@(if db-ready? '() (database-fields config form))
+         ,@(if administrator-ready? '() (admin-fields config form))
+         (button ((type "submit")) ,(tr config 'complete-setup)))
+       (p ((class "note"))
+          "PostgreSQL connection settings are stored in "
+          (code ,(path->string (database-config-path config)))
+          ". Protect the wiki data directory as you would any other file containing database credentials.")
+       (p ((class "note"))
+          "Frontend libraries are stored below "
+          (code ,(path->string (vendor-directory config)))
+          " and are served locally after setup.")))))
+
+(define (setup-page-response config [message #f] [form '()])
+  (html-response
+   (setup-page config message form)
+   #:headers (list (make-header #"Cache-Control" #"no-store"))))
+
+(define (validate-admin-form form)
+  (define username (string-trim (form-value form 'username)))
+  (define display-name (string-trim (form-value form 'display-name)))
+  (define password (form-value form 'password))
+  (define password-confirm (form-value form 'password-confirm))
+  (cond
+    ((string=? username "") "Administrator username is required.")
+    ((string=? password "") "Administrator password is required.")
+    ((< (string-length password) 8) "Administrator password must contain at least 8 characters.")
+    ((not (string=? password password-confirm)) "The two passwords do not match.")
+    (else
+     (list username
+           (if (string=? display-name "") username display-name)
+           password))))
+
+(define (form->database-settings form)
+  (define port (string->number (form-value form 'db-port "5432")))
+  (define ssl-text (form-value form 'db-ssl "no"))
+  (define ssl
+    (cond
+      ((string=? ssl-text "yes") 'yes)
+      ((string=? ssl-text "optional") 'optional)
+      (else 'no)))
+  (cond
+    ((string=? (string-trim (form-value form 'db-server)) "") "PostgreSQL server is required.")
+    ((or (not port) (not (exact-integer? port)) (< port 1) (> port 65535)) "PostgreSQL port is invalid.")
+    ((string=? (string-trim (form-value form 'db-database)) "") "PostgreSQL database is required.")
+    ((string=? (string-trim (form-value form 'db-user)) "") "PostgreSQL user is required.")
+    (else
+     (database-settings (string-trim (form-value form 'db-server))
+                        port
+                        (string-trim (form-value form 'db-database))
+                        (string-trim (form-value form 'db-user))
+                        (form-value form 'db-password)
+                        ssl))))
+
+
+(define (configure-language! config form)
+  (define language (string-downcase (form-value form 'language (current-language config))))
+  (unless (member language '("en" "nl"))
+    (error 'setup "Unsupported UI language: ~a" language))
+  (write-language! config language))
+
+(define (configure-database! config form)
+  (unless (database-ready? config)
+    (define settings (form->database-settings form))
+    (when (string? settings)
+      (error 'setup settings))
+    (test-database-settings! settings)
+    (initialize-database-with-settings! settings config)
+    (write-database-settings! config settings)))
+
+(define (configure-administrator! config form)
+  (unless (admin-ready? config)
+    (define admin-values (validate-admin-form form))
+    (when (string? admin-values)
+      (error 'setup admin-values))
+    (create-user! config
+                  (list-ref admin-values 0)
+                  (list-ref admin-values 1)
+                  (list-ref admin-values 2)
+                  'admin
+                  'enabled)))
+
+(define (cleartext-password-error? message)
+  (and (string? message)
+       (regexp-match? #rx"refusing to send cleartext password" message)))
+
+(define (setup-error-message e)
+  (define message (exn-message e))
+  (if (cleartext-password-error? message)
+      (string-append
+       "PostgreSQL requests cleartext password authentication. "
+       "Configure the matching pg_hba.conf rule for this database/user to use "
+       "scram-sha-256 (recommended), then reload PostgreSQL and try again. "
+       "If more than one pg_hba.conf rule could match, remember that PostgreSQL "
+       "uses the first matching rule. "
+       "The entered non-password fields have been preserved below.\n\n"
+       "Technical detail: " message)
+      message))
+
+(define (complete-setup! config req)
+  (call-with-semaphore
+   setup-lock
+   (λ ()
+     (if (setup-complete? config)
+         (redirect-response "/login")
+         (let ((form (request-form req)))
+           (cond
+             ((not (string=? (form-value form 'setup-token) setup-form-token))
+              (setup-page-response
+               config
+               "Invalid setup form token. Reload the setup page and try again."
+               form))
+             (else
+              (with-handlers ((exn:fail?
+                               (λ (e)
+                                 (setup-page-response
+                                  config
+                                  (setup-error-message e)
+                                  form))))
+                (configure-language! config form)
+                (configure-database! config form)
+                (configure-administrator! config form)
+                (download-vendor-files! config)
+                (redirect-response "/login")))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Handle the web-based initial setup page.
+; pre    : req is a GET or POST request for /setup.
+; post   : POST can configure PostgreSQL, create the first administrator and
+;          download frontend libraries.
+; result : An HTML setup response or a redirect to /login.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (setup-handler config req)
+  (cond
+    ((setup-complete? config)
+     (redirect-response "/login"))
+    ((string-ci=? (bytes->string/latin-1 (request-method req)) "POST")
+     (complete-setup! config req))
+    (else
+     (setup-page-response config))))

private/storage.rkt

@@ -0,0 +1,471 @@
+#lang racket/base
+
+(require db
+         json
+         racket/file
+         racket/list
+         racket/path
+         racket/string
+         "config.rkt"
+         "database.rkt"
+         "todo.rkt")
+
+(provide ensure-wiki-data!
+         valid-slug?
+         title->slug
+         list-pages
+         read-page
+         create-page!
+         update-page!
+         archive-page!
+         page-history
+         read-version
+         search-pages
+         list-todos
+         save-upload!
+         uploaded-file)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ensure writable installation directories exist.
+; pre    : config is a wiki-config value and its data directory is writable.
+; post   : The data directory and writable static directory exist.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (ensure-wiki-data! config)
+  (for ((directory (in-list (list (wiki-config-data-dir config)
+                                  (data-static-directory config)))))
+    (make-directory* directory)))
+
+(define (slug-alphanumeric? char)
+  (or (char-alphabetic? char)
+      (char-numeric? char)))
+
+(define (combining-mark? char)
+  (if (member (char-general-category char) '(mn mc me))
+      #t
+      #f))
+
+(define (valid-slug-character? char)
+  (or (slug-alphanumeric? char)
+      (char=? char #\.)
+      (char=? char #\_)
+      (char=? char #\-)))
+
+(define (valid-slug? slug)
+  (and (> (string-length slug) 0)
+       (<= (string-length slug) 120)
+       (slug-alphanumeric? (string-ref slug 0))
+       (for/and ((char (in-string slug)))
+         (valid-slug-character? char))
+       (not (member slug '("." "..")))))
+
+(define (title->slug title)
+  (define normalized
+    (string-downcase
+     (string-normalize-nfkd (string-trim title))))
+  (define out (open-output-string))
+  (define separator-needed? #f)
+  (define wrote-character? #f)
+  (for ((char (in-string normalized)))
+    (cond
+      ((slug-alphanumeric? char)
+       (when (and separator-needed? wrote-character?)
+         (write-char #\- out))
+       (write-char char out)
+       (set! separator-needed? #f)
+       (set! wrote-character? #t))
+      ((combining-mark? char)
+       (void))
+      (else
+       (set! separator-needed? #t))))
+  (define slug (get-output-string out))
+  (define limited
+    (if (> (string-length slug) 120)
+        (substring slug 0 120)
+        slug))
+  (regexp-replace #px"-+$" limited ""))
+
+(define (tags->text tags)
+  (jsexpr->string tags))
+
+(define (text->tags text)
+  (with-handlers ((exn:fail? (λ (_e) '())))
+    (define value (string->jsexpr text))
+    (if (list? value) value '())))
+
+(define (row->page row [include-markdown? #t])
+  (define result
+    (hash 'slug (vector-ref row 0)
+          'title (vector-ref row 1)
+          'createdAt (vector-ref row 3)
+          'updatedAt (vector-ref row 4)
+          'createdBy (vector-ref row 5)
+          'updatedBy (vector-ref row 6)
+          'tags (text->tags (vector-ref row 7))
+          'currentVersion (vector-ref row 8)))
+  (if include-markdown?
+      (hash-set result 'markdown (vector-ref row 2))
+      result))
+
+(define page-columns
+  "slug, title, markdown, created_at, updated_at, created_by, updated_by, tags, current_version")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List current wiki page metadata.
+; pre    : The PostgreSQL schema is initialized.
+; post   : The pages table has only been read.
+; result : A title-sorted list of page metadata hashes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (list-pages config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (for/list ((row (in-list
+                      (query-rows db
+                                  (string-append "SELECT " page-columns
+                                                 " FROM pages WHERE archived = FALSE ORDER BY lower(title), title")))))
+       (row->page row #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the current form of one wiki page.
+; pre    : slug is a valid page slug.
+; post   : The pages table has only been read.
+; result : Page metadata with Markdown, or #f when the page does not exist.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (read-page config slug)
+  (if (not (valid-slug? slug))
+      #f
+      (call-with-wiki-database
+       config
+       (λ (db)
+         (define row
+           (query-maybe-row db
+                            (string-append "SELECT " page-columns
+                                           " FROM pages WHERE slug = $1 AND archived = FALSE")
+                            slug))
+         (if row (row->page row) #f)))))
+
+
+(define (replace-todos! db page-id markdown)
+  (query-exec db "DELETE FROM todo_items WHERE page_id = $1" page-id)
+  (for ((item (in-list (extract-todos markdown))))
+    (query-exec db
+                "INSERT INTO todo_items(page_id, item_number, line_number, text) VALUES ($1, $2, $3, $4)"
+                page-id
+                (hash-ref item 'number)
+                (hash-ref item 'line)
+                (hash-ref item 'text))))
+
+(define (insert-version! db page-id version title markdown author action summary now tags)
+  (query-exec db
+              #<<SQL
+INSERT INTO page_versions(page_id, version, title, markdown, tags, author, action, summary, created_at)
+VALUES ($1, $2, $3, $4, $5, $6, $7, $8, $9)
+SQL
+              page-id version title markdown (tags->text tags) author action summary now))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create a wiki page and its first version.
+; pre    : slug is valid and unused.
+; post   : Current page state and version 1 are committed atomically.
+; result : The new page metadata with Markdown.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (create-page! config slug title markdown author [summary "Created page"] [tags '()])
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (call-with-transaction
+      db
+      (λ ()
+        (define now (current-seconds))
+        (define page-id
+          (query-value db
+                       #<<SQL
+INSERT INTO pages(slug, title, markdown, tags, current_version,
+                  created_at, updated_at, created_by, updated_by, search_document)
+VALUES ($1, $2, $3, $4, 1, $5, $5, $6, $6,
+        setweight(to_tsvector('simple', coalesce($2, '')), 'A') ||
+        setweight(to_tsvector('simple', coalesce($3, '')), 'B'))
+RETURNING id
+SQL
+                       slug title markdown (tags->text tags) now author))
+        (insert-version! db page-id 1 title markdown author "create" summary now tags)
+        (replace-todos! db page-id markdown)))))
+  (read-page config slug))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Save a new version of an existing wiki page.
+; pre    : The page exists and base-version equals its current version.
+; post   : Current page and version history are committed atomically.
+; result : The updated page metadata with Markdown.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (update-page! config slug title markdown author base-version [summary "Edited page"] [tags #f])
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (call-with-transaction
+      db
+      (λ ()
+        (define row
+          (query-maybe-row db
+                           "SELECT id, current_version, tags FROM pages WHERE slug = $1 AND archived = FALSE FOR UPDATE"
+                           slug))
+        (unless row
+          (error 'update-page! "unknown page: ~a" slug))
+        (define current-version (vector-ref row 1))
+        (define supplied-version
+          (if (number? base-version)
+              base-version
+              (string->number (format "~a" base-version))))
+        (unless (and supplied-version (= current-version supplied-version))
+          (error 'update-page! "version-conflict"))
+        (define page-tags
+          (if tags tags (text->tags (vector-ref row 2))))
+        (define next-version (+ current-version 1))
+        (define now (current-seconds))
+        (query-exec db
+                    #<<SQL
+UPDATE pages
+SET title = $1, markdown = $2, tags = $3, current_version = $4,
+    updated_at = $5, updated_by = $6,
+    search_document = setweight(to_tsvector('simple', coalesce($1, '')), 'A') ||
+                      setweight(to_tsvector('simple', coalesce($2, '')), 'B')
+WHERE id = $7
+SQL
+                    title markdown (tags->text page-tags) next-version now author (vector-ref row 0))
+        (insert-version! db (vector-ref row 0) next-version title markdown author "edit" summary now page-tags)
+        (replace-todos! db (vector-ref row 0) markdown)))))
+  (read-page config slug))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Archive an existing wiki page.
+; pre    : The page exists.
+; post   : The page is marked archived while its versions and attachments remain stored.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (archive-page! config slug author)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (define id
+       (query-maybe-value db
+                          #<<SQL
+UPDATE pages
+SET archived = TRUE, archived_at = $1, archived_by = $2
+WHERE slug = $3 AND archived = FALSE
+RETURNING id
+SQL
+                          (current-seconds) author slug))
+     (unless id
+       (error 'archive-page! "unknown page: ~a" slug))))
+  (void))
+
+(define (page-id config slug)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-maybe-value db
+                        "SELECT id FROM pages WHERE slug = $1 AND archived = FALSE"
+                        slug))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the version history for a wiki page.
+; pre    : The page exists.
+; post   : Page version rows have only been read.
+; result : A newest-first list of version metadata hashes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (page-history config slug)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (define id
+       (query-maybe-value db "SELECT id FROM pages WHERE slug = $1 AND archived = FALSE" slug))
+     (unless id
+       (error 'page-history "unknown page: ~a" slug))
+     (for/list ((row (in-list
+                      (query-rows db
+                                  #<<SQL
+SELECT version, title, author, action, summary, tags, created_at
+FROM page_versions
+WHERE page_id = $1
+ORDER BY version DESC
+SQL
+                                  id))))
+       (hash 'version (vector-ref row 0)
+             'title (vector-ref row 1)
+             'author (vector-ref row 2)
+             'action (vector-ref row 3)
+             'summary (vector-ref row 4)
+             'tags (text->tags (vector-ref row 5))
+             'createdAt (vector-ref row 6))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read one stored page version.
+; pre    : slug and version identify a possible stored version.
+; post   : Version rows have only been read.
+; result : Version metadata with Markdown, or #f when the version is absent.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (read-version config slug version)
+  (define version-number
+    (if (number? version) version (string->number version)))
+  (and version-number
+       (call-with-wiki-database
+        config
+        (λ (db)
+          (define row
+            (query-maybe-row db
+                             #<<SQL
+SELECT v.version, v.title, v.markdown, v.author, v.action, v.summary, v.tags, v.created_at
+FROM page_versions v
+JOIN pages p ON p.id = v.page_id
+WHERE p.slug = $1 AND p.archived = FALSE AND v.version = $2
+SQL
+                             slug version-number))
+          (and row
+               (hash 'version (vector-ref row 0)
+                     'title (vector-ref row 1)
+                     'markdown (vector-ref row 2)
+                     'author (vector-ref row 3)
+                     'action (vector-ref row 4)
+                     'summary (vector-ref row 5)
+                     'tags (text->tags (vector-ref row 6))
+                     'createdAt (vector-ref row 7)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Search current wiki pages using PostgreSQL full-text search.
+; pre    : query-text is a string and the database schema is initialized.
+; post   : Page content has only been read.
+; result : Up to 50 relevance-sorted search result hashes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (search-pages config query-text)
+  (if (string=? (string-trim query-text) "")
+      '()
+      (call-with-wiki-database
+       config
+       (λ (db)
+         (for/list ((row (in-list
+                          (query-rows db
+                                      #<<SQL
+WITH q AS (SELECT websearch_to_tsquery('simple', $1) AS query)
+SELECT p.slug,
+       p.title,
+       ts_rank(p.search_document, q.query) AS rank,
+       ts_headline('simple', p.markdown, q.query,
+                   'StartSel=[[[, StopSel=]]], MaxWords=28, MinWords=8, ShortWord=2') AS snippet
+FROM pages p, q
+WHERE p.archived = FALSE
+  AND p.search_document @@ q.query
+ORDER BY rank DESC, lower(p.title), p.title
+LIMIT 50
+SQL
+                                      query-text))))
+           (hash 'slug (vector-ref row 0)
+                 'title (vector-ref row 1)
+                 'rank (vector-ref row 2)
+                 'snippet (vector-ref row 3)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List unresolved todo(...) markers from all current wiki pages.
+; pre    : PostgreSQL schema 3 or newer is initialized.
+; post   : Todo and page rows have only been read.
+; result : A page/title sorted list of todo item hashes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (list-todos config)
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (for/list ((row (in-list
+                      (query-rows db
+                                  #<<SQL
+SELECT p.slug, p.title, t.item_number, t.line_number, t.text
+FROM todo_items t
+JOIN pages p ON p.id = t.page_id
+WHERE p.archived = FALSE
+ORDER BY lower(p.title), p.title, t.item_number
+SQL
+                                  ))))
+       (hash 'slug (vector-ref row 0)
+             'title (vector-ref row 1)
+             'number (vector-ref row 2)
+             'line (vector-ref row 3)
+             'text (vector-ref row 4))))))
+
+(define (safe-file-name name)
+  (define clean
+    (regexp-replace* #px"[^A-Za-z0-9._ -]" name "_"))
+  (if (or (string=? clean "")
+          (string=? clean ".")
+          (string=? clean ".."))
+      "upload.bin"
+      clean))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store an uploaded file in PostgreSQL.
+; pre    : The page exists and content is a byte string.
+; post   : Attachment metadata and bytes are stored in one PostgreSQL row.
+; result : A hash containing original name, stored name and page-local URL.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (save-upload! config slug original-name content author)
+  (define id (page-id config slug))
+  (unless id
+    (error 'save-upload! "unknown page: ~a" slug))
+  (define stored-name
+    (format "~a-~a-~a" (current-seconds) (random 1000000) (safe-file-name original-name)))
+  (define mime-type
+    (cond
+      ((regexp-match? #px"(?i:[.]png)$" stored-name) "image/png")
+      ((regexp-match? #px"(?i:[.](jpg|jpeg))$" stored-name) "image/jpeg")
+      ((regexp-match? #px"(?i:[.]gif)$" stored-name) "image/gif")
+      ((regexp-match? #px"(?i:[.]webp)$" stored-name) "image/webp")
+      ((regexp-match? #px"(?i:[.]pdf)$" stored-name) "application/pdf")
+      ((regexp-match? #px"(?i:[.]txt)$" stored-name) "text/plain; charset=utf-8")
+      (else "application/octet-stream")))
+  (call-with-wiki-database
+   config
+   (λ (db)
+     (query-exec db
+                 #<<SQL
+INSERT INTO attachments(page_id, original_name, stored_name, mime_type, content,
+                        size, uploaded_at, uploaded_by)
+VALUES ($1, $2, $3, $4, $5, $6, $7, $8)
+SQL
+                 id
+                 original-name
+                 stored-name
+                 mime-type
+                 content
+                 (bytes-length content)
+                 (current-seconds)
+                 author)))
+  (hash 'name original-name
+        'storedName stored-name
+        'url (format "/uploads/~a/~a" slug stored-name)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read one stored attachment from PostgreSQL.
+; pre    : slug and stored-name come from an upload request path.
+; post   : PostgreSQL has only been read.
+; result : A hash containing bytes, MIME type and names, or #f when absent.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (uploaded-file config slug stored-name)
+  (and (valid-slug? slug)
+       (not (regexp-match? #px"[/\\\\]" stored-name))
+       (call-with-wiki-database
+        config
+        (λ (db)
+          (define row
+            (query-maybe-row db
+                             #<<SQL
+SELECT a.original_name, a.stored_name, a.mime_type, a.content, a.size
+FROM attachments a
+JOIN pages p ON p.id = a.page_id
+WHERE p.slug = $1 AND p.archived = FALSE AND a.stored_name = $2
+SQL
+                             slug stored-name))
+          (if row
+              (hash 'originalName (vector-ref row 0)
+                    'storedName (vector-ref row 1)
+                    'mimeType (vector-ref row 2)
+                    'content (vector-ref row 3)
+                    'size (vector-ref row 4))
+              #f)))))

private/todo.rkt

@@ -0,0 +1,35 @@
+#lang racket/base
+
+(require racket/list
+         racket/string)
+
+(provide extract-todos)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Extract wiki todo(...) markers from Markdown source.
+; pre    : markdown is a string.
+; post   : Fenced code blocks are ignored and source is unchanged.
+; result : A list of hashes containing item number, line number and text.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (extract-todos markdown)
+  (define lines (string-split markdown "\n" #:trim? #f))
+  (define in-fence? #f)
+  (define item-number 0)
+  (define result '())
+  (for ((line (in-list lines))
+        (line-number (in-naturals 1)))
+    (define trimmed (string-trim line))
+    (cond
+      ((regexp-match? #px"^(```|~~~)" trimmed)
+       (set! in-fence? (not in-fence?)))
+      ((not in-fence?)
+       (for ((match (in-list (regexp-match* #px"todo\\([^()]+\\)" line))))
+         (define text (string-trim (substring match 5 (- (string-length match) 1))))
+         (when (not (string=? text ""))
+           (set! item-number (+ item-number 1))
+           (set! result
+                 (cons (hash 'number item-number
+                             'line line-number
+                             'text text)
+                       result)))))))
+  (reverse result))

private/vendor.rkt

@@ -0,0 +1,106 @@
+#lang racket/base
+
+(require net/url
+         net/url-connect
+         racket/file
+         racket/path
+         racket/port
+         "config.rkt")
+
+(provide vendor-files
+         vendor-files-ready?
+         download-vendor-files!)
+
+(define vendor-files
+  (list
+   (cons "font-awesome/css/font-awesome.min.css"
+         "https://cdn.jsdelivr.net/npm/font-awesome@4.7.0/css/font-awesome.min.css")
+   (cons "font-awesome/fonts/fontawesome-webfont.woff2"
+         "https://cdn.jsdelivr.net/npm/font-awesome@4.7.0/fonts/fontawesome-webfont.woff2")
+   (cons "easymde.min.js"
+         "https://cdn.jsdelivr.net/npm/easymde@2.21.0/dist/easymde.min.js")
+   (cons "easymde.min.css"
+         "https://cdn.jsdelivr.net/npm/easymde@2.21.0/dist/easymde.min.css")
+   (cons "purify.min.js"
+         "https://cdn.jsdelivr.net/npm/dompurify@3.4.13/dist/purify.min.js")
+   (cons "highlight.min.js"
+         "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.12.0/build/highlight.min.js")
+   (cons "highlight-scheme.min.js"
+         "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.12.0/build/languages/scheme.min.js")
+   (cons "highlight-github.min.css"
+         "https://cdn.jsdelivr.net/gh/highlightjs/cdn-release@11.12.0/build/styles/github.min.css")
+   (cons "diff2html-ui-base.min.js"
+         "https://cdn.jsdelivr.net/npm/diff2html@3.4.56/bundles/js/diff2html-ui-base.min.js")
+   (cons "diff2html.min.css"
+         "https://cdn.jsdelivr.net/npm/diff2html@3.4.56/bundles/css/diff2html.min.css")))
+
+(define (vendor-file-ready? config name)
+  (define path (build-path (vendor-directory config) name))
+  (and (file-exists? path)
+       (> (file-size path) 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Check whether all required browser libraries are installed.
+; pre    : config is a wiki-config value.
+; post   : Vendor files have only been inspected.
+; result : #t when every required vendor file exists and is non-empty,
+;          otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (vendor-files-ready? config)
+  (for/and ([entry (in-list vendor-files)])
+    (vendor-file-ready? config (car entry))))
+
+(define (download-content source)
+  (parameterize ((current-https-protocol 'secure))
+    (define-values (in headers)
+      (get-pure-port/headers (string->url source)
+                             '()
+                             #:redirections 5
+                             #:status? #t))
+    (dynamic-wind
+     void
+     (λ ()
+       (define status-match
+         (regexp-match #px"^HTTP/[^ ]+ ([0-9][0-9][0-9])" headers))
+       (unless (and status-match
+                    (= (string->number (list-ref status-match 1)) 200))
+         (error 'download-vendor-files!
+                "download failed for ~a: ~a"
+                source
+                (or (and status-match (list-ref status-match 1))
+                    "invalid HTTP status")))
+       (port->bytes in))
+     (λ ()
+       (close-input-port in)))))
+
+(define (download-file! config name source)
+  (define directory (vendor-directory config))
+  (define target (build-path directory name))
+  (define temporary-target
+    (build-path directory (string-append name ".download")))
+  (define content (download-content source))
+  (make-directory* (path-only target))
+  (call-with-output-file temporary-target
+    (λ (out)
+      (write-bytes content out))
+    #:exists 'truncate/replace)
+  (rename-file-or-directory temporary-target target #t)
+  (void))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Download all browser libraries required by the wiki frontend.
+; pre    : config identifies a writable data directory and outbound HTTPS is
+;         available for the configured vendor URLs.
+; post   : Every required vendor file is stored below data/static/vendor.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (download-vendor-files! config)
+  (make-directory* (vendor-directory config))
+  (for ([entry (in-list vendor-files)])
+    (define name (car entry))
+    (define source (cdr entry))
+    (unless (vendor-file-ready? config name)
+      (download-file! config name source)))
+  (unless (vendor-files-ready? config)
+    (error 'download-vendor-files! "frontend vendor setup is incomplete"))
+  (void))