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/OWNERS7
-rw-r--r--web/panettone/default.nix27
-rw-r--r--web/panettone/docker-compose.yml4
-rw-r--r--web/panettone/shell.nix4
-rw-r--r--web/panettone/src/authentication.lisp202
-rw-r--r--web/panettone/src/css.lisp131
-rw-r--r--web/panettone/src/email.lisp49
-rw-r--r--web/panettone/src/inline-markdown.lisp127
-rw-r--r--web/panettone/src/irc.lisp35
-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.lisp368
-rw-r--r--web/panettone/src/packages.lisp66
-rw-r--r--web/panettone/src/panettone.lisp410
-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/inline-markdown_test.lisp54
-rw-r--r--web/panettone/test/irc_test.lisp5
-rw-r--r--web/panettone/test/package.lisp3
-rw-r--r--web/panettone/test/util_test.lisp9
21 files changed, 1201 insertions, 366 deletions
diff --git a/web/panettone/OWNERS b/web/panettone/OWNERS
index c5903d6489..5ad475b1c7 100644
--- a/web/panettone/OWNERS
+++ b/web/panettone/OWNERS
@@ -1,4 +1,3 @@
-inherited: true
-owners:
-  - glittershark
-  - tazjin
+aspen
+tazjin
+sterni
diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index 3ff8ca55ec..60fca99e75 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -1,20 +1,22 @@
-{ depot, ... }:
+{ depot, pkgs, ... }:
 
 depot.nix.buildLisp.program {
   name = "panettone";
 
   deps = with depot.third_party.lisp; [
+    bordeaux-threads
     cl-json
     cl-ppcre
+    cl-smtp
     cl-who
-    drakma
+    str
     defclass-std
+    drakma
     easy-routes
     hunchentoot
     lass
     local-time
     postmodern
-    trivial-ldap
 
     depot.lisp.klatre
   ];
@@ -22,10 +24,22 @@ 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
+    ./src/inline-markdown.lisp
     ./src/authentication.lisp
     ./src/model.lisp
+    ./src/irc.lisp
     ./src/panettone.lisp
   ];
 
@@ -37,8 +51,15 @@ depot.nix.buildLisp.program {
     srcs = [
       ./test/package.lisp
       ./test/model_test.lisp
+      ./test/inline-markdown_test.lisp
+      ./test/util_test.lisp
     ];
 
     expression = "(fiveam:run!)";
   };
+
+  brokenOn = [
+    "ecl" # dependencies use dynamic cffi
+    "ccl" # The value NIL is not of the expected type STRING. when loading model.lisp
+  ];
 }
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 2051025753..496a0e0bd7 100644
--- a/web/panettone/src/authentication.lisp
+++ b/web/panettone/src/authentication.lisp
@@ -3,105 +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)
-  (with-ldap ()
-    (progn
-      (ldap:search *ldap* `(= objectClass organizationalPerson)
-                   :base dn
-                   :scope 'ldap:base)
-      (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=glittershark,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 5001d99fef..3bba2bb591 100644
--- a/web/panettone/src/css.lisp
+++ b/web/panettone/src/css.lisp
@@ -1,33 +1,9 @@
 (in-package :panettone.css)
 (declaim (optimize (safety 3)))
 
-(defparameter color/black
-  "rgb(24, 24, 24)")
-
-(defparameter color/light-gray
-  "#EEE")
-
-(defparameter color/gray
-  "#8D8D8D")
-
-(defparameter color/primary
-  "rgb(106, 154, 255)")
-
-(defparameter color/primary-light
-  "rgb(150, 166, 200)")
-
-(defparameter color/success
-  "rgb(168, 249, 166)")
-
-(defparameter color/success-2
-  "rgb(168, 249, 166)")
-
-(defparameter color/failure
-  "rgb(247, 167, 167)")
-
 (defun button (selector)
   `((,selector
-     :background-color ,color/success
+     :background-color "var(--success)"
      :padding "0.5rem"
      :text-decoration "none"
      :transition "box-shadow" "0.15s" "ease-in-out")
@@ -42,11 +18,11 @@
 
 (defparameter markdown-styles
   `((blockquote
-     :border-left "5px" "solid" ,color/light-gray
+     :border-left "5px" "solid" "var(--light)"-gray
      :padding-left "1rem"
      :margin-left "0rem")
     (pre
-     :overflow-x "scroll")))
+     :overflow-x "auto")))
 
 (defparameter issue-list-styles
   `((.issue-list
@@ -60,7 +36,7 @@
       :padding-bottom "1rem")
 
      ((li + li)
-      :border-top "1px" "solid" ,color/gray)
+      :border-top "1px" "solid" "var(--gray)")
 
      (a
       :text-decoration "none"
@@ -70,20 +46,37 @@
       :outline "none"
 
       (.issue-subject
-       :color ,color/primary)))
+       :color "var(--primary)")))
 
     (.comment-count
-     :color ,color/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
      :list-style "none"
-     :border-top "1px" "solid" ,color/gray
+     :border-top "1px" "solid" "var(--gray)"
      :padding-top "1rem"
      :padding-left "2rem"
 
      (.comment-info
-      :color ,color/gray
+      :color "var(--gray)"
       :margin 0
       :padding-top "1rem"
 
@@ -94,16 +87,16 @@
      ((:or .comment .event)
       :padding-top "1rem"
       :padding-bottom "1rem"
-      :border-bottom "1px" "solid" ,color/gray
+      :border-bottom "1px" "solid" "var(--gray)"
 
       (p :margin 0))
 
      ((:and (:or .comment .event) :target)
-      :border-color ,color/primary
+      :border-color "var(--primary)"
       :border-bottom-width "3px")
 
      (.event
-      :color ,color/gray))))
+      :color "var(--gray)"))))
 
 (defparameter form-styles
   `(((:or (:and input (:or (:= type "text")
@@ -115,7 +108,7 @@
      :border-top "none"
      :border-left "none"
      :border-right "none"
-     :border-bottom "1px" "solid" ,color/gray
+     :border-bottom "1px" "solid" "var(--gray)"
      :margin-bottom "1rem")
 
     (textarea
@@ -138,7 +131,13 @@
 
      ((:and input (:= type "submit")
             (:or :hover :active :focus))
-      :box-shadow 0 0 0 0))))
+      :box-shadow 0 0 0 0))
+
+    (.form-group
+     :margin-top "1rem")
+
+    (label.checkbox
+     :cursor "pointer")))
 
 (defparameter issue-styles
   `((.issue-info
@@ -152,12 +151,12 @@
       :flex 1)
 
      (.edit-issue
-      :background-color ,color/light-gray
+      :background-color "var(--light)"-gray
       :flex 0
       :margin-right "0.5rem")
 
      (.close-issue
-      :background-color ,color/failure))))
+      :background-color "var(--failure)"))))
 
 (defparameter styles
   `(,@form-styles
@@ -168,7 +167,27 @@
 
     (body
      :font-family "sans-serif"
-     :color ,color/black)
+     :color "var(--text)"
+     :background "var(--bg)"
+     :--text "rgb(24, 24, 24)"
+     :--bg "white"
+     :--gray "#8D8D8D"
+     :--primary "rgb(106, 154, 255)"
+     :--primary-light "rgb(150, 166, 200)"
+     :--success "rgb(168, 249, 166)"
+     :--failure "rgb(247, 167, 167)"
+     :--light-gray "#EEE")
+
+    (:media "(prefers-color-scheme: dark)"
+      (body
+        :--text "rgb(240, 240, 240)"
+        :--bg "black"
+        :--gray "#8D8D8D"
+        :--primary "rgb(106, 154, 255)"
+        :--primary-light "rgb(150, 166, 200)"
+        :--success "rgb(14, 130, 11)"
+        :--failure "rgb(124, 14, 14)"
+        :--light-gray "#222"))
 
     (a :color "inherit")
 
@@ -179,7 +198,7 @@
     (header
      :display "flex"
      :align-items "center"
-     :border-bottom "1px" "solid" ,color/black
+     :border-bottom "1px" "solid" "var(--text)"
      :margin-bottom "1rem"
 
      (h1
@@ -187,30 +206,46 @@
       :flex 1)
 
      (.issue-number
-      :color ,color/gray
+      :color "var(--gray)"
       :font-size "1.5rem"))
 
     (nav
      :display "flex"
-     :color ,color/gray
-     :justify-content "space-between")
+     :color "var(--gray)"
+     :justify-content "space-between"
+
+     (.nav-group
+      :display "flex"
+      (>*
+       :margin-left "0.5rem")))
 
     (footer
-     :border-top "1px" "solid" ,color/gray
+     :border-top "1px" "solid" "var(--gray)"
      :padding-top "1rem"
      :margin-top "1rem"
-     :color ,color/gray)
+     :color "var(--gray)")
 
     ,@(button '.new-issue)
 
     (.alert
      :padding "0.5rem"
      :margin-bottom "1rem"
-     :background-color ,color/failure)
+     :background-color "var(--failure)")
 
     (.login-form
      :max-width "300px"
      :margin "0 auto")
 
     (.created-by-at
-     :color ,color/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
new file mode 100644
index 0000000000..66ea299858
--- /dev/null
+++ b/web/panettone/src/email.lisp
@@ -0,0 +1,49 @@
+(in-package :panettone.email)
+(declaim (optimize (safety 3)))
+
+(defvar *smtp-server* "localhost"
+  "The host for SMTP connections")
+
+(defvar *smtp-server-port* 2525
+  "The port for SMTP connections")
+
+(defvar *notification-from* "tvlbot@tazj.in"
+  "The email address to send email notifications from")
+
+(defvar *notification-from-display-name* "Panettone"
+  "The Display Name to use when sending email notifications")
+
+(defvar *notification-subject-prefix* "[panettone]"
+  "String to prefix all email subjects with")
+
+(defun send-email-notification (&key to subject message)
+  "Sends an email to TO with the given SUBJECT and MESSAGE, using the current
+values of `*smtp-server*', `*smtp-server-port*' and `*email-notification-from*'"
+  (let ((subject (if *notification-subject-prefix*
+                     (format nil "~A ~A"
+                             *notification-subject-prefix*
+                             subject)
+                     subject)))
+    (cl-smtp:send-email
+     *smtp-server*
+     *notification-from*
+     to
+     subject
+     message
+     :port *smtp-server-port*
+     :display-name *notification-from-display-name*)))
+
+(defun user-has-email-notifications-enabled-p (dn)
+  "Returns T if the user with the given DN has enabled email notifications"
+  (enable-email-notifications-p (settings-for-user dn)))
+
+(defun notify-user (dn &key subject message)
+  "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))
+                (user-mail (mail user)))
+      (send-email-notification
+       :to user-mail
+       :subject subject
+       :message message))))
diff --git a/web/panettone/src/inline-markdown.lisp b/web/panettone/src/inline-markdown.lisp
new file mode 100644
index 0000000000..e49293519b
--- /dev/null
+++ b/web/panettone/src/inline-markdown.lisp
@@ -0,0 +1,127 @@
+(in-package :panettone.inline-markdown)
+(declaim (optimize (safety 3)))
+
+(define-constant +inline-markup-types+
+  '(("~~" :del)
+    ("*"  :em)
+    ("`"  :code))
+  :test #'equal)
+
+(defun next-token (mkdn &optional (escaped nil))
+  "Parses and returns the next token from the beginning of
+  an inline markdown string which is not altered. The resulting
+  tokens are either :normal (normal text), :special (syntactically
+  significant) or :escaped (escaped using \\). If the string is
+  empty, a pseudo-token named :endofinput is returned. Return value
+  is a list where the first element is the token type, the second
+  the token content and optionally the third the markup type."
+  ; special tokens are syntactically significant characters
+  ; or strings for our inline markdown subset. “normal” tokens
+  ; the strings in between
+  (let* ((special-toks #.'(cons (list "\\" :escape) +inline-markup-types+))
+         (toks (loop
+                 for tok in special-toks
+                 for pos = (search (car tok) mkdn)
+                 when pos collect (cons tok pos)))
+         (next-tok
+           (unless (null toks)
+             (reduce (lambda (a b) (if (< (cdr a) (cdr b)) a b)) toks))))
+    (cond
+      ; end of input
+      ((= (length mkdn) 0) (list :endofinput ""))
+      ; no special tokens, just return entire string
+      ((null next-tok) (list :normal mkdn))
+      ; special token, but not at the beginning of the string
+      ; so we return everything until the special token as
+      ; a string
+      ((> (cdr next-tok) 0) (list :normal (subseq mkdn 0 (cdr next-tok))))
+      ; \ at the beginning of the string: we get the next
+      ; token and mark it as escaped unless we are already
+      ; escaping in which case we just return the backslash
+      ; as a special token
+      ((eq (cadr (car next-tok)) :escape)
+       (if escaped
+         (list :special "\\")
+         (list :escaped
+               (next-token (subseq mkdn 1) t))))
+      ; any other special token at the beginning of the string
+      ; here we also pass the markup type as a third list element
+      ; to prevent unnecessesary lookups
+      (t (list :special
+               (subseq mkdn 0 (length (car (car next-tok))))
+               (cadr (car next-tok)))))))
+
+(defun token-length (tok-type tok-str)
+  "Returns the string length consumed by a call
+  to next-token returning the given token type and string."
+  (check-type tok-type symbol)
+  (if (eq tok-type :escaped)
+    ; backslash + length of escaped token
+    (progn
+      (check-type tok-str list)
+      (1+ (token-length (car tok-str) (cadr tok-str))))
+    (progn
+      (check-type tok-str string)
+      (length tok-str))))
+
+(defun write-tag (tag pos &optional (target *standard-output*))
+  "Wrapper around who:convert-tag-to-string-list to
+  only output a single :opening or :closing tag."
+  (check-type tag symbol)
+  (check-type pos symbol)
+  (let
+    ((index
+       (cond
+         ((eq pos :opening) 0)
+         ((eq pos :closing) 3)
+         (t (error 'simple-type-error)))))
+    (dolist
+      (tag-part (subseq
+                  (who:convert-tag-to-string-list tag nil nil nil)
+                  index (+ index 3)))
+      (write-string tag-part target))))
+
+(defun render-inline-markdown (s &optional (target *standard-output*) (in :normal))
+  "Render inline markdown, a subset of markdown safe to render
+  inside inline elements. The resulting html is directly written
+  to a specified stream or *standard-output* to integrate well
+  with cl-who."
+  (check-type s string)
+  (check-type target stream)
+  (loop
+    for (tok-type tok-str tok-markup) = (next-token s)
+    do (setq s (subseq s (token-length tok-type tok-str)))
+    when (eq tok-type :endofinput)
+    return ""
+    when (eq tok-type :normal)
+    do (write-string (who:escape-string tok-str) target)
+    when (eq tok-type :escaped)
+    do (progn
+         ; if normal tokens are escaped we treat the \ as if it were \\
+         ;
+         ; TODO(sterni): maybe also use the :normal behavior in :code except for #\`.
+         (when (eq (car tok-str) :normal)
+           (write-char #\\ target))
+         (write-string (who:escape-string (cadr tok-str)) target))
+    when (eq tok-type :special)
+    do (cond
+         ; we are on the outer level and encounter a special token:
+         ; render surrounding tags and call ourselves to render
+         ; inner content.
+         ((eq in :normal)
+          (progn
+            (write-tag tok-markup :opening target)
+            (setq s (render-inline-markdown s target tok-markup))
+            (write-tag tok-markup :closing target)))
+         ; we are on the inner level and encounter the token that initiated
+         ; our markup again, meaning we need to return to the outer level.
+         ; we return the remaining string to be consumed.
+         ((eq in tok-markup) (return s))
+         ; remaining case: we are on the inner level and encounter different markup.
+
+         ; we don't support nested markup for simplicity reasons, so instead we
+         ; just render any nested markdown tokens as if they were escaped. This
+         ; 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.
+         (t (write-string (who:escape-string tok-str) target)))))
diff --git a/web/panettone/src/irc.lisp b/web/panettone/src/irc.lisp
new file mode 100644
index 0000000000..2ab72a2e39
--- /dev/null
+++ b/web/panettone/src/irc.lisp
@@ -0,0 +1,35 @@
+;;;; Using irccat to send IRC notifications
+
+(in-package :panettone.irc)
+
+(defun noping (s)
+  (format nil "~A~A~A"
+          (char s 0)
+          #\ZERO_WIDTH_SPACE
+          (subseq s 1)))
+
+(defun get-irccat-config ()
+  "Reads the IRCCATHOST and IRCCATPORT environment variables, and returns them
+as two values"
+  (destructuring-bind (host port)
+      (mapcar #'uiop:getenvp '("IRCCATHOST" "IRCCATPORT"))
+    (if (and host port)
+        (values host (parse-integer port))
+        (values "localhost" 4722))))
+
+(defun send-irc-notification (body &key channel)
+  "Sends BODY to the IRC channel CHANNEL (starting with #),
+if an IRCCat server is configured (using the IRCCATHOST and IRCCATPORT
+environment variables).
+May signal a condition if sending fails."
+  (multiple-value-bind (irchost ircport) (get-irccat-config)
+    (when irchost
+      (let ((socket (socket-connect irchost ircport)))
+        (unwind-protect
+             (progn
+               (format (socket-stream socket) "~@[~A ~]~A~A~%"
+                       channel
+                       #\ZERO_WIDTH_SPACE
+                       body)
+               (finish-output (socket-stream socket)))
+          (ignore-errors (socket-close socket)))))))
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 300ee19b6b..a106e9479b 100644
--- a/web/panettone/src/model.lisp
+++ b/web/panettone/src/model.lisp
@@ -1,19 +1,106 @@
 (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))
+(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
+    :col-type boolean
+    :initarg :enable-email-notifications
+    :accessor enable-email-notifications-p
+    :initform t
+    :col-default t))
+  (:metaclass dao-class)
+  (:keys user-dn)
+  (:table-name user_settings)
+  (:documentation
+   "Panettone settings for an individual user DN"))
+
+(deftable (user-settings "user_settings")
+  (!dao-def))
+
+(defun settings-for-user (dn)
+  "Retrieve the settings for the user with the given DN, creating a new row in
+  the database if not yet present"
+  (or
+   (car
+    (query-dao
+     'user-settings
+     (:select '* :from 'user-settings :where (:= 'user-dn dn))))
+   (insert-dao (make-instance 'user-settings :user-dn dn))))
+
+(defun update-user-settings (settings &rest attrs)
+  "Update the fields of the settings for USER with the given ATTRS, which is a
+  plist of slot and value"
+  (check-type settings user-settings)
+  (when-let ((set-fields
+              (iter
+                (for slot in '(enable-email-notifications))
+                (for new-value = (getf attrs slot))
+                (appending
+                 (progn
+                   (setf (slot-value settings slot) new-value)
+                   (list slot new-value))))))
+    (execute
+     (sql-compile
+      `(:update user-settings
+        :set ,@set-fields
+        :where (:= user-dn ,(user-dn settings)))))))
+
+
 (define-constant +issue-statuses+ '(:open :closed)
   :test #'equal)
 
@@ -21,15 +108,6 @@
   "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)
@@ -49,6 +127,9 @@
   (declare (ignore initargs))
   (created-at->timestamp obj))
 
+(defun keyword->str (kw) (string-downcase (symbol-name kw)))
+(defun str->keyword (st) (alexandria:make-keyword (string-upcase st)))
+
 (defclass issue (has-created-at)
   ((id :col-type serial :initarg :id :accessor id)
    (subject :col-type string :initarg :subject :accessor subject)
@@ -61,7 +142,9 @@
            :initarg :status
            :accessor status
            :initform :open
-           :col-default "open"))
+           :col-default "open"
+           :col-export keyword->str
+           :col-import str->keyword))
   (:metaclass dao-class)
   (:keys id)
   (:table-name issues)
@@ -131,22 +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)
-  :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))
+
+;;;
+;;; Utils
+;;;
+
+(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)))
 
-(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))))
+;;;
+;;; Migrations
+;;;
 
-(defun ddl/init ()
-  "Idempotently initialize the full database schema for Panettone"
-  (ddl/create-issue-status)
-  (ddl/create-tables))
+(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
@@ -181,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 '*)
@@ -240,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
 ;;;
@@ -327,10 +565,44 @@ ISSUE-ID, which should be a plist of initforms, and return an instance of
     (error 'issue-not-found :id issue-id))
   (insert-dao (apply #'make-instance 'issue-comment :issue-id issue-id attrs)))
 
+(defun issue-commenter-dns (issue-id)
+  "Returns a list of all the dns of users who have commented on ISSUE-ID"
+  (query (:select 'author-dn :distinct
+          :from 'issue-comments
+          :where (:= 'issue-id issue-id))
+         :column))
+
+(defun issue-subscribers (issue-id)
+  "Returns a list of user DNs who should receive notifications for actions taken
+  on ISSUE-ID.
+
+Currently this is implemented as the author of issue plus all the users who have
+commented on the issue, but in the future we likely want to also allow
+explicitly subscribing to / unsubscribing from individual issues."
+  (let ((issue (get-issue issue-id)))
+    (adjoin (author-dn issue)
+            (issue-commenter-dns issue-id)
+            :test #'equal)))
+
+
 (comment
- (connect-postgres)
- (ddl/init)
+
  (make-instance 'issue :subject "test")
- (create-issue :subject "test"
-               :author-dn "cn=glittershark,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 1a8453055f..8e77c0ff2b 100644
--- a/web/panettone/src/packages.lisp
+++ b/web/panettone/src/packages.lisp
@@ -1,51 +1,95 @@
 (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)
   (:export :styles))
 
+(defpackage panettone.inline-markdown
+  (:use :cl)
+  (:import-from :alexandria :define-constant)
+  (:export :render-inline-markdown))
+
+(defpackage panettone.irc
+  (:nicknames :irc)
+  (:use :cl :usocket)
+  (:export :noping :send-irc-notification))
+
 (defpackage :panettone.authentication
   (:nicknames :authn)
   (:use :cl :panettone.util :klatre)
   (: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
+   :prepare-db-connections
+   :migrate
+   :*pg-spec*
+
+   :create-table-if-not-exists
 
-   :issue :issue-comment :issue-event
+   :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 :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
+   :update-issue :delete-issue :issue-not-found :not-found-id
 
    :issue-events
 
-   :issue-comments :num-comments :create-issue-comment))
+   :issue-comments :num-comments :create-issue-comment
+   :issue-commenter-dns :issue-subscribers))
+
+(defpackage panettone.email
+  (:nicknames :email)
+  (:use :cl)
+  (:import-from :alexandria :when-let :when-let*)
+  (:import-from :panettone.model
+   :settings-for-user :enable-email-notifications-p)
+  (:import-from :panettone.authentication
+   :find-user-by-dn :mail :displayname)
+  (:export
+   :*smtp-server* :*smtp-server-port* :*notification-from*
+   :*notification-from-display-name* :*notification-subject-prefix*
+   :notify-user :send-email-notification))
 
 (defpackage panettone
   (:use :cl :klatre :easy-routes :iterate
         :panettone.util
-        :panettone.authentication)
+        :panettone.authentication
+        :panettone.inline-markdown)
   (:import-from :defclass-std :defclass/std)
   (:import-from :alexandria :if-let :when-let :switch :alist-hash-table)
   (:import-from :cl-ppcre :split)
+  (:import-from :bordeaux-threads :make-thread)
   (:import-from
    :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 cef3572214..37d194d0f9 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -8,11 +8,10 @@
    "Render the argument, or the elements of the argument, as markdown, and return
    the same structure"))
 
-(defmethod render-markdown ((markdown string))
-  (cdr
-   (assoc :markdown
-          (cl-json:decode-json
-           (drakma:http-request
+(defun request-markdown-from-cheddar (input)
+  "Send the CL value INPUT encoded as JSON to cheddar's
+  markdown endpoint and return the decoded response."
+  (let ((s (drakma:http-request
             (concatenate 'string
                          *cheddar-url*
                          "/markdown")
@@ -20,25 +19,19 @@
             :method :post
             :content-type "application/json"
             :external-format-out :utf-8
-            :external-format-in :utf-8
-            :content (json:encode-json-to-string
-                      `((markdown . ,markdown)))
-            :want-stream t)))))
+            :content (json:encode-json-to-string input)
+            :want-stream t)))
+    (setf (flexi-streams:flexi-stream-external-format s) :utf-8)
+    (cl-json:decode-json s)))
+
+(defmethod render-markdown ((markdown string))
+  (cdr (assoc :markdown
+              (request-markdown-from-cheddar
+               `((markdown . ,markdown))))))
 
 (defmethod render-markdown ((markdown hash-table))
   (alist-hash-table
-   (cl-json:decode-json
-    (drakma:http-request
-     (concatenate 'string
-                  *cheddar-url*
-                  "/markdown")
-     :accept "application/json"
-     :method :post
-     :content-type "application/json"
-     :external-format-out :utf-8
-     :external-format-in :utf-8
-     :content (json:encode-json-to-string markdown)
-     :want-stream t))))
+   (request-markdown-from-cheddar markdown)))
 
 (defun markdownify-comment-bodies (comments)
   "Convert the bodies of the given list of comments to markdown in-place using
@@ -63,7 +56,8 @@
 
 (defvar *title* "Panettone")
 
-(setf (who:html-mode) :html5)
+(eval-when (:compile-toplevel :load-toplevel)
+  (setf (who:html-mode) :html5))
 
 (defun render/nav ()
   (who:with-html-output (*standard-output*)
@@ -75,14 +69,16 @@
          (who:htm (:a :href "/" "All Issues")))
      (if *user*
          (who:htm
-          (:form :class "form-link log-out"
-                 :method "post"
-                 :action "/logout"
-                 (:input :type "submit" :value "Log Out")))
+          (:div :class "nav-group"
+           (:a :href "/settings" "Settings")
+           (:form :class "form-link log-out"
+                  :method "post"
+                  :action "/logout"
+                  (:input :type "submit" :value "Log Out"))))
          (who:htm
           (:a :href
               (format nil
-                      "/login?original-uri=~A"
+                      "/auth?original-uri=~A"
                       (drakma:url-encode (hunchentoot:request-uri*)
                                          :utf-8))
               "Log In"))))))
@@ -90,6 +86,10 @@
 (defun author (object)
   (find-user-by-dn (author-dn object)))
 
+(defun displayname-if-known (user)
+  (or (when user (displayname user))
+      "unknown"))
+
 (defmacro render ((&key
                      (footer t)
                      (header t))
@@ -135,35 +135,26 @@
     (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 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 ()
+      (:div
+       :class "settings-page"
+       (:header
+        (:h1 "Settings"))
+       (:form
+        :method :post :action "/settings"
+        (:div
+         (:label :class "checkbox"
+          (:input :type "checkbox"
+                  :name "enable-email-notifications"
+                  :id "enable-email-notifications"
+                  :checked (model:enable-email-notifications-p
+                            settings))
+          "Enable Email Notifications"))
+        (:div :class "form-group"
+         (:input :type "submit"
+                 :value "Save Settings")))))))
 
 (defun created-by-at (issue)
   (check-type issue model:issue)
@@ -171,11 +162,8 @@
     (:span :class "created-by-at"
            "Opened by "
            (:span :class "username"
-                  (who:esc
-                   (or
-                    (when-let ((author (author issue)))
-                      (displayname author))
-                    "someone")))
+                  (who:esc (displayname-if-known
+                             (author issue))))
            " at "
            (:span :class "timestamp"
                   (who:esc
@@ -192,12 +180,12 @@
            (:a :href (format nil "/issues/~A" issue-id)
                (:p
                 (:span :class "issue-subject"
-                       (who:esc (subject issue))))
+                       (render-inline-markdown (subject issue))))
                (:span :class "issue-number"
                       (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"
@@ -205,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")
@@ -217,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)
@@ -251,7 +255,8 @@
                        :name "subject"
                        :placeholder "Subject"
                        :value (when editing
-                                (subject issue))))
+                                (who:escape-string
+                                  (subject issue)))))
 
               (:div
                (:textarea :name "body"
@@ -292,33 +297,38 @@
        (:p
         :class "comment-info"
         (:span :class "username"
-               (who:esc (displayname (author comment)))
+               (who:esc
+                 (displayname-if-known (author comment)))
                " at "
                (:a :href (concatenate 'string "#" fragment)
                    (who:esc (format-dottime (created-at comment))))))))))
 
 (defmethod render/issue-history-item ((event model:issue-event))
-  (let ((user (find-user-by-dn (acting-user-dn event))))
+  (let ((user (find-user-by-dn (acting-user-dn event)))
+        (fragment (format nil "event-~A" (id event))))
     (who:with-html-output (*standard-output*)
       (:li
        :class "event"
-       :id
-       (who:esc (displayname user))
-       (if (string= (field event) "STATUS")
-           (who:htm
-            (who:esc
-             (switch ((new-value event) :test #'string=)
-               ("OPEN" " reopened ")
-               ("CLOSED" " closed ")))
-            " this issue ")
-           (who:htm
-            " changed the "
-            (who:esc (string-downcase (field event)))
-            " of this issue from \""
-            (who:esc (previous-value event))
-            "\" to \""
-            (who:esc (new-value event))
-            "\""))
+       :id fragment
+       (who:esc (displayname-if-known user))
+       (switch ((field event) :test #'string=)
+         ("STATUS"
+          (who:htm
+           (who:esc
+            (switch ((new-value event) :test #'string=)
+              ("OPEN" " reopened ")
+              ("CLOSED" " closed ")))
+           " this issue "))
+         ("BODY" (who:htm " updated the body of this issue"))
+         (t
+          (who:htm
+           " changed the "
+           (who:esc (string-downcase (field event)))
+           " of this issue from \""
+           (who:esc (previous-value event))
+           "\" to \""
+           (who:esc (new-value event))
+           "\"")))
        " at "
        (who:esc (format-dottime (created-at event)))))))
 
@@ -328,7 +338,7 @@
         (issue-status (status issue)))
     (render ()
       (:header
-       (:h1 (who:esc (subject issue)))
+       (:h1 (render-inline-markdown (subject issue)))
        (:div :class "issue-number"
              (who:esc (format nil "#~A" issue-id))))
       (:main
@@ -359,30 +369,49 @@
                      (: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 ()
-    (:h1 (who:esc entity-type) "Not Found")))
+    (:h1 (who:esc entity-type) " Not Found")))
 
 ;;;
 ;;; HTTP handlers
 ;;;
 
+(defun send-email-for-issue
+    (issue-id &key subject (message ""))
+  "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*))
+    (bordeaux-threads:make-thread
+     (lambda ()
+       (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))
+
 (defun @auth-optional (next)
   (let ((*user* (hunchentoot:session-value 'user)))
     (funcall next)))
@@ -391,73 +420,97 @@
   (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)
     (model:issue-not-found (err)
       (render/not-found
-       (format nil "Issue #~A" (model:id err))))))
+       (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 @db)) ()
+  (render/settings))
+
+(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
+     settings
+     'model:enable-email-notifications enable-email-notifications)
+    (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
        (make-instance 'model:issue :subject subject :body body)
        "Subject is required")
-      (progn
-        (model:create-issue :subject subject
-                            :body body
-                            :author-dn (dn *user*))
-        (hunchentoot:redirect "/"))))
+      (let ((issue
+              (model:create-issue :subject subject
+                                  :body body
+                                  :author-dn (dn *user*))))
+        (send-irc-notification
+         (format nil
+                 "b/~A: \"~A\" opened by ~A - https://b.tvl.fyi/issues/~A"
+                 (id issue)
+                 subject
+                 (irc:noping (cn *user*))
+                 (id issue))
+         :channel (or (uiop:getenvp "ISSUECHANNEL")
+                      "#tvl"))
+        (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"
@@ -465,14 +518,14 @@
     (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)
@@ -490,7 +543,7 @@
 
 (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 ()
@@ -503,20 +556,65 @@
         :issue-id id
         :body body
         :author-dn (dn *user*))
+
+       (let ((issue (model:get-issue id)))
+         (send-email-for-issue
+          id
+          :subject (format nil "~A commented on b/~A: \"~A\""
+                           (displayname *user*)
+                           id
+                           (subject issue))
+          :message (format nil "~A~%~%~A"
+                           body
+                           (link-to-issue id))))
        (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)
+  (let ((issue (model:get-issue id)))
+    (send-irc-notification
+     (format nil
+             "b/~A: \"~A\" closed by ~A - ~A"
+             id
+             (subject issue)
+             (irc:noping (cn *user*))
+             (link-to-issue id))
+     :channel (or (uiop:getenvp "ISSUECHANNEL")
+                  "#tvl"))
+    (send-email-for-issue
+     id
+     :subject (format nil "b/~A: \"~A\" closed by ~A"
+                      id
+                      (subject issue)
+                      (displayname *user*))
+     :message (link-to-issue id)))
   (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)
+  (let ((issue (model:get-issue id)))
+    (send-irc-notification
+     (format nil
+             "b/~A: \"~A\" reopened by ~A - ~A"
+             id
+             (subject issue)
+             (irc:noping (cn *user*))
+             (link-to-issue id))
+     :channel (or (uiop:getenvp "ISSUECHANNEL")
+                  "#tvl"))
+    (send-email-for-issue
+     id
+     :subject (format nil "b/~A: \"~A\" reopened by ~A"
+                      id
+                      (subject issue)
+                      (displayname *user*))
+     :message (link-to-issue id)))
   (hunchentoot:redirect (format nil "/issues/~A" id)))
 
 (defroute styles ("/main.css") ()
@@ -528,17 +626,15 @@
 
 (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
@@ -547,12 +643,18 @@
   (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))
@@ -560,9 +662,10 @@
     (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)
@@ -571,9 +674,8 @@
 
 (comment
  (setq hunchentoot:*catch-errors-p* nil)
- ;; to setup an ssh tunnel to ldap+cheddar for development:
- ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 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/inline-markdown_test.lisp b/web/panettone/test/inline-markdown_test.lisp
new file mode 100644
index 0000000000..bb90750436
--- /dev/null
+++ b/web/panettone/test/inline-markdown_test.lisp
@@ -0,0 +1,54 @@
+(in-package :panettone.tests)
+(declaim (optimize (safety 3)))
+
+(defmacro inline-markdown-unit-test (name input expected)
+  `(test ,name
+     (is (equal
+           ,expected
+           (with-output-to-string (*standard-output*)
+             (render-inline-markdown ,input))))))
+
+(inline-markdown-unit-test
+  inline-markdown-typical-test
+  "hello *world*, here is ~~no~~ `code`!"
+  "hello <em>world</em>, here is <del>no</del> <code>code</code>!")
+
+(inline-markdown-unit-test
+  inline-markdown-two-emphasize-types-test
+  "*stress* *this*"
+  "<em>stress</em> <em>this</em>")
+
+(inline-markdown-unit-test
+  inline-markdown-html-escaping-test
+  "<tag>öäü"
+  "&lt;tag&gt;&#xF6;&#xE4;&#xFC;")
+
+(inline-markdown-unit-test
+  inline-markdown-nesting-test
+  "`inside code *anything* goes`, but also ~~*here*~~"
+  "<code>inside code *anything* goes</code>, but also <del>*here*</del>")
+
+(inline-markdown-unit-test
+  inline-markdown-escaping-test
+  "A backslash \\\\ shows: \\*, \\` and \\~~"
+  "A backslash \\ shows: *, ` and ~~")
+
+(inline-markdown-unit-test
+  inline-markdown-nested-escaping-test
+  "`prevent \\`code\\` from ending, but never stand alone \\\\`"
+  "<code>prevent `code` from ending, but never stand alone \\</code>")
+
+(inline-markdown-unit-test
+  inline-markdown-escape-normal-tokens-test
+  "\\Normal tokens \\escaped?"
+  "\\Normal tokens \\escaped?")
+
+(inline-markdown-unit-test
+  inline-markdown-no-unclosed-tags-test
+  "A tag, once opened, *must be closed"
+  "A tag, once opened, <em>must be closed</em>")
+
+(inline-markdown-unit-test
+  inline-markdown-unicode-safe
+  "Does Unicode 👨‍👨‍👧‍👦 break \\👩🏾‍🦰 tokenization?"
+  "Does Unicode &#x1F468;&#x200D;&#x1F468;&#x200D;&#x1F467;&#x200D;&#x1F466; break \\&#x1F469;&#x1F3FE;&#x200D;&#x1F9B0; tokenization?")
diff --git a/web/panettone/test/irc_test.lisp b/web/panettone/test/irc_test.lisp
new file mode 100644
index 0000000000..0224836cbc
--- /dev/null
+++ b/web/panettone/test/irc_test.lisp
@@ -0,0 +1,5 @@
+(in-package :panettone.tests)
+(declaim (optimize (safety 3)))
+
+(test noping-test
+  (is (not (equal "grfn" (panettone.irc:noping "grfn")))))
diff --git a/web/panettone/test/package.lisp b/web/panettone/test/package.lisp
index 77ba1b00bb..d2a2f97420 100644
--- a/web/panettone/test/package.lisp
+++ b/web/panettone/test/package.lisp
@@ -1,2 +1,3 @@
 (defpackage :panettone.tests
-  (:use :cl :klatre :fiveam))
+  (:use :cl :klatre :fiveam
+        :panettone.inline-markdown))
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-05-02T19·46+0000