summaryrefslogtreecommitdiff
path: root/module/web/request.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-10-15 11:49:41 +0200
committerAndy Wingo <wingo@pobox.com>2014-11-01 15:36:56 +0100
commit18c44b29e4438976dac86a3cb53a273dde42e294 (patch)
tree0decd8153038f4775a01776c27ebc724eb94aed3 /module/web/request.scm
parent7f2c824551aa848b359ef6b79c1d5e15d367eb8a (diff)
downloadguile-18c44b29e4438976dac86a3cb53a273dde42e294.tar.gz
web: Location header is URI-reference; better URI-reference support
* module/web/uri.scm (validate-uri): Add reference? keyword argument, for validating references. (build-uri): Clarify comments to indicate that the result is an absolute URI. (build-uri-reference): New interface, to build URI-references. (string->uri-reference): Rename from string->uri*. Fix fragment parsing to not include the #. (string->uri): Adapt to string->uri-reference name change. * module/web/request.scm (request-absolute-uri): Add default-scheme optional argument. Use it if the request-uri has no scheme, or error. * module/web/http.scm (write-uri): Reflow to use "when". Fix writing of URI-reference instances. (declare-uri-reference-header!): Rename from declare-relative-uri-header!. Use string->uri-reference. ("Location"): Declare as a URI-reference header, as per RFC 7231. * module/web/client.scm (open-socket-for-uri): Handle the case in which there is no URI scheme. * test-suite/tests/web-http.test: * test-suite/tests/web-uri.test: Add tests.
Diffstat (limited to 'module/web/request.scm')
-rw-r--r--module/web/request.scm8
1 files changed, 6 insertions, 2 deletions
diff --git a/module/web/request.scm b/module/web/request.scm
index 7ced076fa..0a206cf35 100644
--- a/module/web/request.scm
+++ b/module/web/request.scm
@@ -300,7 +300,8 @@ request R."
(define-request-accessor user-agent #f)
;; Misc accessors
-(define* (request-absolute-uri r #:optional default-host default-port)
+(define* (request-absolute-uri r #:optional default-host default-port
+ default-scheme)
"A helper routine to determine the absolute URI of a request, using the
‘host’ header and the default host and port."
(let ((uri (request-uri r)))
@@ -313,7 +314,10 @@ request R."
(bad-request
"URI not absolute, no Host header, and no default: ~s"
uri)))))
- (build-uri (uri-scheme uri)
+ (build-uri (or (uri-scheme uri)
+ default-scheme
+ (bad-request "URI not absolute and no default-port"
+ uri))
#:host (car host)
#:port (cdr host)
#:path (uri-path uri)