fix(web/panettone): Properly handle un-padded base64 in jwts
The JWT spec apparently specifies that base64 strings in jwts aren't to be padded - but the common lisp base64 library doesn't know how to decode unpadded base64 (it signals a condition in that case). This adds the extra padding characters (a number of `=` characters such that the length of the string is a multiple of 4) using some FORMAT wizardry (?). Change-Id: Ic6b66f05db2699bf1f93f870f5dd614c37eccc2d Reviewed-on: https://cl.tvl.fyi/c/depot/+/5781 Tested-by: BuildkiteCI Reviewed-by: tazjin <tazjin@tvl.su> Autosubmit: grfn <grfn@gws.fyi>
This commit is contained in:
parent
c1bddf191f
commit
b39ca017c0
1 changed files with 13 additions and 1 deletions
|
@ -78,6 +78,12 @@ the user, however email addresses are temporarily not available."
|
|||
;; TODO(tazjin): Figure out actual displayName mapping in tokens.
|
||||
:displayname username)))
|
||||
|
||||
(defun add-missing-base64-padding (s)
|
||||
"Add any missing padding characters to the (un-padded) base64 string `S', such
|
||||
that it can be successfully decoded by the `BASE64' package"
|
||||
;; I apologize
|
||||
(format nil "~A~v@{~A~:*~}" s (- 4 (mod (length s) 4)) "="))
|
||||
|
||||
(defun fetch-token (code)
|
||||
"Fetches the access token on completion of user authentication through
|
||||
the OAuth2 endpoint and returns the resulting user object."
|
||||
|
@ -105,5 +111,11 @@ the OAuth2 endpoint and returns the resulting user object."
|
|||
(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))))
|
||||
(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.
|
||||
(add-missing-base64-padding payload)))))
|
||||
(claims-to-user claims))))))
|
||||
|
|
Loading…
Reference in a new issue