web/jwt, util: fixes and improvements

This commit is contained in:
Helmut Merz 2024-08-27 15:54:47 +02:00
parent 81e44aa4a8
commit ae46e97fc4
2 changed files with 12 additions and 10 deletions

View file

@ -114,7 +114,7 @@
(let ((padding
(case (mod (length s) 4)
(3 "=")
(2 "=")
(2 "==")
(t ""))))
(b64:decode-string (str:concat s padding) :scheme scheme)))

View file

@ -12,26 +12,28 @@
(defvar *header*
(util:to-b64 "{\"alg\":\"HS256\",\"typ\":\"JWT\"}" :scheme :uri))
(defvar *payload-format* "{\"sub\":~s,\"name\":~s,\"iat\":~s}")
(defvar *payload-format* "{\"sub\":~s,\"name\":~s,\"exp\":~s}")
(defun create (secret name &key (subject "scopes") (ttl 86400))
(let* ((iat (util:to-unix-time (+ (get-universal-time) ttl)))
(defun create (secret name &key (subject :scopes) (ttl 86400))
(let* ((exp (util:to-unix-time (+ (get-universal-time) ttl)))
(payload (util:to-b64
(format nil *payload-format*
(util:keyword-to-string subject)
(util:keyword-to-string name) iat)
(util:keyword-to-string name) exp)
:scheme :uri))
(data (str:join "." (list *header* payload)))
(sign (util:sign data secret)))
(str:join "." (list data sign))))
(sig (util:sign data secret)))
(str:join "." (list data sig))))
(defun decode (token secret)
(let (payload errors parts)
(let (payload)
(destructuring-bind (data &optional sig) (str:rsplit "." token :limit 2)
(unless sig
(return-from decode (values nil :malformed-token nil)))
(return-from decode (values nil :malformed-token token)))
(unless (equal sig (util:sign data secret))
(return-from decode (values nil :invalid-signature (list data sig))))
(destructuring-bind (hjson &optional pjson) (str:split "." data)
(setf payload (jzon:parse (util:from-b64 pjson)))
(values payload errors parts)))))
(when (> (util:to-unix-time (get-universal-time)) (gethash "exp" payload))
(return-from decode (values nil :token-expired payload)))
(values payload nil nil)))))