diff options
| author | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-06 12:07:13 +0200 |
|---|---|---|
| committer | Vivien Kraus <vivien@planete-kraus.eu> | 2021-07-06 12:52:46 +0200 |
| commit | 9d23792481d7ae8d75d9565dd2a0b1e17d08943b (patch) | |
| tree | c7b9933c8d946175d480dc8e50b8ad86a527d704 /src/scm/webid-oidc/program.scm | |
| parent | 888fb3e55a5deca32aa46a2bdc7fa5994768797d (diff) | |
Also log exceptions
Diffstat (limited to 'src/scm/webid-oidc/program.scm')
| -rw-r--r-- | src/scm/webid-oidc/program.scm | 44 |
1 files changed, 24 insertions, 20 deletions
diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index 3ee86d8..be72f75 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -103,38 +103,42 @@ ((record-accessor &unknown-client-locale 'c-locale) error) (error->str error))) (lambda () - (receive (response response-body user) + (receive (response response-body user cause) (call-with-values (lambda () (handler request request-body)) (case-lambda ((response response-body) - (values response response-body #f)) + (values response response-body #f #f)) ((response response-body user) - (values response response-body user)))) + (values response response-body user #f)) + ((response response-body user cause) + (values response response-body user cause)))) (let ((logging-port (let ((response-code (response-code response))) (if (>= response-code 400) ;; That’s an error (current-error-port) (current-output-port))))) - (if user - (format logging-port - (G_ "~a: ~a (~a): ~s ~a ~s ~a\n") - (date->string (time-utc->date (current-time))) - (uri->string user) - (request-ip-address request) - (request-method request) - (uri-path (request-uri request)) - (response-code response) - (response-reason-phrase response)) - (format logging-port - (G_ "~a: ~a: ~s ~a ~s ~a\n") - (date->string (time-utc->date (current-time))) - (request-ip-address request) - (request-method request) - (uri-path (request-uri request)) - (response-code response) + (format logging-port + (G_ "~a: ~s ~a ~s ~a\n") + (if user + (format #f (G_ "~a: ~a (~a)") + (date->string (time-utc->date (current-time))) + (uri->string user) + (request-ip-address request)) + (format #f (G_ "~a: ~a") + (date->string (time-utc->date (current-time))) + (request-ip-address request))) + (request-method request) + (uri-path (request-uri request)) + (response-code response) + (if cause + (string-append + (response-reason-phrase response) + " " + (format #f (G_ "(there was an error: ~a)") + (error->str cause))) (response-reason-phrase response)))) (return (build-response |