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

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

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

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

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