web/jwt: JWT decoding basically working
This commit is contained in:
parent
536e89b0d5
commit
81e44aa4a8
3 changed files with 31 additions and 5 deletions
|
@ -50,9 +50,12 @@
|
||||||
(deftest test-jwt ()
|
(deftest test-jwt ()
|
||||||
(let ((secret (util:create-secret))
|
(let ((secret (util:create-secret))
|
||||||
;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
|
;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
|
||||||
jwt1)
|
tok1 jwtdata)
|
||||||
(setf jwt1 (jwt:create secret :admin))
|
(setf tok1 (jwt:create secret :admin))
|
||||||
(util:lgi secret jwt1)))
|
(util:lgi secret tok1)
|
||||||
|
(setf jwtdata (jwt:decode tok1 secret))
|
||||||
|
(util:lgi jwtdata)
|
||||||
|
(== (gethash "name" jwtdata) "admin")))
|
||||||
|
|
||||||
(deftest test-server-config (server)
|
(deftest test-server-config (server)
|
||||||
(== (parse-integer (server:port (core:config server))) 8899))
|
(== (parse-integer (server:port (core:config server))) 8899))
|
||||||
|
|
13
util.lisp
13
util.lisp
|
@ -9,7 +9,7 @@
|
||||||
#:create-secret #:digest #:sign
|
#:create-secret #:digest #:sign
|
||||||
#:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
#:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
|
||||||
#:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
|
#:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
|
||||||
#:from-bytes #:to-bytes #:to-b64
|
#:from-bytes #:to-bytes #:from-b64 #:to-b64
|
||||||
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
|
||||||
#:relative-path #:runtime-path #:system-path
|
#:relative-path #:runtime-path #:system-path
|
||||||
#:add-package-local-nickname))
|
#:add-package-local-nickname))
|
||||||
|
@ -110,9 +110,20 @@
|
||||||
(defun to-bytes (s)
|
(defun to-bytes (s)
|
||||||
(flexi-streams:string-to-octets s :external-format :utf8))
|
(flexi-streams:string-to-octets s :external-format :utf8))
|
||||||
|
|
||||||
|
(defun b64-decode (s &key (scheme :uri))
|
||||||
|
(let ((padding
|
||||||
|
(case (mod (length s) 4)
|
||||||
|
(3 "=")
|
||||||
|
(2 "=")
|
||||||
|
(t ""))))
|
||||||
|
(b64:decode-string (str:concat s padding) :scheme scheme)))
|
||||||
|
|
||||||
(defun b64-encode (b &key (scheme :uri))
|
(defun b64-encode (b &key (scheme :uri))
|
||||||
(str:trim-right (b64:encode-bytes b :scheme scheme) :char-bag "="))
|
(str:trim-right (b64:encode-bytes b :scheme scheme) :char-bag "="))
|
||||||
|
|
||||||
|
(defun from-b64 (s &key (scheme :uri))
|
||||||
|
(from-bytes (b64-decode s :scheme scheme)))
|
||||||
|
|
||||||
(defun to-b64 (s &key (scheme :uri))
|
(defun to-b64 (s &key (scheme :uri))
|
||||||
(b64-encode (to-bytes s) :scheme scheme))
|
(b64-encode (to-bytes s) :scheme scheme))
|
||||||
|
|
||||||
|
|
14
web/jwt.lisp
14
web/jwt.lisp
|
@ -3,7 +3,8 @@
|
||||||
|
|
||||||
(defpackage :scopes/web/jwt
|
(defpackage :scopes/web/jwt
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:util :scopes/util))
|
(:local-nicknames (:util :scopes/util)
|
||||||
|
(:jzon :com.inuoe.jzon))
|
||||||
(:export #:create #:decode))
|
(:export #:create #:decode))
|
||||||
|
|
||||||
(in-package :scopes/web/jwt)
|
(in-package :scopes/web/jwt)
|
||||||
|
@ -23,3 +24,14 @@
|
||||||
(data (str:join "." (list *header* payload)))
|
(data (str:join "." (list *header* payload)))
|
||||||
(sign (util:sign data secret)))
|
(sign (util:sign data secret)))
|
||||||
(str:join "." (list data sign))))
|
(str:join "." (list data sign))))
|
||||||
|
|
||||||
|
(defun decode (token secret)
|
||||||
|
(let (payload errors parts)
|
||||||
|
(destructuring-bind (data &optional sig) (str:rsplit "." token :limit 2)
|
||||||
|
(unless sig
|
||||||
|
(return-from decode (values nil :malformed-token nil)))
|
||||||
|
(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)))))
|
||||||
|
|
Loading…
Add table
Reference in a new issue