diff options
Diffstat (limited to 'src/scm/webid-oidc/program.scm')
| -rw-r--r-- | src/scm/webid-oidc/program.scm | 37 |
1 files changed, 27 insertions, 10 deletions
diff --git a/src/scm/webid-oidc/program.scm b/src/scm/webid-oidc/program.scm index f083700..50f0da4 100644 --- a/src/scm/webid-oidc/program.scm +++ b/src/scm/webid-oidc/program.scm @@ -100,22 +100,39 @@ ((record-accessor &unknown-client-locale 'c-locale) error) (error->str error))) (lambda () - (receive (response response-body) - (handler request request-body) + (receive (response response-body user) + (call-with-values + (lambda () + (handler request request-body)) + (case-lambda + ((response response-body) + (values response response-body #f)) + ((response response-body user) + (values response response-body user)))) (let ((logging-port (let ((response-code (response-code response))) (if (>= response-code 400) ;; That’s an error (current-error-port) (current-output-port))))) - (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) - (response-reason-phrase response))) + (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) + (response-reason-phrase response)))) (return (build-response #:version (response-version response) |