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

auth: minor steps toward setting up default (admin) principal

Browse source
This commit is contained in:
Helmut Merz 2024-08-18 10:37:02 +02:00
parent 8f418400aa
commit 792a8c4c09
1 changed files with 9 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lib/auth/auth.lisp
View file

@ -16,17 +16,19 @@
((admin-credentials :reader admin-credentials :initarg :admin-credentials))) ((admin-credentials :reader admin-credentials :initarg :admin-credentials)))
(defclass context (core:context) (defclass context (core:context)
((authenticator :initarg :authenticator))) ((authenticator :reader authenticator :initarg :authenticator)))
(defun setup (cfg) (defun setup (cfg)
(let* ((auth (make-instance 'simple-authenticator)) (let* ((auth (make-instance 'simple-authenticator))
(ctx (core:default-setup cfg 'context :authenticator auth))) (ctx (core:default-setup cfg 'context :authenticator auth))
(cred (admin-credentials cfg)))
(setf (gethash :admin (principals auth)) cred)
ctx)) ctx))
;;;; simple / basic auth service implementation ;;;; simple / basic auth service implementation
(defclass simple-authenticator () (defclass simple-authenticator ()
((principals))) ((principals :reader principals :initform (make-hash-table))))
(defclass simple-credentials () (defclass simple-credentials ()
((login-name) ((login-name)
@ -42,8 +44,10 @@
;;;; login entry point ;;;; login entry point
(defun login (cred) (defun login (cred)
(let ((srv (core:find-service :auth))) (let* ((srv (core:find-service :auth))
(util:lgi cred (admin-credentials (core:config srv))))) (auth (authenticator srv))
(admin (gethash :admin (principals auth))))
(util:lgi cred admin)))
;;;; auxiliary functions ;;;; auxiliary functions