about summary refs log tree commit diff
path: root/web/panettone
diff options
context:
space:
mode:
Diffstat (limited to 'web/panettone')
-rw-r--r--web/panettone/OWNERS8
-rw-r--r--web/panettone/default.nix14
-rw-r--r--web/panettone/docker-compose.yml4
-rw-r--r--web/panettone/shell.nix4
-rw-r--r--web/panettone/src/authentication.lisp210
-rw-r--r--web/panettone/src/css.lisp32
-rw-r--r--web/panettone/src/email.lisp5
-rw-r--r--web/panettone/src/inline-markdown.lisp3
-rw-r--r--web/panettone/src/migrations/1-init-schema.lisp23
-rw-r--r--web/panettone/src/migrations/3920286378-add-issue-tsv.lisp5
-rw-r--r--web/panettone/src/migrations/3921488651-create-users-table.lisp6
-rw-r--r--web/panettone/src/model.lisp306
-rw-r--r--web/panettone/src/packages.lisp31
-rw-r--r--web/panettone/src/panettone.lisp206
-rw-r--r--web/panettone/src/static/search.pngbin0 -> 711 bytes
-rw-r--r--web/panettone/src/util.lisp32
-rw-r--r--web/panettone/test/util_test.lisp9
17 files changed, 603 insertions, 295 deletions
diff --git a/web/panettone/OWNERS b/web/panettone/OWNERS
index b2b0acc303..5ad475b1c7 100644
--- a/web/panettone/OWNERS
+++ b/web/panettone/OWNERS
@@ -1,5 +1,3 @@
-inherited: true
-owners:
-  - grfn
-  - tazjin
-  - sterni
+aspen
+tazjin
+sterni
diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index a01e0d81c8..60fca99e75 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -1,4 +1,4 @@
-{ depot, ... }:
+{ depot, pkgs, ... }:
 
 depot.nix.buildLisp.program {
   name = "panettone";
@@ -9,6 +9,7 @@ depot.nix.buildLisp.program {
     cl-ppcre
     cl-smtp
     cl-who
+    str
     defclass-std
     drakma
     easy-routes
@@ -16,7 +17,6 @@ depot.nix.buildLisp.program {
     lass
     local-time
     postmodern
-    trivial-ldap
 
     depot.lisp.klatre
   ];
@@ -24,6 +24,15 @@ depot.nix.buildLisp.program {
   srcs = [
     ./panettone.asd
     ./src/packages.lisp
+    (pkgs.writeText "build.lisp" ''
+      (defpackage build
+        (:use :cl :alexandria)
+        (:export :*migrations-dir* :*static-dir*))
+      (in-package :build)
+      (declaim (optimize (safety 3)))
+      (defvar *migrations-dir* "${./src/migrations}")
+      (defvar *static-dir* "${./src/static}")
+    '')
     ./src/util.lisp
     ./src/css.lisp
     ./src/email.lisp
@@ -43,6 +52,7 @@ depot.nix.buildLisp.program {
       ./test/package.lisp
       ./test/model_test.lisp
       ./test/inline-markdown_test.lisp
+      ./test/util_test.lisp
     ];
 
     expression = "(fiveam:run!)";
diff --git a/web/panettone/docker-compose.yml b/web/panettone/docker-compose.yml
index 84723667e6..18e3498306 100644
--- a/web/panettone/docker-compose.yml
+++ b/web/panettone/docker-compose.yml
@@ -1,7 +1,7 @@
-version: '3.4'
+version: "3.4"
 services:
   postgres:
-    image: postgres:11
+    image: postgres:16
     restart: always
     environment:
       POSTGRES_USER: panettone
diff --git a/web/panettone/shell.nix b/web/panettone/shell.nix
index aeafc7afcd..483481ca9a 100644
--- a/web/panettone/shell.nix
+++ b/web/panettone/shell.nix
@@ -1,6 +1,6 @@
-{ depot ? import ../.. {} }:
+{ depot ? import ../.. { } }:
 
-with depot.third_party;
+with depot.third_party.nixpkgs;
 
 mkShell {
   buildInputs = [
diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp
index c335345020..496a0e0bd7 100644
--- a/web/panettone/src/authentication.lisp
+++ b/web/panettone/src/authentication.lisp
@@ -3,113 +3,121 @@
 (defvar *user* nil
   "The currently logged-in user")
 
-(defvar *ldap* nil
-  "The ldap connection")
-
-(defvar *ldap-host* "localhost"
-  "The host for the ldap connection")
-
-(defvar *ldap-port* 389
-  "The port for the ldap connection")
-
 (defclass/std user ()
   ((cn dn mail displayname :type string)))
 
-(defun connect-ldap (&key
-                       (host "localhost")
-                       (port 389))
-  (setq *ldap-host* host
-        *ldap-port* port
-        *ldap* (ldap:new-ldap :host host :port port)))
-
-(defun reconnect-ldap ()
-  (setq *ldap* (ldap:new-ldap
-                :host *ldap-host*
-                :port *ldap-port*)))
-
-(defmacro with-ldap ((&key (max-tries 1)) &body body)
-  "Execute BODY in a context where ldap connection errors trigger a reconnect
-and a retry"
-  (with-gensyms (n try retry e)
-    `(flet
-         ((,try
-              (,n)
-            (flet ((,retry (,e)
-                     (if (>= ,n ,max-tries)
-                         (error ,e)
-                         (progn
-                           (reconnect-ldap)
-                           (,try (1+ ,n))))))
-              (handler-case
-                  (progn
-                    ,@body)
-                (end-of-file (,e) (,retry ,e))
-                (trivial-ldap:ldap-connection-error (,e) (,retry ,e))))))
-       (,try 0))))
-
-(defun ldap-entry->user (entry)
-  (apply
-   #'make-instance
-   'user
-   :dn (ldap:dn entry)
-   (alexandria:mappend
-    (lambda (field)
-      (list field (car (ldap:attr-value entry field))))
-    (list :mail
-          :cn
-          :displayname))))
-
-(defun find-user/ldap (username)
-  (check-type username (simple-array character (*)))
-  (with-ldap ()
-    (ldap:search
-     *ldap*
-     `(and (= objectClass organizationalPerson)
-           (or
-            (= cn ,username)
-            (= dn ,username)))
-     ;; TODO(grfn): make this configurable
-     :base "ou=users,dc=tvl,dc=fyi")
-    (ldap:next-search-result *ldap*)))
-
-(defun find-user (username)
-  (check-type username (simple-array character (*)))
-  (when-let ((ldap-entry (find-user/ldap username)))
-    (ldap-entry->user ldap-entry)))
+;; Migrating user authentication to OAuth2 necessitates some temporary
+;; workarounds while other parts of the panettone code are being
+;; amended appropriately.
+
+(defun fake-dn (username)
+  "Users are no longer read directly from LDAP, but everything in
+panettone is keyed on the DNs. This function constructs matching
+'fake' DNs."
+  (format nil "cn=~A,ou=users,dc=tvl,dc=fyi" username))
 
 (defun find-user-by-dn (dn)
-  "Look up the user with the given DN in the LDAP database, returning an
-instance of `user'"
-  (with-ldap ()
-    (let ((have-results
-            (handler-case
-              (ldap:search *ldap* `(= objectClass organizationalPerson)
-                           :base dn
-                           :scope 'ldap:base)
-              ; catch ldap-errors generated by trivial-ldap:parse-ldap-message
-              ; since this is thrown on conditions which we don't want this
-              ; function to fail like when there are no search results
-              (trivial-ldap:ldap-error (e) nil))))
-      (when have-results
-        (when-let ((ldap-entry (ldap:next-search-result *ldap*)))
-          (ldap-entry->user ldap-entry))))))
+  "Previously this function looked up users in LDAP based on their DN,
+however panettone now does not have direct access to a user database.
+
+For most cases only the username is needed, which can be parsed out of
+the user, however email addresses are temporarily not available."
+  (let ((username
+          (car (uiop:split-string (subseq dn 3) :separator '(#\,)))))
+    (make-instance
+     'user
+     :dn dn
+     :cn username
+     :displayname username
+     :mail nil)))
+
+;; Implementation of standard OAuth2 authorisation flow.
+
+(defvar *oauth2-auth-endpoint* nil)
+(defvar *oauth2-token-endpoint* nil)
+(defvar *oauth2-client-id* nil)
+(defvar *oauth2-client-secret* nil)
+
+(defvar *oauth2-redirect-uri*
+  (or (uiop:getenv "OAUTH2_REDIRECT_URI")
+      "https://b.tvl.fyi/auth"))
 
 (comment
- (find-user-by-dn "cn=grfn,ou=users,dc=tvl,dc=fyi")
+ (setq *oauth2-redirect-uri* "http://localhost:6161/auth")
  )
 
-(defun authenticate-user (user-or-username password)
-  "Checks the given USER-OR-USERNAME has the given PASSWORD, by making a bind
-request against the ldap server at *ldap*. Returns the user if authentication is
-successful, `nil' otherwise"
-  (when-let ((user (if (typep user-or-username 'user) user-or-username
-                       (find-user user-or-username))))
-    (let ((dn (dn user)))
-      (let ((code-sym
-              (nth-value 1 (ldap:bind
-                            (ldap:new-ldap :host (ldap:host *ldap*)
-                                           :port (ldap:port *ldap*)
-                                           :user dn
-                                           :pass password)))))
-        (when (equalp code-sym 'trivial-ldap:success)
-          user)))))
+(defun initialise-oauth2 ()
+  "Initialise all settings needed for OAuth2"
+
+  (setq *oauth2-auth-endpoint*
+        (or *oauth2-auth-endpoint*
+            (uiop:getenv "OAUTH2_AUTH_ENDPOINT")
+            "https://auth.tvl.fyi/auth/realms/TVL/protocol/openid-connect/auth"))
+
+  (setq *oauth2-token-endpoint*
+        (or *oauth2-token-endpoint*
+            (uiop:getenv "OAUTH2_TOKEN_ENDPOINT")
+            "https://auth.tvl.fyi/auth/realms/TVL/protocol/openid-connect/token"))
+
+  (setq *oauth2-client-id*
+        (or *oauth2-client-id*
+            (uiop:getenv "OAUTH2_CLIENT_ID")
+            "panettone"))
+
+  (setq *oauth2-client-secret*
+        (or *oauth2-client-secret*
+            (uiop:getenv "OAUTH2_CLIENT_SECRET")
+            (error "OAUTH2_CLIENT_SECRET must be set!"))))
+
+(defun auth-url ()
+  (format nil "~A?response_type=code&client_id=~A&redirect_uri=~A"
+          *oauth2-auth-endpoint*
+          (drakma:url-encode *oauth2-client-id* :utf-8)
+          (drakma:url-encode *oauth2-redirect-uri* :utf-8)))
+
+(defun claims-to-user (claims)
+  (let ((username (cdr (assoc :preferred--username claims)))
+        (email (cdr (assoc :email claims))))
+    (make-instance
+     'user
+     :dn (fake-dn username)
+     :cn username
+     :mail email
+     ;; TODO(tazjin): Figure out actual displayName mapping in tokens.
+     :displayname username)))
+
+(defun fetch-token (code)
+  "Fetches the access token on completion of user authentication through
+the OAuth2 endpoint and returns the resulting user object."
+
+  (multiple-value-bind (body status)
+      (drakma:http-request *oauth2-token-endpoint*
+                           :method :post
+                           :parameters `(("grant_type" . "authorization_code")
+                                         ("client_id" . ,*oauth2-client-id*)
+                                         ("client_secret" . ,*oauth2-client-secret*)
+                                         ("redirect_uri" . ,*oauth2-redirect-uri*)
+                                         ("code" . ,code))
+                           :external-format-out :utf-8
+                           :want-stream t)
+    (if (/= status 200)
+        (error "Authentication failed: ~A (~A)~%"
+               (alexandria:read-stream-content-into-string body)
+               status)
+
+        ;; Returned JWT contains username and email, we can populate
+        ;; all fields from that.
+        (progn
+          (setf (flexi-streams:flexi-stream-external-format body) :utf-8)
+          (let* ((response (cl-json:decode-json body))
+                 (access-token (cdr (assoc :access--token response)))
+                 (payload (cadr (uiop:split-string access-token :separator '(#\.))))
+                 (claims (cl-json:decode-json-from-string
+                          (base64:base64-string-to-string
+                           ;; The JWT spec specifies that base64 strings
+                           ;; embedded in jwts are *not* padded, but the common
+                           ;; lisp base64 library doesn't know how to deal with
+                           ;; that - we need to add those extra padding
+                           ;; characters here.
+                           (panettone.util:add-missing-base64-padding payload)))))
+            (claims-to-user claims))))))
diff --git a/web/panettone/src/css.lisp b/web/panettone/src/css.lisp
index aa753cb50f..3bba2bb591 100644
--- a/web/panettone/src/css.lisp
+++ b/web/panettone/src/css.lisp
@@ -49,7 +49,24 @@
        :color "var(--primary)")))
 
     (.comment-count
-     :color "var(--gray)")))
+     :color "var(--gray)")
+
+    (.issue-links
+     :display "flex"
+     :flex-direction "row"
+     :align-items "center"
+     :justify-content "space-between"
+     :flex-wrap "wrap")
+
+    (.issue-search
+     ((:and input (:= type "search"))
+      :padding "0.5rem"
+      :background-image "url('static/search.png')"
+      :background-position "10px 10px"
+      :background-repeat "no-repeat"
+      :background-size "1rem"
+      :padding-left "2rem"
+      :border "1px" "solid" "var(--gray)"))))
 
 (defparameter issue-history-styles
   `((.issue-history
@@ -220,4 +237,15 @@
      :margin "0 auto")
 
     (.created-by-at
-     :color "var(--gray)")))
+     :color "var(--gray)")
+
+    ;; screen-reader-only content
+    (.sr-only
+     :border 0
+     :clip "rect(0 0 0 0)"
+     :height "1px"
+     :margin "-1px"
+     :overflow "hidden"
+     :padding 0
+     :position "absolute"
+     :width "1px")))
diff --git a/web/panettone/src/email.lisp b/web/panettone/src/email.lisp
index cb01c488a2..66ea299858 100644
--- a/web/panettone/src/email.lisp
+++ b/web/panettone/src/email.lisp
@@ -41,8 +41,9 @@ values of `*smtp-server*', `*smtp-server-port*' and `*email-notification-from*'"
   "Sends an email notification to the user with DN with the given SUBJECT and
   MESSAGE, iff that user has not disabled email notifications"
   (when (user-has-email-notifications-enabled-p dn)
-    (when-let ((user (find-user-by-dn dn)))
+    (when-let* ((user (find-user-by-dn dn))
+                (user-mail (mail user)))
       (send-email-notification
-       :to (mail user)
+       :to user-mail
        :subject subject
        :message message))))
diff --git a/web/panettone/src/inline-markdown.lisp b/web/panettone/src/inline-markdown.lisp
index fc5f77584f..e49293519b 100644
--- a/web/panettone/src/inline-markdown.lisp
+++ b/web/panettone/src/inline-markdown.lisp
@@ -124,7 +124,4 @@
          ; only eliminates the slight use case for nesting :em inside :del, but
          ; shouldn't be too bad. As a side effect this is the precise behavior
          ; we want for :code.
-         ;
-         ; TODO(sterni): maybe bring back the restart-based system which allowed
-         ;               to skip nested tokens if desired.
          (t (write-string (who:escape-string tok-str) target)))))
diff --git a/web/panettone/src/migrations/1-init-schema.lisp b/web/panettone/src/migrations/1-init-schema.lisp
new file mode 100644
index 0000000000..3be6c4fcc0
--- /dev/null
+++ b/web/panettone/src/migrations/1-init-schema.lisp
@@ -0,0 +1,23 @@
+"Initialize the database schema from before migrations were added"
+
+(defun ddl/create-issue-status ()
+  "Issue DDL to create the `issue-status' type, if it doesn't exist"
+  (unless (query (:select (:exists (:select 1
+                                    :from 'pg_type
+                                    :where (:= 'typname "issue_status"))))
+                 :single)
+    (query (sql-compile
+            `(:create-enum issue-status ,panettone.model:+issue-statuses+)))))
+
+(defun ddl/create-tables ()
+  "Issue DDL to create all tables, if they don't already exist."
+  (dolist (table '(panettone.model:issue
+                   panettone.model:issue-comment
+                   panettone.model:issue-event
+                   panettone.model:user-settings))
+    (unless (table-exists-p (dao-table-name table))
+      (create-table table))))
+
+(defun up ()
+  (ddl/create-issue-status)
+  (ddl/create-tables))
diff --git a/web/panettone/src/migrations/3920286378-add-issue-tsv.lisp b/web/panettone/src/migrations/3920286378-add-issue-tsv.lisp
new file mode 100644
index 0000000000..2a965a7bba
--- /dev/null
+++ b/web/panettone/src/migrations/3920286378-add-issue-tsv.lisp
@@ -0,0 +1,5 @@
+"Add tsvector for full-text search of issues"
+
+(defun up ()
+  (query "ALTER TABLE issues ADD COLUMN tsv tsvector GENERATED ALWAYS AS (to_tsvector('english', subject || ' ' || body)) STORED")
+  (query "CREATE INDEX issues_tsv_index ON issues USING GIN (tsv);"))
diff --git a/web/panettone/src/migrations/3921488651-create-users-table.lisp b/web/panettone/src/migrations/3921488651-create-users-table.lisp
new file mode 100644
index 0000000000..2598ab101e
--- /dev/null
+++ b/web/panettone/src/migrations/3921488651-create-users-table.lisp
@@ -0,0 +1,6 @@
+"Add a table to store information about users, load the initial set of users
+from the authentication provider, and change fks for other tables"
+
+(defun up ()
+  (panettone.model:create-table-if-not-exists
+   'panettone.model:user))
diff --git a/web/panettone/src/model.lisp b/web/panettone/src/model.lisp
index a3b75380c8..a106e9479b 100644
--- a/web/panettone/src/model.lisp
+++ b/web/panettone/src/model.lisp
@@ -1,33 +1,60 @@
 (in-package :panettone.model)
 (declaim (optimize (safety 3)))
 
-(defun connect-postgres (&key
-                           (host (or (uiop:getenvp "PGHOST") "localhost"))
-                           (user (or (uiop:getenvp "PGUSER") "panettone"))
-                           (password (or (uiop:getenvp "PGPASSWORD") "password"))
-                           (database (or (uiop:getenvp "PGDATABASE") "panettone"))
-                           (port (or (integer-env "PGPORT") 5432)))
-  "Initialize the global postgresql connection for Panettone"
-  (postmodern:connect-toplevel database user password host :port port))
-
-(defun make-thread
-    (function &rest args)
-  "Make a new thread as per `BORDEAUX-THREADS:MAKE-THREAD' but with its own, new
-database connection."
-  (let ((spec `(,(or (uiop:getenvp "PGDATABASE") "panettone")
-                ,(or (uiop:getenvp "PGUSER") "panettone")
-                ,(or (uiop:getenvp "PGPASSWORD") "password")
-                ,(or (uiop:getenvp "PGHOST") "localhost")
-                :port ,(or (integer-env "PGPORT") 5432))))
-    (apply #'bt:make-thread
-           (lambda ()
-             (postmodern:call-with-connection spec function))
-           args)))
+(setq pomo:*ignore-unknown-columns* t)
+
+(defvar *pg-spec* nil
+  "Connection spec for use with the with-connection macro. Needs to be
+initialised at launch time.")
+
+(defun make-pg-spec ()
+  "Construct the Postgres connection spec from the environment."
+  (list (or (uiop:getenvp "PGDATABASE") "panettone")
+        (or (uiop:getenvp "PGUSER") "panettone")
+        (or (uiop:getenvp "PGPASSWORD") "password")
+        (or (uiop:getenvp "PGHOST") "localhost")
+
+        :port (or (integer-env "PGPORT") 5432)
+        :application-name "panettone"
+        :pooled-p t))
+
+(defun prepare-db-connections ()
+  "Initialises the connection spec used for all Postgres connections."
+  (setq *pg-spec* (make-pg-spec)))
+
+(defun connect-to-db ()
+  "Connect using *PG-SPEC* at the top-level, for use during development"
+  (apply #'connect-toplevel
+         (loop for v in *pg-spec*
+               until (eq v :pooled-p)
+               collect v)))
+
+(defun pg-spec->url (&optional (spec *pg-spec*))
+  (destructuring-bind (db user password host &key port &allow-other-keys) spec
+    (format nil
+            "postgres://~A:~A@~A:~A/~A"
+            user password host port db)))
 
 ;;;
 ;;; Schema
 ;;;
 
+(defclass user ()
+  ((sub :col-type uuid :initarg :sub :accessor sub
+        :documentation
+        "ID for the user in the authentication provider. Taken from the `:SUB'
+        field in the JWT when the user first logged in")
+   (username :col-type string :initarg :username :accessor username)
+   (email :col-type string :initarg :email :accessor email))
+  (:metaclass dao-class)
+  (:keys sub)
+  (:table-name users)
+  (:documentation
+   "Panettone users. Uses an external authentication provider."))
+
+(deftable (user "users")
+  (!dao-def))
+
 (defclass user-settings ()
   ((user-dn :col-type string :initarg :user-dn :accessor user-dn)
    (enable-email-notifications
@@ -81,15 +108,6 @@ database connection."
   "Type specifier for the status of an `issue'"
   (cons 'member +issue-statuses+))
 
-(defun ddl/create-issue-status ()
-  "Issue DDL to create the `issue-status' type, if it doesn't exist"
-  (unless (query (:select (:exists (:select 1
-                                    :from 'pg_type
-                                    :where (:= 'typname "issue_status"))))
-                 :single)
-    (query (sql-compile
-            `(:create-enum issue-status ,+issue-statuses+)))))
-
 (defclass has-created-at ()
   ((created-at :col-type timestamp
                :col-default (local-time:now)
@@ -196,23 +214,171 @@ its new value will be formatted using ~A into NEW-VALUE"))
   (!dao-def)
   (!foreign 'issues 'issue-id 'id :on-delete :cascade :on-update :cascade))
 
-(define-constant +all-tables+
-    '(issue
-      issue-comment
-      issue-event
-      user-settings)
-  :test #'equal)
+(defclass migration ()
+  ((version
+    :col-type bigint
+    :primary-key t
+    :initarg :version
+    :accessor version)
+   (name :col-type string :initarg :name :accessor name)
+   (docstring :col-type string :initarg :docstring :accessor docstring)
+   (path :col-type string
+         :type pathname
+         :initarg :path
+         :accessor path
+         :col-export namestring
+         :col-import parse-namestring)
+   (package :type keyword :initarg :package :accessor migration-package))
+  (:metaclass dao-class)
+  (:keys version)
+  (:table-name migrations)
+  (:documentation "Migration scripts that have been run on the database"))
+(deftable migration (!dao-def))
 
-(defun ddl/create-tables ()
-  "Issue DDL to create all tables, if they don't already exist."
-  (dolist (table +all-tables+)
-    (unless (table-exists-p (dao-table-name table))
-      (create-table table))))
+;;;
+;;; Utils
+;;;
 
-(defun ddl/init ()
-  "Idempotently initialize the full database schema for Panettone"
-  (ddl/create-issue-status)
-  (ddl/create-tables))
+(defun create-table-if-not-exists (name)
+  " Takes the name of a dao-class and creates the table identified by symbol by
+executing all forms in its definition as found in the *tables* list, if it does
+not already exist."
+  (unless (table-exists-p (dao-table-name name))
+    (create-table name)))
+
+;;;
+;;; Migrations
+;;;
+
+(defun ensure-migrations-table ()
+  "Ensure the migrations table exists"
+  (unless (table-exists-p (dao-table-name 'migration))
+    (create-table 'migration)))
+
+(define-build-time-var *migrations-dir* "migrations/"
+    "The directory where migrations are stored")
+
+(defun load-migration-docstring (migration-path)
+  "If the first form in the file pointed to by `migration-pathname` is
+  a string, return it, otherwise return NIL."
+
+  (handler-case
+      (with-open-file (s migration-path)
+        (when-let ((form (read s)))
+          (when (stringp form) form)))
+    (t () nil)))
+
+(defun load-migration (path)
+  (let* ((parts (str:split #\- (pathname-name path) :limit 2))
+         (version (parse-integer (car parts)))
+         (name (cadr parts))
+         (docstring (load-migration-docstring path))
+         (package (intern (format nil "MIGRATION-~A" version)
+                          :keyword))
+         (migration (make-instance 'migration
+                                   :version version
+                                   :name name
+                                   :docstring docstring
+                                   :path path
+                                   :package package)))
+    (uiop/package:ensure-package package
+                                 :use '(#:common-lisp
+                                        #:postmodern
+                                        #:panettone.model))
+    (let ((*package* (find-package package)))
+      (load path))
+
+    migration))
+
+(defun run-migration (migration)
+  (declare (type migration migration))
+  (with-transaction ()
+    (format t "Running migration ~A (version ~A)"
+            (name migration)
+            (version migration))
+    (query
+     (sql-compile
+      `(:delete-from migrations
+        :where (= version ,(version migration)))))
+    (uiop:symbol-call (migration-package migration) :up)
+    (insert-dao migration)))
+
+(defun list-migration-files ()
+  (remove-if-not
+   (lambda (pn) (string= "lisp" (pathname-type pn)))
+   (uiop:directory-files (util:->dir *migrations-dir*))))
+
+(defun load-migrations ()
+  (mapcar #'load-migration (list-migration-files)))
+
+(defun generate-migration (name &key documentation)
+  "Generate a new database migration with the given NAME, optionally
+prepopulated with the given DOCUMENTATION.
+
+Returns the file that the migration is located at, as a `pathname'. Write Lisp
+code in this migration file to define a function called `up', which will be run
+in the context of a database transaction and should perform the migration."
+  (let* ((version (get-universal-time))
+         (filename (format nil "~A-~A.lisp"
+                           version
+                           name))
+         (pathname
+           (merge-pathnames filename *migrations-dir*)))
+    (with-open-file (stream pathname
+                            :direction :output
+                            :if-does-not-exist :create)
+      (when documentation
+        (format stream "~S~%~%" documentation))
+
+      (format stream "(defun up ()~%)"))
+    pathname))
+
+(defun migrations-already-run ()
+  "Query the database for a list of migrations that have already been run"
+  (query-dao 'migration (sql-compile '(:select * :from migrations))))
+
+(define-condition migration-name-mismatch ()
+  ((version :type integer :initarg :version)
+   (name-in-database :type string :initarg :name-in-database)
+   (name-in-code :type string :initarg :name-in-code))
+  (:report
+   (lambda (cond stream)
+     (format stream "Migration mismatch: Migration version ~A has name ~S in the database, but we have name ~S"
+             (slot-value cond 'version)
+             (slot-value cond 'name-in-database)
+             (slot-value cond 'name-in-code)))))
+
+(defun migrate ()
+  "Migrate the database, running all migrations that have not yet been run"
+  (ensure-migrations-table)
+  (format t "Running migrations from ~A...~%" *migrations-dir*)
+  (let* ((all-migrations (load-migrations))
+         (already-run (migrations-already-run))
+         (num-migrations-run 0))
+    (iter (for migration in all-migrations)
+      (if-let ((existing (find-if (lambda (existing)
+                                    (= (version existing)
+                                       (version migration)))
+                                  already-run)))
+        (progn
+          (unless (string= (name migration)
+                           (name existing))
+            (restart-case
+                (error 'migration-name-mismatch
+                       :version (version existing)
+                       :name-in-database (name existing)
+                       :name-in-code (name migration))
+              (skip ()
+                :report "Skip this migration"
+                (next-iteration))
+              (run-and-overwrite ()
+                :report "Run this migration anyway, overwriting the previous migration"
+                (run-migration migration))))
+          (next-iteration))
+        ;; otherwise, run the migration
+        (run-migration migration))
+      (incf num-migrations-run))
+    (format t "Ran ~A migration~:P~%" num-migrations-run)))
 
 ;;;
 ;;; Querying
@@ -247,28 +413,35 @@ type `ISSUE-NOT-FOUND'."
                       :where (:= 'id id))))
    :single))
 
-(defun list-issues (&key status (with '(:num-comments)))
+(defun list-issues (&key status search (with '(:num-comments)))
   "Return a list of all issues with the given STATUS (or all if nil), ordered by
   ID descending. If WITH contains `:NUM-COMMENTS' (the default) each issue will
   have the `num-comments' slot filled with the number of comments on that issue
   (to avoid N+1 queries)."
-  (let* ((condition (unless (null status)
-                      `(:where (:= status $1))))
+  (let* ((conditions
+           (and-where*
+            (unless (null status)
+              `(:= status $1))
+            (when (str:non-blank-string-p search)
+              `(:@@ tsv (:websearch-to-tsquery ,search)))))
          (select (if (find :num-comments with)
                      `(:select issues.* (:as (:count issue-comments.id)
                                              num-comments)
-                               :from issues
-                               :left-join issue-comments
-                               :on (:= issues.id issue-comments.issue-id)
-                               ,@condition
-                               :group-by issues.id)
-                     `(:select * :from issues ,@condition)))
+                       :from issues
+                       :left-join issue-comments
+                       :on (:= issues.id issue-comments.issue-id)
+                       :where ,conditions
+                       :group-by issues.id)
+                     `(:select * :from issues :where ,conditions)))
+         (order (if (str:non-blank-string-p search)
+                    `(:desc (:ts-rank-cd tsv (:websearch-to-tsquery ,search)))
+                    `(:desc id)))
          (query (sql-compile
-                 `(:order-by ,select (:desc id)))))
+                 `(:order-by ,select ,order))))
     (with-column-writers ('num_comments 'num-comments)
       (query-dao 'issue query status))))
 
-(defmethod num-comments ((issue-id integer))
+(defmethod count-comments ((issue-id integer))
   "Return the number of comments for the given ISSUE-ID."
   (query
    (:select (:count '*)
@@ -306,7 +479,6 @@ NOTE: This makes a database query, so be wary of N+1 queries"
      :where (:= 'issue-id issue-id))
     (:asc 'created-at))))
 
-
 ;;;
 ;;; Writing
 ;;;
@@ -414,13 +586,23 @@ explicitly subscribing to / unsubscribing from individual issues."
 
 
 (comment
- (connect-postgres)
- (ddl/init)
+
  (make-instance 'issue :subject "test")
- (create-issue :subject "test"
-               :author-dn "cn=grfn,ou=users,dc=tvl,dc=fyi")
+
+ (with-connection *pg-spec*
+   (create-issue :subject "test"
+                 :author-dn "cn=aspen,ou=users,dc=tvl,dc=fyi"))
 
  (issue-commenter-dns 1)
  (issue-subscribers 1)
 
+ ;; Creating new migrations
+ (setq *migrations-dir* (merge-pathnames "migrations/"))
+ (generate-migration "create-users-table"
+                     :documentation "Add a table to store information about users")
+ (load-migrations)
+
+ ;; Running migrations
+ (with-connection *pg-spec*
+   (migrate))
  )
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index b0833e4541..8e77c0ff2b 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -1,7 +1,10 @@
 (defpackage panettone.util
+  (:nicknames :util)
   (:use :cl :klatre)
   (:import-from :alexandria :when-let)
-  (:export :integer-env))
+  (:export
+   :integer-env :add-missing-base64-padding :and-where :and-where*
+   :define-build-time-var :->dir))
 
 (defpackage panettone.css
   (:use :cl :lass)
@@ -23,24 +26,34 @@
   (:import-from :defclass-std :defclass/std)
   (:import-from :alexandria :when-let :with-gensyms)
   (:export
-   :*user* :*ldap*
+   :*user*
+   :auth-url
+   :fetch-token
    :user :cn :dn :mail :displayname
-   :connect-ldap :find-user :find-user-by-dn :authenticate-user))
+   :find-user-by-dn
+   :initialise-oauth2))
 
 (defpackage panettone.model
   (:nicknames :model)
   (:use :cl :panettone.util :klatre :postmodern :iterate)
   (:import-from :alexandria :if-let :when-let :define-constant)
   (:export
-   :connect-postgres :ddl/init :make-thread
+   :prepare-db-connections
+   :migrate
+   :*pg-spec*
+
+   :create-table-if-not-exists
+
+   :user
+   :sub :username :email
 
    :user-settings
    :user-dn :enable-email-notifications-p :settings-for-user
    :update-user-settings :enable-email-notifications
 
-   :issue :issue-comment :issue-event
+   :issue :issue-comment :issue-event :migration
    :id :subject :body :author-dn :issue-id :status :created-at :acting-user-dn
-   :field :previous-value :new-value
+   :field :previous-value :new-value :+issue-statuses+
 
    :get-issue :issue-exists-p :list-issues :create-issue :set-issue-status
    :update-issue :delete-issue :issue-not-found :not-found-id
@@ -53,7 +66,7 @@
 (defpackage panettone.email
   (:nicknames :email)
   (:use :cl)
-  (:import-from :alexandria :when-let)
+  (:import-from :alexandria :when-let :when-let*)
   (:import-from :panettone.model
    :settings-for-user :enable-email-notifications-p)
   (:import-from :panettone.authentication
@@ -76,7 +89,7 @@
    :panettone.model
    :id :subject :body :author-dn :issue-id :status :created-at
    :field :previous-value :new-value :acting-user-dn
-   :issue-comments :num-comments :issue-events)
+   :*pg-spec*)
   (:import-from :panettone.irc :send-irc-notification)
   (:shadow :next)
-  (:export :start-pannetone :config :main))
+  (:export :start-panettone :config :main))
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index 4c9c7dafee..37d194d0f9 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -78,7 +78,7 @@
          (who:htm
           (:a :href
               (format nil
-                      "/login?original-uri=~A"
+                      "/auth?original-uri=~A"
                       (drakma:url-encode (hunchentoot:request-uri*)
                                          :utf-8))
               "Log In"))))))
@@ -135,36 +135,6 @@
     (when message
       (who:htm (:div :class "alert" (who:esc message))))))
 
-(defun render/login (&key message (original-uri "/"))
-  (render (:footer nil :header nil)
-    (:div
-     :class "login-form"
-     (:header
-      (:h1 "Login"))
-     (:main
-      :class "login-form"
-      (render/alert message)
-      (:form
-       :method :post :action "/login"
-       (:input :type "hidden" :name "original-uri"
-               :value (who:escape-string original-uri))
-       (:div
-        (:label :for "username"
-                "Username")
-        (:input :type "text"
-                :name "username"
-                :id "username"
-                :placeholder "username"))
-       (:div
-        (:label :for "password"
-                "Password")
-        (:input :type "password"
-                :name "password"
-                :id "password"
-                :placeholder "password"))
-       (:input :type "submit"
-               :value "Submit"))))))
-
 (defun render/settings ()
   (let ((settings (model:settings-for-user (dn *user*))))
     (render ()
@@ -215,7 +185,7 @@
                       (who:esc (format nil "#~A" issue-id)))
                " - "
                (created-by-at issue)
-               (let ((num-comments (length (issue-comments issue))))
+               (let ((num-comments (length (model:issue-comments issue))))
                  (unless (zerop num-comments)
                    (who:htm
                     (:span :class "comment-count"
@@ -223,7 +193,21 @@
                            (who:esc
                             (format nil "~A comment~:p" num-comments))))))))))))))
 
-(defun render/index (&key issues)
+(defun render/issue-search (&key search)
+  (who:with-html-output (*standard-output*)
+    (:form
+     :method "get"
+     :class "issue-search"
+     (:input :type "search"
+             :name "search"
+             :title "Issue search query"
+             :value search)
+     (:input
+      :type "submit"
+      :value "Search Issues"
+      :class "sr-only"))))
+
+(defun render/index (&key issues search)
   (render ()
     (:header
      (:h1 "Issues")
@@ -235,17 +219,19 @@
     (:main
      (:div
       :class "issue-links"
-      (:a :href "/issues/closed" "View closed issues"))
+      (:a :href "/issues/closed" "View closed issues")
+      (render/issue-search :search search))
      (render/issue-list :issues issues))))
 
-(defun render/closed-issues (&key issues)
+(defun render/closed-issues (&key issues search)
   (render ()
     (:header
      (:h1 "Closed issues"))
     (:main
      (:div
       :class "issue-links"
-      (:a :href "/" "View open isues"))
+      (:a :href "/" "View open isues")
+      (render/issue-search :search search))
      (render/issue-list :issues issues))))
 
 (defun render/issue-form (&optional issue message)
@@ -383,21 +369,22 @@
                      (:open "Close")
                      (:closed "Reopen"))))))
        (:p (who:str (render-markdown (body issue))))
-       (let* ((comments (issue-comments issue))
-              (events (issue-events issue))
+       (let* ((comments (model:issue-comments issue))
+              (events (model:issue-events issue))
               (history (merge 'list
                               comments
                               events
                               #'local-time:timestamp<
                               :key #'created-at)))
          (markdownify-comment-bodies comments)
-         (who:htm
-          (:ol
-           :class "issue-history"
-           (dolist (item history)
-             (render/issue-history-item item))
-           (when *user*
-             (render/new-comment (id issue))))))))))
+         (when (or history *user*)
+           (who:htm
+            (:ol
+             :class "issue-history"
+             (dolist (item history)
+               (render/issue-history-item item))
+             (when *user*
+               (render/new-comment (id issue)))))))))))
 
 (defun render/not-found (entity-type)
   (render ()
@@ -412,14 +399,15 @@
   "Send an email notification to all subscribers to the given issue with the
 given subject an body (in a thread, to avoid blocking)"
   (let ((current-user *user*))
-    (model:make-thread
+    (bordeaux-threads:make-thread
      (lambda ()
-       (dolist (user-dn (model:issue-subscribers issue-id))
-         (when (not (equal (dn current-user) user-dn))
-           (email:notify-user
-            user-dn
-            :subject subject
-            :message message)))))))
+       (pomo:with-connection *pg-spec*
+         (dolist (user-dn (model:issue-subscribers issue-id))
+           (when (not (equal (dn current-user) user-dn))
+             (email:notify-user
+              user-dn
+              :subject subject
+              :message message))))))))
 
 (defun link-to-issue (issue-id)
   (format nil "https://b.tvl.fyi/issues/~A" issue-id))
@@ -432,20 +420,22 @@ given subject an body (in a thread, to avoid blocking)"
   (if-let ((*user* (hunchentoot:session-value 'user)))
     (funcall next)
     (hunchentoot:redirect
-     (format nil "/login?original-uri=~A"
+     (format nil "/auth?original-uri=~A"
              (drakma:url-encode
               (hunchentoot:request-uri*)
               :utf-8)))))
 
-(defun @txn (next)
-  (pomo:with-transaction ()
-    (catch
-        ;; 'hunchentoot:handler-done is unexported, but is used by functions
-        ;; like hunchentoot:redirect to nonlocally abort the request handler -
-        ;; this doesn't mean an error occurred, so we need to catch it here to
-        ;; make the transaction still get committed
-        (intern "HANDLER-DONE" "HUNCHENTOOT")
-      (funcall next))))
+(defun @db (next)
+  "Decorator for handlers that use the database, wrapped in a transaction."
+  (pomo:with-connection *pg-spec*
+    (pomo:with-transaction ()
+      (catch
+          ;; 'hunchentoot:handler-done is unexported, but is used by functions
+          ;; like hunchentoot:redirect to nonlocally abort the request handler -
+          ;; this doesn't mean an error occurred, so we need to catch it here to
+          ;; make the transaction still get committed
+          (intern "HANDLER-DONE" "HUNCHENTOOT")
+        (funcall next)))))
 
 (defun @handle-issue-not-found (next)
   (handler-case (funcall next)
@@ -453,33 +443,31 @@ given subject an body (in a thread, to avoid blocking)"
       (render/not-found
        (format nil "Issue #~A" (model:not-found-id err))))))
 
-(defroute login-form ("/login" :method :get)
-    (original-uri)
-  (if (hunchentoot:session-value 'user)
-      (hunchentoot:redirect (or original-uri "/"))
-      (render/login :original-uri original-uri)))
+(defroute auth-handler ("/auth" :method :get :decorators (@auth-optional)) ()
+  (if-let ((code (hunchentoot:get-parameter "code")))
+    (let ((user (fetch-token code)))
+      (setf (hunchentoot:session-value 'user) user)
+      (hunchentoot:redirect (or (hunchentoot:session-value 'original-uri) "/")))
 
-(defroute submit-login ("/login" :method :post)
-    (&post original-uri username password)
-  (if-let ((user (authenticate-user username password)))
     (progn
-      (setf (hunchentoot:session-value 'user) user)
-      (hunchentoot:redirect (or original-uri "/")))
-    (render/login :message "Invalid credentials"
-                  :original-uri original-uri)))
+      (when-let ((original-uri (hunchentoot:get-parameter "original-uri")))
+        (setf (hunchentoot:session-value 'original-uri) original-uri))
+      (hunchentoot:redirect (authn:auth-url)))))
 
 (defroute logout ("/logout" :method :post) ()
   (hunchentoot:delete-session-value 'user)
   (hunchentoot:redirect "/"))
 
-(defroute index ("/" :decorators (@auth-optional)) ()
-  (let ((issues (model:list-issues :status :open)))
-    (render/index :issues issues)))
+(defroute index ("/" :decorators (@auth-optional @db)) (&get search)
+  (let ((issues (model:list-issues :status :open
+                                   :search search)))
+    (render/index :issues issues
+                  :search search)))
 
-(defroute settings ("/settings" :method :get :decorators (@auth)) ()
+(defroute settings ("/settings" :method :get :decorators (@auth @db)) ()
   (render/settings))
 
-(defroute save-settings ("/settings" :method :post :decorators (@auth))
+(defroute save-settings ("/settings" :method :post :decorators (@auth @db))
     (&post enable-email-notifications)
   (let ((settings (model:settings-for-user (dn *user*))))
     (model:update-user-settings
@@ -488,15 +476,18 @@ given subject an body (in a thread, to avoid blocking)"
     (render/settings)))
 
 (defroute handle-closed-issues
-    ("/issues/closed" :decorators (@auth-optional)) ()
-  (let ((issues (model:list-issues :status :closed)))
-    (render/closed-issues :issues issues)))
+    ("/issues/closed" :decorators (@auth-optional @db))
+    (&get search)
+  (let ((issues (model:list-issues :status :closed
+                                   :search search)))
+    (render/closed-issues :issues issues
+                          :search search)))
 
 (defroute new-issue ("/issues/new" :decorators (@auth)) ()
   (render/issue-form))
 
 (defroute handle-create-issue
-    ("/issues" :method :post :decorators (@auth @txn))
+    ("/issues" :method :post :decorators (@auth @db))
     (&post subject body)
   (if (string= subject "")
       (render/issue-form
@@ -515,10 +506,11 @@ given subject an body (in a thread, to avoid blocking)"
                  (id issue))
          :channel (or (uiop:getenvp "ISSUECHANNEL")
                       "#tvl"))
-        (hunchentoot:redirect "/"))))
+        (hunchentoot:redirect
+         (format nil "/issues/~A" (id issue))))))
 
 (defroute show-issue
-    ("/issues/:id" :decorators (@auth-optional @handle-issue-not-found))
+    ("/issues/:id" :decorators (@auth-optional @handle-issue-not-found @db))
     (&path (id 'integer))
   (let* ((issue (model:get-issue id))
          (*title* (format nil "~A | Panettone"
@@ -526,14 +518,14 @@ given subject an body (in a thread, to avoid blocking)"
     (render/issue issue)))
 
 (defroute edit-issue
-    ("/issues/:id/edit" :decorators (@auth @handle-issue-not-found))
+    ("/issues/:id/edit" :decorators (@auth @handle-issue-not-found @db))
     (&path (id 'integer))
   (let* ((issue (model:get-issue id))
          (*title* "Edit Issue | Panettone"))
     (render/issue-form issue)))
 
 (defroute update-issue
-    ("/issues/:id" :decorators (@auth @handle-issue-not-found @txn)
+    ("/issues/:id" :decorators (@auth @handle-issue-not-found @db)
                    ;; NOTE: this should be a put, but we're all HTML forms
                    ;; right now and those don't support PUT
                    :method :post)
@@ -551,7 +543,7 @@ given subject an body (in a thread, to avoid blocking)"
 
 (defroute handle-create-comment
     ("/issues/:id/comments"
-     :decorators (@auth @handle-issue-not-found @txn)
+     :decorators (@auth @handle-issue-not-found @db)
      :method :post)
     (&path (id 'integer) &post body)
   (flet ((redirect-to-issue ()
@@ -578,7 +570,7 @@ given subject an body (in a thread, to avoid blocking)"
        (redirect-to-issue)))))
 
 (defroute close-issue
-    ("/issues/:id/close" :decorators (@auth @handle-issue-not-found @txn)
+    ("/issues/:id/close" :decorators (@auth @handle-issue-not-found @db)
                          :method :post)
     (&path (id 'integer))
   (model:set-issue-status id :closed)
@@ -602,7 +594,7 @@ given subject an body (in a thread, to avoid blocking)"
   (hunchentoot:redirect (format nil "/issues/~A" id)))
 
 (defroute open-issue
-    ("/issues/:id/open" :decorators (@auth)
+    ("/issues/:id/open" :decorators (@auth @db)
                         :method :post)
     (&path (id 'integer))
   (model:set-issue-status id :open)
@@ -634,17 +626,15 @@ given subject an body (in a thread, to avoid blocking)"
 
 (defun migrate-db ()
   "Migrate the database to the latest version of the schema"
-  (model:ddl/init))
+  (pomo:with-connection *pg-spec*
+    (model:migrate)))
 
-(defun start-panettone (&key port
-                          (ldap-host "localhost")
-                          (ldap-port 389)
-                          postgres-params
-                          session-secret)
-  (connect-ldap :host ldap-host
-                :port ldap-port)
+(define-build-time-var *static-dir* "static/"
+    "Directory to serve static files from")
 
-  (apply #'model:connect-postgres postgres-params)
+(defun start-panettone (&key port session-secret)
+  (authn:initialise-oauth2)
+  (model:prepare-db-connections)
   (migrate-db)
 
   (when session-secret
@@ -653,12 +643,18 @@ given subject an body (in a thread, to avoid blocking)"
   (setq hunchentoot:*session-max-time* (* 60 60 24 90))
 
   (setq *acceptor*
-        (make-instance 'easy-routes:routes-acceptor :port port))
+        (make-instance 'easy-routes:easy-routes-acceptor :port port))
+
+  (push
+   (hunchentoot:create-folder-dispatcher-and-handler
+    "/static/"
+    (util:->dir *static-dir*))
+   hunchentoot:*dispatch-table*)
+
   (hunchentoot:start *acceptor*))
 
 (defun main ()
   (let ((port (integer-env "PANETTONE_PORT" :default 6161))
-        (ldap-port (integer-env "LDAP_PORT" :default 389))
         (cheddar-url (uiop:getenvp "CHEDDAR_URL"))
         (session-secret (uiop:getenvp "SESSION_SECRET")))
     (when cheddar-url (setq *cheddar-url* cheddar-url))
@@ -666,9 +662,10 @@ given subject an body (in a thread, to avoid blocking)"
     (setq hunchentoot:*log-lisp-backtraces-p* nil)
 
     (start-panettone :port port
-                     :ldap-port ldap-port
                      :session-secret session-secret)
 
+    (format t "launched panettone on port ~A~%" port)
+
     (sb-thread:join-thread
      (find-if (lambda (th)
                 (string= (sb-thread:thread-name th)
@@ -677,9 +674,8 @@ given subject an body (in a thread, to avoid blocking)"
 
 (comment
  (setq hunchentoot:*catch-errors-p* nil)
- ;; to setup an ssh tunnel to ldap+cheddar+irccat for development:
- ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
+ ;; to setup an ssh tunnel to cheddar+irccat for development:
+ ;; ssh -N -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
  (start-panettone :port 6161
-                  :ldap-port 3899
                   :session-secret "session-secret")
  )
diff --git a/web/panettone/src/static/search.png b/web/panettone/src/static/search.png
new file mode 100644
index 0000000000..0fd78c6651
--- /dev/null
+++ b/web/panettone/src/static/search.png
Binary files differdiff --git a/web/panettone/src/util.lisp b/web/panettone/src/util.lisp
index 9fd9ceaa79..4c3c4f1aa6 100644
--- a/web/panettone/src/util.lisp
+++ b/web/panettone/src/util.lisp
@@ -5,3 +5,35 @@
    (when-let ((str (uiop:getenvp var)))
      (try-parse-integer str))
    default))
+
+(defun add-missing-base64-padding (s)
+  "Add any missing padding characters to the (un-padded) base64 string `S', such
+that it can be successfully decoded by the `BASE64' package"
+  ;; I apologize
+  (let* ((needed-padding (mod (length s) 4))
+         (pad-chars (if (zerop needed-padding) 0 (- 4 needed-padding))))
+    (format nil "~A~v@{~A~:*~}" s pad-chars "=")))
+
+(defun and-where (clauses)
+  "Combine all non-nil clauses in CLAUSES into a single S-SQL WHERE form"
+  (let ((clauses (remove nil clauses)))
+    (if (null clauses) t
+        (reduce (lambda (x y) `(:and ,x ,y)) clauses))))
+
+(defun and-where* (&rest clauses)
+  "Combine all non-nil clauses in CLAUSES into a single S-SQL WHERE form"
+  (and-where clauses))
+
+(defmacro define-build-time-var
+    (name value-if-not-in-build &optional (doc nil))
+  `(defvar ,name
+     (or (when-let ((package (find-package :build)))
+           (let ((sym (find-symbol ,(symbol-name name) package)))
+             (when (boundp sym) (symbol-value sym))))
+         ,value-if-not-in-build)
+     ,doc))
+
+(defun ->dir (dir)
+  (if (char-equal (uiop:last-char dir) #\/)
+      dir
+      (concatenate 'string dir "/")))
diff --git a/web/panettone/test/util_test.lisp b/web/panettone/test/util_test.lisp
new file mode 100644
index 0000000000..ff52d916cb
--- /dev/null
+++ b/web/panettone/test/util_test.lisp
@@ -0,0 +1,9 @@
+(in-package :panettone.tests)
+(declaim (optimize (safety 3)))
+
+(test add-missing-base64-padding-test
+  (is (string=
+       "abcdef"
+       (base64:base64-string-to-string
+        (panettone.util:add-missing-base64-padding
+         "YWJjZGVm")))))
generated by cgit-pink 1.4.1 (git 2.44.0) at 2024-06-08T15ยท46+0000