summaryrefslogtreecommitdiff
path: root/tests/acl.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/acl.scm')
-rw-r--r--tests/acl.scm249
1 files changed, 249 insertions, 0 deletions
diff --git a/tests/acl.scm b/tests/acl.scm
new file mode 100644
index 0000000..b582b17
--- /dev/null
+++ b/tests/acl.scm
@@ -0,0 +1,249 @@
+(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: <http://www.w3.org/2006/vcard/ns#>.
+
+<#spies> a vcard:Group;
+ vcard:hasMember <https://the-spy.databox.me/profile/card#me> .
+"))
+
+(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: <http://www.w3.org/ns/auth/acl#> .
+
+<#default>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/>;
+ acl:agent <https://alice.databox.me/profile/card#me>;
+ acl:mode acl:Read, acl:Write, acl:Control;
+ acl:default <https://alice.databox.me/>.
+
+<#for-the-fbi>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/>;
+ acl:agentGroup <https://fbi.databox.me/group#spies>;
+ acl:mode acl:Read, acl:Write;
+ acl:default <https://alice.databox.me/private-docs/file1>.
+"))
+ (/docs/.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
+@prefix foaf: <http://xmlns.com/foaf/0.1/>.
+
+<#default>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/>;
+ acl:agent <https://alice.databox.me/profile/card#me>;
+ acl:mode acl:Read, acl:Write, acl:Control.
+
+<#anyone-can-list-files>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/>;
+ acl:agentClass foaf:Agent;
+ acl:mode acl:Read.
+"))
+ (/docs/file1.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
+@prefix foaf: <http://xmlns.com/foaf/0.1/>.
+
+<#default>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/file1>;
+ acl:agent <https://alice.databox.me/profile/card#me>;
+ acl:mode acl:Read, acl:Write, acl:Control.
+
+<#public>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/file1>;
+ acl:agentClass foaf:Agent;
+ acl:mode acl:Read.
+"))
+ (/docs/file2.acl (create 'text/turtle #f "@prefix acl: <http://www.w3.org/ns/auth/acl#> .
+
+<#default>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/file2>;
+ acl:agent <https://alice.databox.me/profile/card#me>;
+ acl:mode acl:Read, acl:Write, acl:Control.
+
+<#public>
+ a acl:Authorization;
+ acl:accessTo <https://alice.databox.me/docs/file2>;
+ 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)))))))))
generated by cgit v1.2.3 (git 2.44.0) at 2024-05-06 23:23:11 +0000