diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-15 00:45:43 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-15 01:43:12 +0100 |
| commit | 622b88d8d9b6d1456d134936362ed9a30cd1fe41 (patch) | |
| tree | 5df625959187b4b234083135f8fb04b42deba246 /module/web | |
| parent | Qualify functions in make-routes expansion. (diff) | |
| download | calp-622b88d8d9b6d1456d134936362ed9a30cd1fe41.tar.gz calp-622b88d8d9b6d1456d134936362ed9a30cd1fe41.tar.xz | |
Fix r:host and r:port in make-route's body.
Also noted that r:port was bound twice.
The earlier binding (which is now removed) was a Guile IO-port for
writing the response, while the later was the target port number of the
request.
Diffstat (limited to 'module/web')
| -rw-r--r-- | module/web/http/make-routes.scm | 21 |
1 files changed, 9 insertions, 12 deletions
diff --git a/module/web/http/make-routes.scm b/module/web/http/make-routes.scm index abaa6870..0efb2fb1 100644 --- a/module/web/http/make-routes.scm +++ b/module/web/http/make-routes.scm @@ -66,25 +66,22 @@ (r:uri ((@ (web request) request-uri) request)) (r:version ((@ (web request) request-version) request)) (r:headers ((@ (web request) request-headers) request)) - (r:meta ((@ (web request) request-meta) request)) - (r:port ((@ (web request) request-port) request))) + (r:meta ((@ (web request) request-meta) request))) (let ((r:scheme ((@ (web uri) uri-scheme) r:uri)) (r:userinfo ((@ (web uri) uri-userinfo) r:uri)) - ;; TODO can sometimes be a pair of host and port - ;; '("localhost" . 8080). It shouldn't... - (r:host (or ((@ (web uri) uri-host) r:uri) - ((@ (web request) request-host) - request))) - (r:port (or ((@ (web uri) uri-port) r:uri) - ((@ (web request) request-port) - request))) + ;; uri-{host,port} is (probably) not set when we are a server, + ;; fetch them from the request instead + (r:host (or ((@ (web uri) uri-host) r:uri) + (and=> ((@ (web request) request-host) request) car))) + (r:port (or ((@ (web uri) uri-port) r:uri) + (and=> ((@ (web request) request-host) request) cdr))) (r:path ((@ (web uri) uri-path) r:uri)) (r:query ((@ (web uri) uri-query) r:uri)) (r:fragment ((@ (web uri) uri-fragment) r:uri))) ;; TODO propper logging - (display (format #f "[~a] ~a ~a/~a?~a~%" + (display (format #f "[~a] ~a ~a:~a~a?~a~%" (datetime->string (current-datetime)) - r:method r:host r:path (or r:query "")) + r:method r:host r:port r:path (or r:query "")) (current-error-port)) (call-with-values (lambda () |