diff options
Diffstat (limited to 'src/scm/webid-oidc/reverse-proxy.scm')
| -rw-r--r-- | src/scm/webid-oidc/reverse-proxy.scm | 56 |
1 files changed, 16 insertions, 40 deletions
diff --git a/src/scm/webid-oidc/reverse-proxy.scm b/src/scm/webid-oidc/reverse-proxy.scm index ee4878e..4221fa5 100644 --- a/src/scm/webid-oidc/reverse-proxy.scm +++ b/src/scm/webid-oidc/reverse-proxy.scm @@ -34,6 +34,8 @@ #:use-module (webid-oidc cache) #:use-module (webid-oidc web-i18n) #:use-module (web server) + #:use-module (webid-oidc server endpoint) + #:use-module (webid-oidc server endpoint reverse-proxy) #:declarative? #t #:export ( @@ -56,6 +58,10 @@ #:server-uri server-uri)) (unless (and endpoint (uri? endpoint)) (fail (G_ "#:endpoint argument is not present or not an URI."))) + (define backend + (make <reverse-proxy> + #:backend-uri endpoint + #:authentication-header auth-header)) (lambda (request request-body) (let ((agent (catch #t @@ -72,43 +78,13 @@ (request-time ((p:current-date)))) (parameterize ((p:current-date request-time) (web-locale request)) - ;; The time is now set for the duration of the request - (let ((raw-headers (request-headers request))) - (let ((modified-headers - (append - (if agent - (list (cons auth-header (uri->string agent))) - '()) - (filter - (lambda (h) - (not (eq? (car h) auth-header))) - raw-headers)))) - (let ((modified-request - (build-request - (request-uri request) - #:method (request-method request) - #:headers modified-headers))) - (let ((port (open-socket-for-uri endpoint))) - (let ((request-with-port - (write-request modified-request port))) - (when request-body - (unless (bytevector? request-body) - (set! request-body (string->utf8 request-body))) - (write-request-body request-with-port request-body)) - (force-output (request-port request-with-port)) - (let ((response (read-response port))) - (let ((response-body - (or (response-must-not-include-body? response) - (read-response-body response)))) - (let ((adapted-response - (build-response - #:code (response-code response) - #:reason-phrase (response-reason-phrase response) - #:headers - (append - (if (eqv? (response-code response) 401) - (list (cons 'www-authenticate '((DPoP)))) - '()) - (response-headers response))))) - (close-port port) - (values adapted-response response-body))))))))))))) + (set! request + (build-request (request-uri request) + #:method (request-method request) + #:version (request-version request) + #:headers (request-headers request) + #:port (request-port request) + #:meta `((user . ,agent) ,@(request-meta request)))) + (receive (response response-body response-meta) + (handle backend request request-body) + (values response response-body)))))) |