mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
111 lines
4 KiB
Common Lisp
111 lines
4 KiB
Common Lisp
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; CLOG - The Common Lisp Omnificent GUI ;;;;
|
|
;;;; (c) 2020-2022 David Botton ;;;;
|
|
;;;; License BSD 3 Clause ;;;;
|
|
;;;; ;;;;
|
|
;;;; clog-auth.lisp ;;;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; CLOG-Auth an authorization abstraction for CLOG
|
|
|
|
(mgl-pax:define-package :clog-auth
|
|
(:documentation "CLOG-AUTH an authenticationa and authorization abstraction
|
|
for CLOG")
|
|
(:use #:cl #:clog #:mgl-pax))
|
|
|
|
(cl:in-package :clog-auth)
|
|
|
|
(defsection @clog-auth (:title "CLOG Auth Objects")
|
|
"CLOG-AUTH - Authentication"
|
|
(get-authentication-token function)
|
|
(store-authentication-token function)
|
|
(remove-authentication-token function)
|
|
(set-on-authentication-change function)
|
|
|
|
"CLOG-AUTH - Authorization"
|
|
(add-authorization function)
|
|
(is-authorized-p function))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Implementation - clog-auth - Authenitcation
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defparameter *clog-auth-key* "clog-auth-token"
|
|
"Key used for local storage of authentication token")
|
|
|
|
(defparameter *authorization-hash* (make-hash-table* :test #'equalp)
|
|
"Hash table of roles to actions")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; get-authentication-token ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun get-authentication-token (body &key auth-path)
|
|
"Retrieve the stored authentication token"
|
|
(check-type body clog-body)
|
|
(let ((token (storage-element (window body) :local *clog-auth-key*)))
|
|
(when (equalp token "null")
|
|
(setf token nil))
|
|
(unless token
|
|
(when auth-path
|
|
(url-assign (location body) auth-path)))
|
|
token))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; store-authentication-token ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun store-authentication-token (body token)
|
|
(check-type body clog-body)
|
|
(setf (storage-element (window body) :local *clog-auth-key*) token))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; remove-authentication-token ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun remove-authentication-token (body)
|
|
(check-type body clog-body)
|
|
(storage-remove (window body) :local *clog-auth-key*))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; set-on-authentication-change ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun set-on-authentication-change (body handler)
|
|
(check-type body clog-body)
|
|
(set-on-storage (window body) (lambda (obj data)
|
|
(declare (ignore obj))
|
|
(set-on-storage (window body) nil)
|
|
(when (equalp (getf data :key)
|
|
*clog-auth-key*)
|
|
(funcall handler body)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Implementation - clog-auth - Authorization
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defparameter *authorization-hash* (make-hash-table* :test #'equalp)
|
|
"Hash table of role to action")
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; add-authorization ;;
|
|
;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun add-authorization (role-list action-list)
|
|
"Add to each role in ROLE-LIST every action in ACTION-LIST"
|
|
(dolist (role role-list)
|
|
(dolist (action action-list)
|
|
(setf (gethash role *authorization-hash*)
|
|
(adjoin action (gethash role *authorization-hash*))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;
|
|
;; is-authorized-p ;;
|
|
;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun is-authorized-p (role-list action)
|
|
"Given ROLE-LIST is action authorized. If action is nil returns t."
|
|
(if action
|
|
(dolist (role role-list nil)
|
|
(when (member action (gethash role *authorization-hash*))
|
|
(return t)))
|
|
t))
|