diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-10-21 10:53:28 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-11-14 16:49:56 +0000 |
| commit | 25431da247c33c66529c373e13919c87d8e86c55 (patch) | |
| tree | 403f23f76bfd4a86960b413e99b4fc688003ec63 | |
| parent | 17bc5999ce9ee774afd82d8ede33f5a9be61a4af (diff) | |
Verbose HTTP router
| -rw-r--r-- | src/scm/webid-oidc/server/endpoint.scm | 18 |
1 files changed, 16 insertions, 2 deletions
diff --git a/src/scm/webid-oidc/server/endpoint.scm b/src/scm/webid-oidc/server/endpoint.scm index 9a19ceb..e38bb5e 100644 --- a/src/scm/webid-oidc/server/endpoint.scm +++ b/src/scm/webid-oidc/server/endpoint.scm @@ -151,6 +151,7 @@ (list routed))))))) (define-method (relevant? (endpoint <endpoint>) request) + (format (current-error-port) "Is ~s relevant for ~s?\n" endpoint request) (let ((requested-host (match (request-host request) ((or ((? string? host) . _) @@ -160,22 +161,34 @@ (requested-path (split-and-decode-uri-path (uri-path (request-uri request))))) + (format (current-error-port) "Requested host: ~s, requested path: ~s\n" requested-host requested-path) (and (or (not (host endpoint)) (equal? (host endpoint) requested-host)) (let check-path ((path (split-and-decode-uri-path (path endpoint))) (requested-path requested-path)) + (format (current-error-port) "Checking if path ~s is compatible with requested path ~s…\n" path requested-path) (match `(,path ,requested-path) - ((() _) #t) - ((_ ()) #f) + ((() _) + (format (current-error-port) "Yes.\n") + #t) + ((_ ()) + (format (current-error-port) "No.\n") + #f) (((element path ...) (requested-element requested-path ...)) + (unless (equal? element requested-element) + (format (current-error-port) "No (~s vs ~s)\n" element requested-element)) (and (equal? element requested-element) + (format (current-error-port) "Maybe…\n") (check-path path requested-path)))))))) (define-method (handle (endpoint <router>) request request-body) + (format (current-error-port) "Handling in a router: ~s ~s\n" request request-body) (let find-router ((routed (routed endpoint))) + (format (current-error-port) "Handling in a router: ~s ~s, ~s\n" request request-body routed) (match routed (() + (format (current-error-port) "Handling in a router: ~s ~s, no more routed\n" request request-body) (raise-exception (make-exception (make-web-exception 404 (W_ "Not Found")) @@ -183,6 +196,7 @@ (((and router (? (cute relevant? <> request))) _ ...) + (format (current-error-port) "Handling in a router: ~s ~s, found ~s\n" request request-body router) (handle router request request-body)) ((_ routed ...) (find-router routed))))) |