auth: basic login functionality working
This commit is contained in:
parent
2fe0577a02
commit
22d9e88295
2 changed files with 12 additions and 3 deletions
|
@ -41,6 +41,10 @@
|
||||||
(defclass simple-credentials (base-credentials)
|
(defclass simple-credentials (base-credentials)
|
||||||
((password :reader password :initarg :password)))
|
((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)
|
(defclass principal (shape:record)
|
||||||
((shape:head-fields :initform '(:organization :name :login))
|
((shape:head-fields :initform '(:organization :name :login))
|
||||||
(shape:data-fields :initform '(:credentials :full-name :email :role))))
|
(shape:data-fields :initform '(:credentials :full-name :email :role))))
|
||||||
|
@ -57,9 +61,12 @@
|
||||||
(cred (make-instance 'simple-credentials
|
(cred (make-instance 'simple-credentials
|
||||||
:login (getf inp :login)
|
:login (getf inp :login)
|
||||||
:password (digest (getf inp :password))))
|
:password (digest (getf inp :password))))
|
||||||
(admin (gethash (list :system (login-name cred)) (principals auth))))
|
(prc (gethash (list :system (login-name cred)) (principals auth)))
|
||||||
(util:lgi inp cred admin)
|
(prc-cred (shape:data-value prc :credentials)))
|
||||||
admin))
|
(util:lgi inp cred)
|
||||||
|
(when (equalp (password cred) (password prc-cred))
|
||||||
|
(util:lgi prc)
|
||||||
|
prc)))
|
||||||
|
|
||||||
;;;; auxiliary functions
|
;;;; auxiliary functions
|
||||||
|
|
||||||
|
|
|
@ -34,6 +34,8 @@
|
||||||
(deftest test-login ()
|
(deftest test-login ()
|
||||||
(let ((cred '(:login "admin" :password "secret"))
|
(let ((cred '(:login "admin" :password "secret"))
|
||||||
pr1)
|
pr1)
|
||||||
|
(== (auth:login cred) nil)
|
||||||
|
(setf (getf cred :password) "sc0pes")
|
||||||
(setf pr1 (auth:login cred))
|
(setf pr1 (auth:login cred))
|
||||||
(== (shape:head-value pr1 :name) :admin)
|
(== (shape:head-value pr1 :name) :admin)
|
||||||
))
|
))
|
||||||
|
|
Loading…
Add table
Reference in a new issue