diff options
author | Vincent Ambo <mail@tazj.in> | 2022-05-28T16·20+0200 |
---|---|---|
committer | tazjin <tazjin@tvl.su> | 2022-05-28T18·00+0000 |
commit | c1bddf191f0f4ca9d14d254a29dfaaa0c49149b5 (patch) | |
tree | 4f1ca31bfb75e0e305abd3a174102f2572c8f2ee /web/panettone/src/authentication.lisp | |
parent | 121fb136485e2f3fb5a6ed04bb3607a4dcaa8368 (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
Diffstat (limited to '')
-rw-r--r-- | web/panettone/src/authentication.lisp | 204 |
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)))))) |