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

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

1 files changed, 99 insertions, 105 deletions

diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp
index 3d4a3510ea05..291284b41619 100644
--- a/web/panettone/src/authentication.lisp
+++ b/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
-                       (host "localhost")
-                       (port 389))
-  (setq *ldap-host* host
-        *ldap-port* port
-        *ldap* (ldap:new-ldap :host host :port port)))
-
-(defun reconnect-ldap ()
-  (setq *ldap* (ldap:new-ldap
-                :host *ldap-host*
-                :port *ldap-port*)))
-
-(defmacro with-ldap ((&key (max-tries 1)) &body body)
-  "Execute BODY in a context where ldap connection errors trigger a reconnect
-and a retry"
-  (with-gensyms (n try retry e)
-    `(flet
-         ((,try
-              (,n)
-            (flet ((,retry (,e)
-                     (if (>= ,n ,max-tries)
-                         (error ,e)
-                         (progn
-                           (reconnect-ldap)
-                           (,try (1+ ,n))))))
-              (handler-case
-                  (progn
-                    ,@body)
-                (end-of-file (,e) (,retry ,e))
-                (trivial-ldap:ldap-connection-error (,e) (,retry ,e))))))
-       (,try 0))))
-
-(defun ldap-entry->user (entry)
-  (apply
-   #'make-instance
-   'user
-   :dn (ldap:dn entry)
-   (alexandria:mappend
-    (lambda (field)
-      (list field (car (ldap:attr-value entry field))))
-    (list :mail
-          :cn
-          :displayname))))
-
-(defun find-user/ldap (username)
-  (check-type username (simple-array character (*)))
-  (with-ldap ()
-    (ldap:search
-     *ldap*
-     `(and (= objectClass organizationalPerson)
-           (or
-            (= cn ,username)
-            (= dn ,username)))
-     ;; TODO(grfn): make this configurable
-     :base "ou=users,dc=tvl,dc=fyi")
-    (ldap:next-search-result *ldap*)))
-
-(defun find-user (username)
-  (check-type username (simple-array character (*)))
-  (when-let ((ldap-entry (find-user/ldap username)))
-    (ldap-entry->user ldap-entry)))
+;; Migrating user authentication to OAuth2 necessitates some temporary
+;; workarounds while other parts of the panettone code are being
+;; amended appropriately.
+
+(defun fake-dn (username)
+  "Users are no longer read directly from LDAP, but everything in
+panettone is keyed on the DNs. This function constructs matching
+'fake' DNs."
+  (format nil "cn=~A,ou=users,dc=tvl,dc=fyi" username))
 
 (defun find-user-by-dn (dn)
-  "Look up the user with the given DN in the LDAP database, returning an
-instance of `user'"
-  (with-ldap ()
-    (let ((have-results
-            (handler-case
-              (ldap:search *ldap* `(= objectClass organizationalPerson)
-                           :base dn
-                           :scope 'ldap:base)
-              ; catch ldap-errors generated by trivial-ldap:parse-ldap-message
-              ; since this is thrown on conditions which we don't want this
-              ; function to fail like when there are no search results
-              (trivial-ldap:ldap-error (e) nil))))
-      (when have-results
-        (when-let ((ldap-entry (ldap:next-search-result *ldap*)))
-          (ldap-entry->user ldap-entry))))))
-
-(comment
- (find-user-by-dn "cn=grfn,ou=users,dc=tvl,dc=fyi")
- )
-
-(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))
-           (conn (ldap:new-ldap :host (ldap:host *ldap*)
-                                :port (ldap:port *ldap*)
-                                :user dn
-                                :pass password))
-           (code-sym (nth-value 1 (unwind-protect (ldap:bind conn)
-                                    (ldap:unbind conn)))))
-      (when (equalp code-sym 'trivial-ldap:success)
-        user))))
+  "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"))
+
+(defun initialise-oauth2 ()
+  "Initialise all settings needed for OAuth2"
+
+  (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))))))