about summary refs log tree commit diff
diff options
context:
space:
mode:
authorVincent Ambo <mail@tazj.in>2022-05-28T16·20+0200
committertazjin <tazjin@tvl.su>2022-05-28T18·00+0000
commitc1bddf191f0f4ca9d14d254a29dfaaa0c49149b5 (patch)
tree4f1ca31bfb75e0e305abd3a174102f2572c8f2ee
parent121fb136485e2f3fb5a6ed04bb3607a4dcaa8368 (diff)
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
-rw-r--r--web/panettone/default.nix1
-rw-r--r--web/panettone/src/authentication.lisp204
-rw-r--r--web/panettone/src/packages.lisp9
-rw-r--r--web/panettone/src/panettone.lisp70
4 files changed, 119 insertions, 165 deletions
diff --git a/web/panettone/default.nix b/web/panettone/default.nix
index a01e0d81c8..862dac95a8 100644
--- a/web/panettone/default.nix
+++ b/web/panettone/default.nix
@@ -16,7 +16,6 @@ depot.nix.buildLisp.program {
     lass
     local-time
     postmodern
-    trivial-ldap
 
     depot.lisp.klatre
   ];
diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp
index 3d4a3510ea..291284b416 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))))))
diff --git a/web/panettone/src/packages.lisp b/web/panettone/src/packages.lisp
index d3e23d5b33..a63f4c766a 100644
--- a/web/panettone/src/packages.lisp
+++ b/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))
diff --git a/web/panettone/src/panettone.lisp b/web/panettone/src/panettone.lisp
index bef5b018e4..f9ed979adc 100644
--- a/web/panettone/src/panettone.lisp
+++ b/web/panettone/src/panettone.lisp
@@ -78,7 +78,7 @@
          (who:htm
           (:a :href
               (format nil
-                      "/login?original-uri=~A"
+                      "/auth?original-uri=~A"
                       (drakma:url-encode (hunchentoot:request-uri*)
                                          :utf-8))
               "Log In"))))))
@@ -135,36 +135,6 @@
     (when message
       (who:htm (:div :class "alert" (who:esc message))))))
 
-(defun render/login (&key message (original-uri "/"))
-  (render (:footer nil :header nil)
-    (:div
-     :class "login-form"
-     (:header
-      (:h1 "Login"))
-     (:main
-      :class "login-form"
-      (render/alert message)
-      (:form
-       :method :post :action "/login"
-       (:input :type "hidden" :name "original-uri"
-               :value (who:escape-string original-uri))
-       (:div
-        (:label :for "username"
-                "Username")
-        (:input :type "text"
-                :name "username"
-                :id "username"
-                :placeholder "username"))
-       (:div
-        (:label :for "password"
-                "Password")
-        (:input :type "password"
-                :name "password"
-                :id "password"
-                :placeholder "password"))
-       (:input :type "submit"
-               :value "Submit"))))))
-
 (defun render/settings ()
   (let ((settings (model:settings-for-user (dn *user*))))
     (render ()
@@ -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)
-    (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)
@@ -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
-                          (ldap-host "localhost")
-                          (ldap-port 389)
-                          session-secret)
-  (connect-ldap :host ldap-host
-                :port ldap-port)
-
+(defun start-panettone (&key port session-secret)
+  (authn:initialise-oauth2)
   (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:
- ;; ssh -NL 3899:localhost:389 -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
+ ;; to setup an ssh tunnel to cheddar+irccat for development:
+ ;; ssh -N -L 4238:localhost:4238 -L 4722:localhost:4722 whitby.tvl.fyi
  (start-panettone :port 6161
-                  :ldap-port 3899
                   :session-secret "session-secret")
  )