From ded10e28782f289ad3db15320bcf619ab4336876 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Mon, 9 Aug 2021 18:46:48 +0200 Subject: Switch to a more sensible error reporting system --- src/scm/webid-oidc/server/resource/path.scm | 112 ++++++++++++++++++++++++---- 1 file changed, 98 insertions(+), 14 deletions(-) (limited to 'src/scm/webid-oidc/server/resource/path.scm') diff --git a/src/scm/webid-oidc/server/resource/path.scm b/src/scm/webid-oidc/server/resource/path.scm index 55c4274..b8a9472 100644 --- a/src/scm/webid-oidc/server/resource/path.scm +++ b/src/scm/webid-oidc/server/resource/path.scm @@ -1,4 +1,4 @@ -;; webid-oidc, implementation of the Solid specification +;; disfluid, implementation of the Solid specification ;; Copyright (C) 2020, 2021 Vivien Kraus ;; This program is free software: you can redistribute it and/or modify @@ -18,6 +18,7 @@ #:use-module (webid-oidc errors) #:use-module ((webid-oidc stubs) #:prefix stubs:) #:use-module (webid-oidc rdf-index) + #:use-module (webid-oidc web-i18n) #:use-module ((webid-oidc refresh-token) #:prefix refresh:) #:use-module ((webid-oidc parameters) #:prefix p:) #:use-module (web uri) @@ -31,9 +32,35 @@ #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (oop goops) + #:declarative? #t #:export ( + &path-not-found + make-path-not-found + path-not-found? + path-not-found-path + + &uri-slash-semantics-error + make-uri-slash-semantics-error + uri-slash-semantics-error? + uri-slash-semantics-error-requested + uri-slash-semantics-error-existing + + &container-not-empty + make-container-not-empty + container-not-empty? + container-not-empty-path + + &cannot-delete-root + make-cannot-delete-root + cannot-delete-root? + + &path-is-auxiliary + make-path-is-auxiliary + path-is-auxiliary? + path-is-auxiliary-path + read-path update-path @@ -48,6 +75,41 @@ )) +(define-exception-type + &path-not-found + &external-error + make-path-not-found + path-not-found? + (path path-not-found-path)) + +(define-exception-type + &uri-slash-semantics-error + &external-error + make-uri-slash-semantics-error + uri-slash-semantics-error? + (requested uri-slash-semantics-error-requested) + (existing uri-slash-semantics-error-existing)) + +(define-exception-type + &container-not-empty + &external-error + make-container-not-empty + container-not-empty? + (path container-not-empty-path)) + +(define-exception-type + &cannot-delete-root + &external-error + make-cannot-delete-root + cannot-delete-root?) + +(define-exception-type + &path-is-auxiliary + &external-error + make-path-is-auxiliary + path-is-auxiliary? + (path path-is-auxiliary-path)) + (define (hash-path/lock path) (let ((h (stubs:hash 'SHA-256 path)) (dir (p:data-home))) @@ -78,17 +140,30 @@ (without-slash-exists (file-exists? (hash-path without-slash)))) (cond (with-slash-exists - (raise-exception - (make-exception - (make-path-not-found path) - (make-uri-slash-semantics-error path with-slash)))) + (let ((final-message + (format #f (G_ "incorrect slash semantics: path ~s should have a slash") + path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-uri-slash-semantics-error path with-slash) + (make-exception-with-message final-message))))) (without-slash-exists - (raise-exception - (make-exception - (make-path-not-found path) - (make-uri-slash-semantics-error path with-slash)))) + (let ((final-message + (format #f (G_ "incorrect slash semantics: path ~s should not have a slash") + path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-uri-slash-semantics-error path without-slash) + (make-exception-with-message final-message))))) (else - (raise-exception (make-path-not-found path))))))) + (let ((final-message + (format #f (G_ "path ~s does not exist") path))) + (raise-exception + (make-exception + (make-path-not-found path) + (make-exception-with-message final-message))))))))) (lambda () (call-with-input-file h (lambda (port) @@ -152,19 +227,28 @@ (case-lambda ((false) (when false - (error "You’re using the API wrong.")) + (fail (G_ "You’re using the API wrong."))) ;; Delete the resource (unless (or (not etag) (not (contained etag)) (null? (contained etag))) - (raise-exception (make-container-not-empty path))) + (raise-exception + (make-exception + (make-container-not-empty path) + (make-exception-with-message + (format #f (G_ "the path ~s exists, it has contained paths, and it is not empty") + path))))) (when (equal? path "/") - (raise-exception (make-cannot-delete-root))) + (raise-exception + (make-exception + (make-cannot-delete-root) + (make-exception-with-message + (format #f (G_ "you cannot delete the root")))))) (set! has-been-deleted? #t) #f) ((new-etag new-auxiliary) (unless (and (string? new-etag) (list? new-auxiliary)) - (error "You’re using the API wrong.")) + (fail (G_ "You’re using the API wrong."))) (hash-remove! garbage new-etag) (when new-auxiliary (for-each -- cgit v1.2.3