ACL WIP stuff.

parent eed924e4
;;; Pubstrate --- ActivityStreams based social networking for Guile
;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
;;;
;;; This file is part of Pubstrate.
;;;
;;; Pubstrate is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Pubstrate is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Pubstrate. If not, see <http://www.gnu.org/licenses/>.
;;;
;;; Access control lists
;;;
(define-module (pubstrate webapp acl)
#:use-module (pubstrate asobj)
#:use-module (pubstrate webapp store)
#:use-module (pubstrate webapp utils)
#:use-module (pubstrate webapp ctx)
#:use-module (srfi srfi-11))
(define (assert-asobj-local asobj)
(when (not (asobj-local? asobj))
(throw 'non-local-actor
"Can't check the permission of an asobj that isn't local"
#:asobj asobj)))
(define (actor-is-owner? asobj actor)
"Check whether the ACTOR is the author or attributedTo of the ASOBJ"
(and actor
(equal? (or (asobj-ref asobj "actor")
(asobj-ref asobj "attributedTo"))
(actor-id actor))))
;; @@: Maybe we want to just enable read/write access when the actor
;; is the actor or attributedTo on the object?
(define (actor-can-read? asobj actor)
"Check whether or not actor (which is either an actor asobj or #f) is
able to read asobj (which must be a local object)."
(assert-asobj-local asobj)
(cond
;; If it's public? Then the answer is always yes!
((asobj-publicly-readable? asobj)
#t)
;; No actor? Well we know it's not public, so no.
((not actor)
#f)
((actor-is-owner? asobj actor)
#t)
(else
(or (actor-in-read-users? asobj actor)
(actor-in-read-groups? asobj actor)))))
;; For now, write encompasses both update and delete
(define (actor-can-write? asobj #:optional actor)
"Check whether or not actor (which is either an actor asobj or #f) is
able to write asobj (which must be a local object)."
(assert-asobj-local asobj)
(cond
;; No actor? Then no.
((not actor)
#f)
((actor-is-owner? asobj actor)
#t)
(else
(or (actor-in-write-users? asobj actor)
(actor-in-write-groups? asobj actor)))))
(define (asobj-publicly-readable? asobj)
(asobj-private-ref asobj "publicly-readable?"))
(define (asobj-set-publicly-readable asobj #:optional (readable? #t))
"Set ASOBJ's publicly-readable? to READABLE?"
(asobj-private-set asobj "publicly-readable?" readable?))
(define (%add-actor-to-acl-collection acl-name)
(lambda (asobj actor)
(let-values ((store (ctx-ref 'store))
((asobj container-key)
(cond
((asobj-private-ref asobj acl-name) =>
;; Yep, we already have a container, return it as-is
(lambda (container-key)
(values asobj container-key)))
(else
(let* ((container-key (store-container-new! (ctx-ref 'store)))
(asobj (asobj-private-set asobj acl-name container-key)))
(values asobj container-key)))))
(actor-id (asobj-id actor)))
(when (not (store-container-member? store container-key actor-id))
(store-container-append! store container-key actor-id))
asobj)))
;;; Return a new copy of ASOBJ with ACTOR added to its readers.
;;;
;;; This may add a "read-users" key to the asobj if it doesn't have one yet,
;;; hence returning a new asobj.
(define add-actor-to-readers
(%add-actor-to-acl-name "read-actors"))
(define add-actor-to-writers
(%add-actor-to-acl-name "writer-actors"))
(define (%remove-actor-from-acl-collection acl-name)
(lambda (asobj actor)
(cond
((asobj-private-ref asobj acl-name) =>
(lambda (container-key)
(store-container-remove! (ctx-ref 'store)
container-key (asobj-id actor))
;; return the asobj, why not
asobj))
;; Oh I guess we didn't have a container, so we don't have to do anything!
(else
asobj))))
(define remove-actor-from-readers
(%remove-actor-from-acl-collection "read-actors"))
(define (remove-actor-from-writers asobj actor)
(%remove-actor-from-acl-collection "write-actors"))
(define (add-collection-to-readers asobj collection)
(%add-actor-to-acl-collection "read-collections"))
(define (add-collection-to-writers asobj collection)
(%add-actor-to-acl-collection "write-collections"))
(define (remove-collection-from-readers asobj collection)
(%remove-actor-from-acl-collection "read-collections"))
(define (remove-collection-from-writers asobj collection)
(%remove-actor-from-acl-collection "write-collections"))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment