diff options
-rw-r--r-- | web/panettone/src/authentication.lisp | 14 |
1 files changed, 13 insertions, 1 deletions
diff --git a/web/panettone/src/authentication.lisp b/web/panettone/src/authentication.lisp index 291284b41619..5c6d82e02027 100644 --- a/web/panettone/src/authentication.lisp +++ b/web/panettone/src/authentication.lisp @@ -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)))))) |