diff options
author | Andy Wingo <wingo@pobox.com> | 2014-10-15 11:49:41 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-11-01 15:36:56 +0100 |
commit | 18c44b29e4438976dac86a3cb53a273dde42e294 (patch) | |
tree | 0decd8153038f4775a01776c27ebc724eb94aed3 /module/web/request.scm | |
parent | 7f2c824551aa848b359ef6b79c1d5e15d367eb8a (diff) | |
download | guile-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.scm | 8 |
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) |