Hash :
ec818092
Author :
Date :
2014-03-25T15:33:19
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
;;
;; can - semantic rule-based access control library.
;;
;; Copyright 2013,2014 Thomas de Grivel <billitch@gmail.com>
;;
;; Permission to use, copy, modify, and distribute this software for any
;; purpose with or without fee is hereby granted, provided that the above
;; copyright notice and this permission notice appear in all copies.
;;
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
;; WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
;; MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
;; ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
;; WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
;; ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
;; OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;
(in-package #:can)
(defvar *rules*)
(defun reset-rules ()
(setq *rules* nil))
#+nil
(reset-rules)
(defmacro define-permission ((subject permission action object) &body specs)
`(push '((,subject ,permission ,action ,object) . ,specs)
*rules*))
#+nil
(define-permission (?user :can :edit ?module)
(?user :is-a 'user
'user.status :active)
(?module :is-a 'module
'module.owner ?user))
#+nil
(define-permission (:everyone :can :view :all))
#+nil
(rule-bindings '?s '?a '?o (first *rules*))
(defun can/rule (subject action object rule)
(destructuring-bind ((s p a o) &body specs) rule
(let (bindings constants)
(flet ((unify (r x wild)
(if (facts:binding-p r)
(push (cons r x) bindings)
(push `(or (lessp:lessp-equal ',r ,x)
(eq ',r ,wild)
(eq ,x ,wild))
constants))))
(unify o object :all)
(unify a action :admin)
(unify s subject :everyone))
`(when (and ,@constants
,@(when specs
`((facts:bound-p ,(sublis bindings specs)))))
,p))))
#+nil
(can/rule 'user ':edit 'object (second *rules*))
(defun can (action &optional (object :all)
(user (or (session-user) :anonymous)))
(declare (ignore action object user))
(error "Please call CAN:COMPILE-RULES."))
(defun compile-rules ()
(setf (symbol-function 'can)
(compile nil `(lambda (action &optional (object :all)
(user (or (session-user) :anonymous)))
(eq (or ,@(mapcar (lambda (rule)
(can/rule 'user 'action 'object rule))
*rules*))
:can)))))