move util.lisp to directory util, move crypto functions to separate package util/crypt

lib/auth/auth.lisp

@@ -4,6 +4,7 @@
   (:use :common-lisp)
   (:local-nicknames (:config :scopes/config)
                     (:core :scopes/core)
+                    (:crypt :scopes/util/crypt)
                     (:shape :scopes/shape)
                     (:util :scopes/util)
                     (:b64 :qbase64))
@@ -45,7 +46,7 @@
 
 (defun make-credentials (name pw &optional (cls 'simple-credentials))
   (make-instance cls :name (util:to-keyword name) 
-                     :password (util:digest pw)))
+                     :password (crypt:digest pw)))
 
 (defmethod print-object ((cred simple-credentials) stream)
   (print-unreadable-object (cred stream :type t)

scopes-core.asd

@@ -8,16 +8,17 @@
   :description "Core packages of the scopes project."
   :depends-on (:alexandria :cl-dotenv :com.inuoe.jzon 
                :flexi-streams :ironclad :local-time :log4cl :qbase64 :str)
-  :components ((:file "config" :depends-on ("util"))
+  :components ((:file "config" :depends-on ("util/util"))
                (:file "core/core" 
                       :depends-on ("core/message" "config" 
-                                   "forge/forge" "logging" "util"))
+                                   "forge/forge" "logging" "util/util"))
                (:file "core/message" :depends-on ("shape/shape"))
                (:file "forge/forge")
-               (:file "logging" :depends-on ("config" "util"))
+               (:file "logging" :depends-on ("config" "util/util"))
                (:file "shape/shape")
-               (:file "util")
-               (:file "testing" :depends-on ("util")))
+               (:file "util/util")
+               (:file "util/crypt" :depends-on ("util/util"))
+               (:file "testing" :depends-on ("util/util")))
   :long-description "scopes/core: The core packages of the scopes project."
   :in-order-to ((test-op (test-op "scopes-core/test"))))
 

test/test-core.lisp

@@ -5,6 +5,7 @@
   (:local-nicknames (:alx :alexandria)
                     (:config :scopes/config)
                     (:core :scopes/core)
+                    (:crypt :scopes/util/crypt)
                     (:logging :scopes/logging)
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
@@ -63,7 +64,7 @@
       (t:show-result))))
 
 (deftest test-util ()
-  (util:lgi (util:create-secret))
+  (util:lgi (crypt:create-secret))
   (let ((now (get-universal-time)))
     (== (util:from-unix-time (util:to-unix-time now)) now))
   (== (util:rfill '(1 2 3 4 5) '(a b c)) '(a b c nil nil))

test/test-web.lisp

@@ -6,6 +6,7 @@
                     (:core :scopes/core)
                     (:client :scopes/web/client)
                     (:cs-hx :scopes/frontend/cs-hx)
+                    (:crypt :scopes/util/crypt)
                     (:dom :scopes/web/dom)
                     (:jwt :scopes/web/jwt)
                     (:logging :scopes/logging)
@@ -48,7 +49,7 @@
                   class=\"demo-link plain\">Link to example.com</a>")))
 
 (deftest test-jwt ()
-  (let ((secret (util:create-secret))
+  (let ((secret (crypt:create-secret))
         ;(secret "5Hw3zlpoVbFGRNZcp7Dymw")
         tok1 jwtdata)
     (setf tok1 (jwt:create secret :admin))

util/crypt.lisp

@@ -0,0 +1,26 @@
+;;;; cl-scopes/util/crypt - common cryptographic utilities, e.g. for signing texts
+
+(defpackage :scopes/util/crypt
+  (:use :common-lisp)
+  (:local-nicknames (:util :scopes/util)
+                    (:b64 :qbase64))
+  (:export #:create-secret #:digest #:sign))
+
+(in-package :scopes/util/crypt)
+
+(defun create-secret (&key (bytes 16) (scheme :uri))
+  (util:b64-encode (ironclad:random-data bytes) :scheme scheme))
+
+(defun digest (tx &key (scheme :original) (alg :sha256))
+  (b64:encode-bytes (ironclad:digest-sequence alg (util:to-bytes tx)) :scheme scheme))
+
+(defun sign (tx key)
+  (let* ((binp (util:to-bytes tx))
+         (bkey (util:to-bytes key))
+         ;(bkey (make-array 16 :element-type '(unsigned-byte 8)
+         ;                 :initial-contents (b64:decode-string key)))
+         (mac (ironclad:make-mac :hmac bkey :sha256)))
+    (ironclad:update-mac mac binp)
+    (util:b64-encode (ironclad:produce-mac mac) :scheme :uri)))
+
+

util/util.lisp

@@ -6,10 +6,9 @@
   #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
   (:export #:make-vars-format #:lg #:lgd #:lgi
            #:from-unix-time #:to-unix-time
-           #:create-secret #:digest #:sign
            #:rfill #:rtrim #:loop-plist #:filter-plist #:plist-pairs #:plist-equal
            #:flatten-str #:to-keyword #:keyword-to-string #:to-integer #:to-string
-           #:from-bytes #:to-bytes #:from-b64 #:to-b64
+           #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
            #:relative-path #:runtime-path #:system-path
            #:add-package-local-nickname))
@@ -31,30 +30,13 @@
 
 ;;;; date and time manipulations
 
-(defconstant *unix-time-base* (encode-universal-time 0 0 0 1 1 1970 0))
+(defconstant +unix-time-base+ (encode-universal-time 0 0 0 1 1 1970 0))
 
 (defun from-unix-time (time)
-  (when time (+ time *unix-time-base*)))
+  (when time (+ time +unix-time-base+)))
 
 (defun to-unix-time (time)
-  (when time (- time *unix-time-base*)))
-
-;;;; secrets, digests, and other crypto stuff
-
-(defun create-secret (&key (bytes 16) (scheme :uri))
-  (b64-encode (ironclad:random-data bytes) :scheme scheme))
-
-(defun digest (tx &key (scheme :original) (alg :sha256))
-  (b64:encode-bytes (ironclad:digest-sequence alg (to-bytes tx)) :scheme scheme))
-
-(defun sign (tx key)
-  (let* ((binp (to-bytes tx))
-         (bkey (to-bytes key))
-         ;(bkey (make-array 16 :element-type '(unsigned-byte 8)
-         ;                 :initial-contents (b64:decode-string key)))
-         (mac (ironclad:make-mac :hmac bkey :sha256)))
-    (ironclad:update-mac mac binp)
-    (b64-encode (ironclad:produce-mac mac) :scheme :uri)))
+  (when time (- time +unix-time-base+)))
 
 ;;;; lists and loops
 
@@ -114,7 +96,7 @@
   (let ((padding
           (case (mod (length s) 4)
             (3 "=")
-            (2 "=")
+            (2 "==")
             (t ""))))
     (b64:decode-string (str:concat s padding) :scheme scheme)))
 

web/jwt.lisp

@@ -3,7 +3,8 @@
 
 (defpackage :scopes/web/jwt
   (:use :common-lisp)
-  (:local-nicknames (:util :scopes/util)
+  (:local-nicknames (:crypt :scopes/util/crypt)
+                    (:util :scopes/util)
                     (:jzon :com.inuoe.jzon))
   (:export #:create #:decode))
 
@@ -12,26 +13,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 (crypt: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)))
-      (unless (equal sig (util:sign data secret))
+        (return-from decode (values nil :malformed-token token)))
+      (unless (equal sig (crypt: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)))))