cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

web/jwt, util: fixes and improvements

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
util.lisp
View file

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

20
web/jwt.lisp
View file

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