(use-modules (webid-oidc server resource wac) (webid-oidc server resource content) (webid-oidc server resource path) (webid-oidc testing) (web http) (web request) (web response) (web uri)) (define (http-get uri . other-args) (when (string? uri) (set! uri (string->uri uri))) (unless (equal? uri (string->uri "https://fbi.databox.me/group")) (format (current-error-port) "Expected:\n ~s, got:\n ~s\n" uri (string->uri "https://fbi.databox.me/group")) (exit 1)) (values (build-response #:headers '((content-type text/turtle))) "@prefix vcard: . <#spies> a vcard:Group; vcard:hasMember . ")) (with-test-environment "direct-acl" (lambda () (for-each (lambda (f) (false-if-exception (delete-file (string-append "tests/direct-acl.home/webid-oidc/server/content/" f)))) '("6/8OMG_V5x-KmI6TI" "X/hqM_2Avn5_egTzs" "a/68pTwiImTWTpjQl" "5/n1KPgAd3ng4wSqn" "D/wxU0ogx5rzRrvu2" "F/BQKBGrtq6U_M0L7" "n/U46BXbknEaLWZpH" "N/gnO8RAS9FpPiO5j" "A/fkGTJRCHc-jHk-V" "H/y4S5p1BqTEJi-Jb" "b/k7RqZevpCHAumba" "y/29x0MEOMybxUqDU" "5/KVojpXDg0Aob3_v")) (with-session (lambda (content-type contained static-content create delete) ;; In this little scenario: ;; / can only be listed by Alice and the FBI ;; /docs/ can only be updated by Alice and the public can list ;; /docs/file1 can only be updated by Alice, but public ;; /docs/file2 same, but authenticated ;; /private-docs/ private to Alice, no ACL ;; /private-docs/file1 no ACL (so, readable by the FBI as inherited in /) ;; /private/docs/file2 no ACL (so, not readable by the FBI) (let ((/ (create 'text/turtle '("docs" "private-docs") "")) (/docs/ (create 'text/turtle '("file1" "file2") "")) (/docs/file1 (create 'text/plain #f "Hello :)")) (/docs/file2 (create 'text/plain #f "You’re authenticated :)")) (/private-docs/ (create 'text/turtle '("file1") "")) (/private-docs/file1 (create 'text/plain #f "Private, but FBI can read!")) (/private-docs/file2 (create 'text/plain #f "Private!")) (/.acl (create 'text/turtle #f "@prefix acl: . <#default> a acl:Authorization; acl:accessTo ; acl:agent ; acl:mode acl:Read, acl:Write, acl:Control; acl:default . <#for-the-fbi> a acl:Authorization; acl:accessTo ; acl:agentGroup ; acl:mode acl:Read, acl:Write; acl:default . ")) (/docs/.acl (create 'text/turtle #f "@prefix acl: . @prefix foaf: . <#default> a acl:Authorization; acl:accessTo ; acl:agent ; acl:mode acl:Read, acl:Write, acl:Control. <#anyone-can-list-files> a acl:Authorization; acl:accessTo ; acl:agentClass foaf:Agent; acl:mode acl:Read. ")) (/docs/file1.acl (create 'text/turtle #f "@prefix acl: . @prefix foaf: . <#default> a acl:Authorization; acl:accessTo ; acl:agent ; acl:mode acl:Read, acl:Write, acl:Control. <#public> a acl:Authorization; acl:accessTo ; acl:agentClass foaf:Agent; acl:mode acl:Read. ")) (/docs/file2.acl (create 'text/turtle #f "@prefix acl: . <#default> a acl:Authorization; acl:accessTo ; acl:agent ; acl:mode acl:Read, acl:Write, acl:Control. <#public> a acl:Authorization; acl:accessTo ; acl:agentClass acl:AuthenticatedAgent; acl:mode acl:Read. "))) (update-path "/" (lambda (main auxiliary) (values / `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") . ,/.acl)))) content-type contained static-content create delete) (update-path "/docs/" (lambda (main auxiliary) (values /docs/ `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") . ,/docs/.acl)))) content-type contained static-content create delete) (update-path "/docs/file1" (lambda (main auxiliary) (values /docs/file1 `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") . ,/docs/file1.acl)))) content-type contained static-content create delete) (update-path "/docs/file2" (lambda (main auxiliary) (values /docs/file2 `((,(string->uri "http://www.w3.org/ns/auth/acl#accessControl") . ,/docs/file2.acl)))) content-type contained static-content create delete) (update-path "/private-docs/" (lambda (main auxiliary) (values /private-docs/ '())) content-type contained static-content create delete) (update-path "/private-docs/file1" (lambda (main auxiliary) (values /private-docs/file1 '())) content-type contained static-content create delete) (update-path "/private-docs/file2" (lambda (main auxiliary) (values /private-docs/file2 '())) content-type contained static-content create delete) (let ((server-name (string->uri "https://alice.databox.me"))) ;; Who can access what? ;; Alice: https://alice.databox.me/profile/card#me ;; Bob: https://bob.databox.me/profile/card#me (authenticated) ;; FBI: https://the-spy.databox.me/profile/card#me ;; Anonymous ;; ;; Alice Bob FBI Anonymous ;; / RWC X RW X ;; /docs/ RWC R R R ;; /docs/file1 RWC R R R ;; /docs/file2 RWC R R X ;; /private-docs/ RWC X X X ;; /private-docs/file1 RWC X RW X ;; /private-docs/file2 RWC X X X (define (run-test path modes-alice modes-bob modes-fbi modes-anonymous) (define (uri< a b) (string< (uri->string a) (uri->string b))) (let ((alice (wac-get-modes server-name path (string->uri "https://alice.databox.me/profile/card#me") #:http-get http-get)) (bob (wac-get-modes server-name path (string->uri "https://bob.databox.me/profile/card#me") #:http-get http-get)) (fbi (wac-get-modes server-name path (string->uri "https://the-spy.databox.me/profile/card#me") #:http-get http-get)) (anonymous (wac-get-modes server-name path #f #:http-get http-get))) (unless (equal? alice modes-alice) (format (current-error-port) "Alice’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" path (map uri->string modes-alice) (map uri->string alice)) (exit 2)) (unless (equal? bob modes-bob) (format (current-error-port) "Bob’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" path (map uri->string modes-bob) (map uri->string bob)) (exit 3)) (unless (equal? fbi modes-fbi) (format (current-error-port) "Spy’s modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" path (map uri->string modes-fbi) (map uri->string fbi)) (exit 4)) (unless (equal? anonymous modes-anonymous) (format (current-error-port) "Anonymous modes for path ~s:\n expected:\n ~s\n got:\n ~s\n" path (map uri->string modes-anonymous) (map uri->string anonymous)) (exit 5)))) (let ((read (string->uri "http://www.w3.org/ns/auth/acl#Read")) (write (string->uri "http://www.w3.org/ns/auth/acl#Write")) (control (string->uri "http://www.w3.org/ns/auth/acl#Control"))) (let ((RWC (list control read write)) (R (list read)) (RW (list read write)) (X '())) (run-test "/" RWC X RW X) (run-test "/docs/" RWC R R R) (run-test "/docs/file1" RWC R R R) (run-test "/docs/file2" RWC R R X) (run-test "/private-docs/" RWC X X X) (run-test "/private-docs/file1" RWC X RW X) (run-test "/private-docs/file2" RWC X X X)))))))))