From d4ba8350e1c821e8a262ab3e84e440069069e34a Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Fri, 25 Jun 2021 17:02:42 +0200 Subject: WAC: add auxiliary functions to check the well-known modes --- doc/webid-oidc.texi | 10 ++++++ src/scm/webid-oidc/server/resource/wac.scm | 56 ++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+) diff --git a/doc/webid-oidc.texi b/doc/webid-oidc.texi index ccb6e25..5900256 100644 --- a/doc/webid-oidc.texi +++ b/doc/webid-oidc.texi @@ -643,6 +643,16 @@ whatsoever, bypassing WAC. Otherwise, it is possible to steal control away from the data owner. @end deffn +@deffn function check-acl-can-read @var{server-name} @var{path} @var{owner} @var{user} @var{[#:http-get]} +@deffnx function check-acl-can-write @var{server-name} @var{path} @var{owner} @var{user} @var{[#:http-get]} +@deffnx function check-acl-can-append @var{server-name} @var{path} @var{owner} @var{user} @var{[#:http-get]} +@deffnx function check-acl-can-control @var{server-name} @var{path} @var{owner} @var{user} @var{[#:http-get]} +Assert that the resource at @var{path} on @var{server-name} is owned +by @var{owner}, and check that @var{user} has the proper +authorization. Otherwise, raise an exception of type +@code{&forbidden}. +@end deffn + @node Running a client @chapter Running a client diff --git a/src/scm/webid-oidc/server/resource/wac.scm b/src/scm/webid-oidc/server/resource/wac.scm index b9959f9..47748ca 100644 --- a/src/scm/webid-oidc/server/resource/wac.scm +++ b/src/scm/webid-oidc/server/resource/wac.scm @@ -26,6 +26,11 @@ wac-get-modes + check-acl-can-read + check-acl-can-write + check-acl-can-append + check-acl-can-control + )) (define (group-member? http-get group-uri agent) @@ -233,3 +238,54 @@ (sort all-modes (lambda (a b) (string< (uri->string a) (uri->string b))))))))) + +(define (check-mode server-name path owner user http-get expected-mode) + (unless (equal? owner user) + (receive (base-path type) + (base-path path) + (when (equal? type (string->uri "https://www.w3.org/ns/iana/link-relations/relation#describedby")) + ;; We’re checking the description resource, which is an alias + ;; for the real resource. + (set! path base-path)) + (when (equal? type (string->uri "http://www.w3.org/ns/auth/acl#accessControl")) + ;; We’re checking access modes for the ACL, so we’re looking + ;; for Control over the base resource. + (set! path base-path) + (set! expected-mode (string->uri "http://www.w3.org/ns/auth/acl#Control")))) + (let ((modes (wac-get-modes server-name path user #:http-get http-get))) + (define (check-modes modes) + (if (null? modes) + (raise-exception + (make-forbidden path user owner expected-mode)) + (or + (equal? (car modes) expected-mode) + ;; It is also OK if we’re asking for acl:Append but + ;; acl:Write is provided. + (and (equal? expected-mode (string->uri "http://www.w3.org/ns/auth/acl#Append")) + (equal? (car modes) (string->uri "http://www.w3.org/ns/auth/acl#Write"))) + (check-modes (cdr modes))))) + (check-modes modes)))) + +(define* (check-acl-can-read server-name path owner user + #:key + (http-get http-get)) + (check-mode server-name path owner user http-get + (string->uri "http://www.w3.org/ns/auth/acl#Read"))) + +(define* (check-acl-can-write server-name path owner user + #:key + (http-get http-get)) + (check-mode server-name path owner user http-get + (string->uri "http://www.w3.org/ns/auth/acl#Write"))) + +(define* (check-acl-can-append server-name path owner user + #:key + (http-get http-get)) + (check-mode server-name path owner user http-get + (string->uri "http://www.w3.org/ns/auth/acl#Append"))) + +(define* (check-acl-can-control server-name path owner user + #:key + (http-get http-get)) + (check-mode server-name path owner user http-get + (string->uri "http://www.w3.org/ns/auth/acl#Control"))) -- cgit v1.2.3