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

auth: set-up credentials and example (admin) principal basically OK

Browse source
This commit is contained in:
Helmut Merz 2024-08-18 15:18:11 +02:00
parent 6e7aadf3af
commit 2fe0577a02
3 changed files with 26 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
lib/auth/auth.lisp
View file

@ -21,36 +21,44 @@
(defun setup (cfg)
(let* ((auth (make-instance 'simple-authenticator))
(ctx (core:default-setup cfg 'context :authenticator auth))
(cred (admin-credentials cfg))
(head '(:system :admin))
(data (list :credentials cred))
(admin (make-instance 'principal :head head :data data)))
(setf (gethash :admin (principals auth)) admin)
(cred (setup-credentials (admin-credentials cfg)))
(admin (make-principal :system :admin cred)))
(setf (gethash (list :system (login-name cred)) (principals auth)) admin)
ctx))
(defun setup-credentials (inp)
(let ((pw (digest (cadr inp))))
(make-instance 'simple-credentials :login (car inp) :password pw)))
;;;; simple / basic auth service implementation
(defclass simple-authenticator ()
((principals :reader principals :initform (make-hash-table))))
((principals :reader principals :initform (make-hash-table :test 'equal))))
(defclass simple-credentials ()
((login-name)
(password)))
(defclass base-credentials ()
((login :reader login-name :initarg :login)))
(defclass simple-credentials (base-credentials)
((password :reader password :initarg :password)))
(defclass principal (shape:record)
((shape:head-fields :initform '(:organization :short-name))
((shape:head-fields :initform '(:organization :name :login))
(shape:data-fields :initform '(:credentials :full-name :email :role))))
(defun authenticate (cred)
(make-instance 'principal))
(defun make-principal (org name cred &optional (cls 'principal))
(make-instance cls :head (list org name (login-name cred))
:data (list :credentials cred)))
;;;; login entry point
(defun login (cred)
(defun login (inp)
(let* ((srv (core:find-service :auth))
(auth (authenticator srv))
(admin (gethash :admin (principals auth))))
(util:lgi cred admin)
(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))
;;;; auxiliary functions

4
lib/auth/test/etc/config.lisp
View file

@ -17,8 +17,8 @@
(config:add :auth :class 'auth:config
:setup #'auth:setup
:admin-credentials `(:login ,(config:from-env :admin-login "admin")
:password ,(config:from-env :admin-password "secret")))
:admin-credentials `(,(config:from-env :admin-login "admin")
,(config:from-env :admin-password "secret")))
(config:add :server :class 'server:config
:port "8899"

2
lib/auth/test/test-auth.lisp
View file

@ -35,5 +35,5 @@
(let ((cred '(:login "admin" :password "secret"))
pr1)
(setf pr1 (auth:login cred))
(== (shape:head-value pr1 :short-name) :admin)
(== (shape:head-value pr1 :name) :admin)
))