1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
(in-package :panettone.authentication)
(defvar *user* nil
"The currently logged-in user")
(defclass/std user ()
((cn dn mail displayname :type string)))
;; 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)
"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
;; 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))))))
|
