From 923982369e140e78dd99e12aa4652ee3db82c994 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Tue, 27 Aug 2024 16:36:30 +0200 Subject: [PATCH] move util.lisp to directory util, move crypto functions to separate package util/crypt --- lib/auth/auth.lisp | 3 ++- scopes-core.asd | 11 ++++++----- test/test-core.lisp | 3 ++- test/test-web.lisp | 3 ++- util/crypt.lisp | 26 ++++++++++++++++++++++++++ util.lisp => util/util.lisp | 26 ++++---------------------- web/jwt.lisp | 7 ++++--- 7 files changed, 46 insertions(+), 33 deletions(-) create mode 100644 util/crypt.lisp rename util.lisp => util/util.lisp (81%) diff --git a/lib/auth/auth.lisp b/lib/auth/auth.lisp index 0bde7bb..723f7ab 100644 --- a/lib/auth/auth.lisp +++ b/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) diff --git a/scopes-core.asd b/scopes-core.asd index 1f61413..ddaf993 100644 --- a/scopes-core.asd +++ b/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")))) diff --git a/test/test-core.lisp b/test/test-core.lisp index 9263d2c..72f5baa 100644 --- a/test/test-core.lisp +++ b/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)) diff --git a/test/test-web.lisp b/test/test-web.lisp index cadb361..8c4d3a8 100644 --- a/test/test-web.lisp +++ b/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"))) (deftest test-jwt () - (let ((secret (util:create-secret)) + (let ((secret (crypt:create-secret)) ;(secret "5Hw3zlpoVbFGRNZcp7Dymw") tok1 jwtdata) (setf tok1 (jwt:create secret :admin)) diff --git a/util/crypt.lisp b/util/crypt.lisp new file mode 100644 index 0000000..284ac30 --- /dev/null +++ b/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))) + + diff --git a/util.lisp b/util/util.lisp similarity index 81% rename from util.lisp rename to util/util.lisp index 08b4185..0df9da9 100644 --- a/util.lisp +++ b/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 diff --git a/web/jwt.lisp b/web/jwt.lisp index e464c95..da7eb10 100644 --- a/web/jwt.lisp +++ b/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)) @@ -22,7 +23,7 @@ (util:keyword-to-string name) exp) :scheme :uri)) (data (str:join "." (list *header* payload))) - (sig (util:sign data secret))) + (sig (crypt:sign data secret))) (str:join "." (list data sig)))) (defun decode (token secret) @@ -30,7 +31,7 @@ (destructuring-bind (data &optional sig) (str:rsplit "." token :limit 2) (unless sig (return-from decode (values nil :malformed-token token))) - (unless (equal sig (util:sign data secret)) + (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)))