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/http.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/http.scm')
-rw-r--r-- | module/web/http.scm | 56 |
1 files changed, 29 insertions, 27 deletions
diff --git a/module/web/http.scm b/module/web/http.scm index aa75142fc..a157cf021 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -1090,20 +1090,19 @@ three values: the method, the URI, and the version." (bad-request "Bad Request-Line: ~s" line)))) (define (write-uri uri port) - (if (uri-host uri) - (begin - (display (uri-scheme uri) port) - (display "://" port) - (if (uri-userinfo uri) - (begin - (display (uri-userinfo uri) port) - (display #\@ port))) - (display (uri-host uri) port) - (let ((p (uri-port uri))) - (if (and p (not (eqv? p 80))) - (begin - (display #\: port) - (display p port)))))) + (when (uri-host uri) + (when (uri-scheme uri) + (display (uri-scheme uri) port) + (display #\: port)) + (display "//" port) + (when (uri-userinfo uri) + (display (uri-userinfo uri) port) + (display #\@ port)) + (display (uri-host uri) port) + (let ((p (uri-port uri))) + (when (and p (not (eqv? p 80))) + (display #\: port) + (display p port)))) (let* ((path (uri-path uri)) (len (string-length path))) (cond @@ -1113,10 +1112,9 @@ three values: the method, the URI, and the version." (bad-request "Empty path and no host for URI: ~s" uri)) (else (display path port)))) - (if (uri-query uri) - (begin - (display #\? port) - (display (uri-query uri) port)))) + (when (uri-query uri) + (display #\? port) + (display (uri-query uri) port))) (define (write-request-line method uri version port) "Write the first line of an HTTP request to PORT." @@ -1226,11 +1224,11 @@ treated specially, and is just returned as a plain string." (@@ (web uri) absolute-uri?) write-uri)) -;; emacs: (put 'declare-relative-uri-header! 'scheme-indent-function 1) -(define (declare-relative-uri-header! name) +;; emacs: (put 'declare-uri-reference-header! 'scheme-indent-function 1) +(define (declare-uri-reference-header! name) (declare-header! name (lambda (str) - (or ((@@ (web uri) string->uri*) str) + (or (string->uri-reference str) (bad-header-component 'uri str))) uri? write-uri)) @@ -1519,9 +1517,9 @@ treated specially, and is just returned as a plain string." ;; (declare-integer-header! "Content-Length") -;; Content-Location = ( absoluteURI | relativeURI ) +;; Content-Location = URI-reference ;; -(declare-relative-uri-header! "Content-Location") +(declare-uri-reference-header! "Content-Location") ;; Content-MD5 = <base64 of 128 bit MD5 digest as per RFC 1864> ;; @@ -1822,9 +1820,9 @@ treated specially, and is just returned as a plain string." (display (cdr pair) port))) ","))) -;; Referer = ( absoluteURI | relativeURI ) +;; Referer = URI-reference ;; -(declare-relative-uri-header! "Referer") +(declare-uri-reference-header! "Referer") ;; TE = #( t-codings ) ;; t-codings = "trailers" | ( transfer-extension [ accept-params ] ) @@ -1859,9 +1857,13 @@ treated specially, and is just returned as a plain string." entity-tag? write-entity-tag) -;; Location = absoluteURI +;; Location = URI-reference +;; +;; In RFC 2616, Location was specified as being an absolute URI. This +;; was changed in RFC 7231 to permit URI references generally, which +;; matches web reality. ;; -(declare-uri-header! "Location") +(declare-uri-reference-header! "Location") ;; Proxy-Authenticate = 1#challenge ;; |