diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-06 10:39:29 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-06 10:39:29 +0200 |
| commit | 30cc567b291c9f5af200a327bbd79f555541b57b (patch) | |
| tree | 87272f8b7b7964496b19eb803bd7a54a84c69cbc /src/scm/webid-oidc/resource-server.scm | |
| parent | c243694b33f1783824a4d4b747d1e463d500b2b4 (diff) | |
Log the authenticated user too
Diffstat (limited to 'src/scm/webid-oidc/resource-server.scm')
| -rw-r--r-- | src/scm/webid-oidc/resource-server.scm | 47 |
1 files changed, 31 insertions, 16 deletions
diff --git a/src/scm/webid-oidc/resource-server.scm b/src/scm/webid-oidc/resource-server.scm index 9257a43..a8e88f5 100644 --- a/src/scm/webid-oidc/resource-server.scm +++ b/src/scm/webid-oidc/resource-server.scm @@ -120,12 +120,13 @@ (lambda () (f return)))))) -(define (serve-get return path if-match if-none-match content-type content etag headers) +(define (serve-get return path if-match if-none-match content-type content etag headers user) (define (respond-normal) (return (build-response #:headers headers) - content)) + content + user)) (if if-match ;; If the precondition failed, then we should respond with 412 (with-exception-handler @@ -136,7 +137,8 @@ (build-response #:code 412 #:reason-phrase "Precondition Failed") - #f)) + #f + user)) (lambda () (check-precondition path if-match if-none-match etag) (respond-normal))) @@ -151,7 +153,8 @@ #:code 304 #:reason-phrase "Not Modified" #:headers headers) - #f)) + #f + user)) (lambda () (when if-none-match (check-precondition path if-match if-none-match etag)) @@ -207,7 +210,8 @@ negociated-content (car (assq-ref headers 'etag)) (cons `(content-type ,negociated-content-type) - other-headers)))))) + other-headers) + user))))) ((PUT) (return (build-response @@ -220,7 +224,8 @@ request-body #:http-get http-get) . #f)))) - "")) + "" + user)) ((POST) (let ((types (map car @@ -239,7 +244,8 @@ (request-content-type request) request-body #:http-get http-get)))) - ""))) + "" + user))) ((DELETE) (delete server-uri owner user (uri-path (request-uri request)) @@ -248,7 +254,8 @@ #:http-get http-get) (return (build-response) - ""))))) + "" + user))))) (lambda (return error) (if (cannot-fetch-group? error) (format (current-error-port) (G_ "Warning: ~a\n") @@ -267,7 +274,8 @@ #:host (uri-host server-uri) #:port (uri-port server-uri) #:path (uri-slash-semantics-error-expected-path error))))) - #f)) + #f + user)) ((or (path-not-found? error) (auxiliary-resource-absent? error) (forbidden? error)) @@ -275,17 +283,20 @@ ;; That’s a forbidden (return (build-response #:code 403 #:reason-phrase "Forbidden") - #f) + #f + user) (return (build-response #:code 401 #:reason-phrase "Unauthorized" #:headers `((www-authenticate . ((DPoP))))) - #f))) + #f + user))) ((or (cannot-delete-root? error)) (return (build-response #:code 405 #:reason-phrase "Method Not Allowed") - #f)) + #f + user)) ((or (container-not-empty? error) (incorrect-containment-triples? error) (path-is-auxiliary? error)) @@ -293,24 +304,28 @@ (build-response #:code 409 #:reason-phrase "Conflict") - #f)) + #f + user)) ((unsupported-media-type? error) (return (build-response #:code 415 #:reason-phrase "Unsupported Media Type") - #f)) + #f + user)) ((precondition-failed? error) (return (build-response #:code 412 #:reason-phrase "Precondition Failed") - #f)) + #f + user)) ((not-acceptable? error) (return (build-response #:code 406 #:reason-phrase "Not Acceptable") - #f)) + #f + user)) (else (raise-exception error))))))))) |