From 22d9e88295467a39d191570f2f0ad0034658e2a0 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sun, 18 Aug 2024 18:23:21 +0200 Subject: [PATCH] auth: basic login functionality working --- lib/auth/auth.lisp | 13 ++++++++++--- lib/auth/test/test-auth.lisp | 2 ++ 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/lib/auth/auth.lisp b/lib/auth/auth.lisp index ed9dc56..14173ce 100644 --- a/lib/auth/auth.lisp +++ b/lib/auth/auth.lisp @@ -41,6 +41,10 @@ (defclass simple-credentials (base-credentials) ((password :reader password :initarg :password))) +(defmethod print-object ((cred simple-credentials) stream) + (print-unreadable-object (cred stream :type t :identity t) + (format stream "~s ~s" (login-name cred) (password cred)))) + (defclass principal (shape:record) ((shape:head-fields :initform '(:organization :name :login)) (shape:data-fields :initform '(:credentials :full-name :email :role)))) @@ -57,9 +61,12 @@ (cred (make-instance 'simple-credentials :login (getf inp :login) :password (digest (getf inp :password)))) - (admin (gethash (list :system (login-name cred)) (principals auth)))) - (util:lgi inp cred admin) - admin)) + (prc (gethash (list :system (login-name cred)) (principals auth))) + (prc-cred (shape:data-value prc :credentials))) + (util:lgi inp cred) + (when (equalp (password cred) (password prc-cred)) + (util:lgi prc) + prc))) ;;;; auxiliary functions diff --git a/lib/auth/test/test-auth.lisp b/lib/auth/test/test-auth.lisp index eb670ad..2e1ea7a 100644 --- a/lib/auth/test/test-auth.lisp +++ b/lib/auth/test/test-auth.lisp @@ -34,6 +34,8 @@ (deftest test-login () (let ((cred '(:login "admin" :password "secret")) pr1) + (== (auth:login cred) nil) + (setf (getf cred :password) "sc0pes") (setf pr1 (auth:login cred)) (== (shape:head-value pr1 :name) :admin) ))