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:
Griffin Smith 2022-05-28 13:53:17 -04:00 committed by clbot
parent c1bddf191f
commit b39ca017c0

View file

@ -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))))))