about summary refs log tree commit diff
path: root/web/panettone/src/authentication.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'web/panettone/src/authentication.lisp')
-rw-r--r--web/panettone/src/authentication.lisp14
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))))))