feat(web/panettone): Implement OAuth2-based authentication

Instead of directly connecting to LDAP and attempting to bind
usernames/password, authenticate users through an OAuth2 flow to
Keycloak.

This has the advantage of reusing the same SSO we already have for
Gerrit, Buildkite, ...

However, much of panettone's functionality makes assumptions about
LDAP being used. As a result there are some warts introduced by
this (for now):

* Since LDAP DNs are used as primary keys for users, we have to
  construct fake DNs based on LDAP usernames

  It might be sensible to migrate this to the UUIDs used by Keycloak
  eventually.

* LDAP is part of the serving path for issues (for fetching user
  information), however panettone no longer has a way to fetch
  arbitrary user information unless it is persisted in its database.

  To work around this, we construct a "fake" user based only on its
  DN (i.e. only the username is going to be "correct") and use that to
  serve issues.

* Email notifications no longer work (panettone can not access email
  addresses)

Some of these need to be worked around by persisting some of that
information in the panettone database instead, as we don't want to
give the service the ability to access arbitrary user information
anymore.

We can probably do this with the user settings feature that already
exists and populate it on launch, but as of this commit email and
displayName functionality is simply broken.

Change-Id: Id32bf5e09d67f0f1e883024c6e013eb342f03b05
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5772
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

web/panettone/default.nix

@@ -16,7 +16,6 @@ depot.nix.buildLisp.program {
     lass
     local-time
     postmodern
-    trivial-ldap
 
     depot.lisp.klatre
   ];

web/panettone/src/authentication.lisp

@@ -3,113 +3,107 @@
 (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
+;; Migrating user authentication to OAuth2 necessitates some temporary
-                       (host "localhost")
+;; workarounds while other parts of the panettone code are being
-                       (port 389))
+;; amended appropriately.
-  (setq *ldap-host* host
-        *ldap-port* port
-        *ldap* (ldap:new-ldap :host host :port port)))
 
-(defun reconnect-ldap ()
+(defun fake-dn (username)
-  (setq *ldap* (ldap:new-ldap
+  "Users are no longer read directly from LDAP, but everything in
-                :host *ldap-host*
+panettone is keyed on the DNs. This function constructs matching
-                :port *ldap-port*)))
+'fake' DNs."
-
+  (format nil "cn=~A,ou=users,dc=tvl,dc=fyi" username))
-(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)))
 
 (defun find-user-by-dn (dn)
-  "Look up the user with the given DN in the LDAP database, returning an
+  "Previously this function looked up users in LDAP based on their DN,
-instance of `user'"
+however panettone now does not have direct access to a user database.
-  (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))))))
 
-(comment
+For most cases only the username is needed, which can be parsed out of
- (find-user-by-dn "cn=grfn,ou=users,dc=tvl,dc=fyi")
+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)))
 
-(defun authenticate-user (user-or-username password)
+;; Implementation of standard OAuth2 authorisation flow.
-  "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
+(defvar *oauth2-auth-endpoint* nil)
-successful, `nil' otherwise"
+(defvar *oauth2-token-endpoint* nil)
-  (when-let ((user (if (typep user-or-username 'user) user-or-username
+(defvar *oauth2-client-id* nil)
-                     (find-user user-or-username))))
+(defvar *oauth2-client-secret* nil)
-    (let* ((dn (dn user))
+
-           (conn (ldap:new-ldap :host (ldap:host *ldap*)
+(defvar *oauth2-redirect-uri*
-                                :port (ldap:port *ldap*)
+  (or (uiop:getenv "OAUTH2_REDIRECT_URI")
-                                :user dn
+      "https://b.tvl.fyi/auth"))
-                                :pass password))
+
-           (code-sym (nth-value 1 (unwind-protect (ldap:bind conn)
+(defun initialise-oauth2 ()
-                                    (ldap:unbind conn)))))
+  "Initialise all settings needed for OAuth2"
-      (when (equalp code-sym 'trivial-ldap:success)
+
-        user))))
+  (setq *oauth2-auth-endpoint*
+        (or (uiop:getenv "OAUTH2_AUTH_ENDPOINT")
+            "https://auth.tvl.fyi/auth/realms/TVL/protocol/openid-connect/auth"))
+
+  (setq *oauth2-token-endpoint*
+        (or (uiop:getenv "OAUTH2_TOKEN_ENDPOINT")
+            "https://auth.tvl.fyi/auth/realms/TVL/protocol/openid-connect/token"))
+
+  (setq *oauth2-client-id*
+        (or (uiop:getenv "OAUTH2_CLIENT_ID")
+            "panettone"))
+
+  (setq *oauth2-client-secret*
+        (or (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 payload))))
+            (claims-to-user claims))))))

web/panettone/src/packages.lisp

@@ -23,9 +23,12 @@
   (: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)
@@ -81,4 +84,4 @@
    :*pg-spec*)
   (:import-from :panettone.irc :send-irc-notification)
   (:shadow :next)
-  (:export :start-pannetone :config :main))
+  (:export :start-panettone :config :main))

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 ()
@@ -434,7 +404,7 @@ 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)))))
@@ -457,20 +427,16 @@ 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)
+(defroute auth-handler ("/auth" :method :get :decorators (@auth-optional)) ()
-    (original-uri)
+  (if-let ((code (hunchentoot:get-parameter "code")))
-  (if (hunchentoot:session-value 'user)
+    (let ((user (fetch-token code)))
-      (hunchentoot:redirect (or original-uri "/"))
-      (render/login :original-uri 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 "/")))
+      (hunchentoot:redirect (or (hunchentoot:session-value 'original-uri) "/")))
-    (render/login :message "Invalid credentials"
+
-                  :original-uri original-uri)))
+    (progn
+      (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)
@@ -641,13 +607,8 @@ given subject an body (in a thread, to avoid blocking)"
   (pomo:with-connection *pg-spec*
     (model:ddl/init)))
 
-(defun start-panettone (&key port
+(defun start-panettone (&key port session-secret)
-                          (ldap-host "localhost")
+  (authn:initialise-oauth2)
-                          (ldap-port 389)
-                          session-secret)
-  (connect-ldap :host ldap-host
-                :port ldap-port)
-
   (model:prepare-db-connections)
   (migrate-db)
 
@@ -662,7 +623,6 @@ given subject an body (in a thread, to avoid blocking)"
 
 (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))
@@ -670,7 +630,6 @@ 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)
@@ -683,9 +642,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:
+ ;; to setup an ssh tunnel to cheddar+irccat for development:
- ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
+ ;; ssh -N -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
  (start-panettone :port 6161
-                  :ldap-port 3899
                   :session-secret "session-secret")
  )