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

make shape:print-object more generic

Browse source
This commit is contained in:
Helmut Merz 2024-08-24 14:35:38 +02:00
parent 5fec210f2f
commit ccbd9cd4fe
3 changed files with 16 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/auth/auth.lisp
View file

@ -44,10 +44,11 @@
((password :reader password :initarg :password))) ((password :reader password :initarg :password)))
(defun make-credentials (name pw &optional (cls 'simple-credentials)) (defun make-credentials (name pw &optional (cls 'simple-credentials))
(make-instance cls :name (util:to-keyword name) :password (digest pw))) (make-instance cls :name (util:to-keyword name)
:password (util:digest pw)))
(defmethod print-object ((cred simple-credentials) stream) (defmethod print-object ((cred simple-credentials) stream)
(print-unreadable-object (cred stream :type t :identity t) (print-unreadable-object (cred stream :type t)
(format stream "~s ~s" (name cred) (password cred)))) (format stream "~s ~s" (name cred) (password cred))))
;;; principal (abstract / generic user object) ;;; principal (abstract / generic user object)
@ -76,11 +77,3 @@
(when (equalp (password cred) (password prc-cred)) (when (equalp (password cred) (password prc-cred))
(util:lgi prc) (util:lgi prc)
prc))) prc)))
;;;; auxiliary functions
(defun digest (pw &key (scheme :original))
(b64:encode-bytes
(ironclad:digest-sequence
:sha3/256 (flexi-streams:string-to-octets pw :external-format :utf8))
:scheme scheme))

8
shape/shape.lisp
View file

@ -21,8 +21,12 @@
(setf (slot-value rec 'head) (util:rfill (head-fields rec) head))) (setf (slot-value rec 'head) (util:rfill (head-fields rec) head)))
(defmethod print-object ((rec record) stream) (defmethod print-object ((rec record) stream)
(print-unreadable-object (rec stream :type t :identity t) (print-unreadable-object (rec stream :type t)
(format stream "~s <data ~s>" (head rec) (data rec)))) (format-fields rec stream 'head 'data)))
(defun format-fields (item stream &rest fields)
(let ((fm (format nil "~{~(~a~): ~~S ~}" fields)))
(apply #'format stream fm (mapcar #'(lambda (x) (funcall x item)) fields))))
(defun head-value (rec key) (defun head-value (rec key)
(elt (head rec) (position key (head-fields rec)))) (elt (head rec) (position key (head-fields rec))))

8
util.lisp
View file

@ -5,7 +5,7 @@
(:local-nicknames (:b64 :qbase64)) (:local-nicknames (:b64 :qbase64))
#+sbcl (:import-from :sb-ext #:add-package-local-nickname) #+sbcl (:import-from :sb-ext #:add-package-local-nickname)
(:export #:lg #:lgd #:lgi (:export #:lg #:lgd #:lgi
#:create-secret #:create-secret #:digest
#: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
#:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@ -29,6 +29,12 @@
(defun create-secret () (defun create-secret ()
(b64:encode-bytes (ironclad:random-data 16))) (b64:encode-bytes (ironclad:random-data 16)))
(defun digest (pw &key (scheme :original) (alg :sha256))
(b64:encode-bytes
(ironclad:digest-sequence alg
(flexi-streams:string-to-octets pw :external-format :utf8))
:scheme scheme))
;;;; lists and loops ;;;; lists and loops
(defun rfill (ll ls) (defun rfill (ll ls)