From: Daniel Hartwig <mandyke@gmail.com>
To: Andy Wingo <wingo@pobox.com>
Cc: "Ludovic Courtès" <ludo@gnu.org>, 12827@debbugs.gnu.org
Subject: bug#12827: [PATCH] Tweak web modules, support relative URIs
Date: Sat, 16 Mar 2013 22:25:34 +0800 [thread overview]
Message-ID: <CAN3veRcCsRm8DX8awJtzoMeT96=NPNzLQqeb9D-ZryuDLyusFw@mail.gmail.com> (raw)
In-Reply-To: <87a9q7impu.fsf@pobox.com>
[-- Attachment #1: Type: text/plain, Size: 1181 bytes --]
On 13 March 2013 19:05, Andy Wingo <wingo@pobox.com> wrote:
> What's the status here, Daniel? Would be nice to fix this bug one way
> or another for 2.0.8.
Latest work attached, updated as per discussion with Mark.
Still missing #:base-uri (RFC 3986 #5.2) and some polish.
For the docs, I believe it best to follow the RFC and leave the
existing section on URIs as-is, followed by a new section introducing
the other types. This will help avoid conflating the two concepts of
URI and URI-reference.
Regarding the interface. There is now an abundance of constructors
and string converters, one for each specific type. It is also
somewhat inconsistent in that there is no need for multiple accessors
or ‘uri*->string’ procedures. An alternative interface might employ a
single constructor similar to ‘make-time’, using a set of
variables/symbols to represent the desired type:
build-uri-reference arg ... [#:type=‘uri’]
string->uri-reference str [type]
where TYPE is one of ‘uri’, ‘uri-reference’, ‘relative-ref’,
‘absolute-uri’. Perhaps even have a single ‘build-uri’ with these
semantics.
Comments, ideas?
[-- Attachment #2: 0001-web-add-support-for-URI-reference.patch --]
[-- Type: application/octet-stream, Size: 25390 bytes --]
From 26655a2ae8a2864ea867ed5240eff5d0bb916a49 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sat, 16 Mar 2013 21:18:34 +0800
Subject: [PATCH] web: add support for URI-reference
* doc/ref/web.texi (URIs): Fragments are properly part of a URI, so
remove the incorrect note.
* module/web/uri.scm (uri-reference?): New base type predicate.
(uri?, relative-ref?, absolute-uri?): Specific predicates.
(validate-uri-reference): Strict validation.
(validate-uri, validate-relative-ref, validate-absolute-uri):
Specific validators.
(build-uri-reference, build-relative-ref, build-absolute-uri):
New constructors.
(string->uri*): Add `validate' argument.
(string->uri, string->uri-reference, string->relative-ref):
(string->absolute-uri): Specific constructors.
* module/web/http.scm (parse-request-uri): Use `build-uri-reference',
and result is a URI-reference, not URI, object. No longer infer an
absent `uri-scheme' is `http'.
(write-uri): Do not display an absent `uri-scheme', however, do
display the scheme even when `uri-host' is absent. Add note to look
at using `uri->string'.
(declare-absolute-uri-header!): Update. Rename from
`declare-uri-header!'.
(declare-uri-reference-header!): Update. Rename from
`declare-relative-uri-header!'.
* test-suite/tests/web-uri.test ("build-uri-reference"):
("string->uri-reference"): Add.
("uri->string"): Also tests for relative-refs.
* test-suite/tests/web-http.test ("read-request-line"):
("write-request-line"): Update for no scheme in some URIs.
("entity headers", "request headers"): Content-location and referer
should also parse relative-URIs.
("response headers"): Location should not parse relative-URIs.
* test-suite/tests/web-request.test ("example-1"): Expect URI-reference
with no scheme.
---
doc/ref/web.texi | 8 --
module/web/http.scm | 47 ++++++-----
module/web/uri.scm | 158 ++++++++++++++++++++++++++++++++++---
test-suite/tests/web-http.test | 54 ++++++++-----
test-suite/tests/web-request.test | 5 +-
test-suite/tests/web-uri.test | 66 +++++++++++++++-
6 files changed, 275 insertions(+), 63 deletions(-)
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 0d41f9f..476151b 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -190,14 +190,6 @@ since passwords do not belong in URIs, the RFC does not want to condone
this practice, so it calls anything before the @code{@@} sign
@dfn{userinfo}.
-Properly speaking, a fragment is not part of a URI. For example, when a
-web browser follows a link to @indicateurl{http://example.com/#foo}, it
-sends a request for @indicateurl{http://example.com/}, then looks in the
-resulting page for the fragment identified @code{foo} reference. A
-fragment identifies a part of a resource, not the resource itself. But
-it is useful to have a fragment field in the URI record itself, so we
-hope you will forgive the inconsistency.
-
@example
(use-modules (web uri))
@end example
diff --git a/module/web/http.scm b/module/web/http.scm
index b5202b6..5c250d9 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1023,7 +1023,8 @@ symbol, like ‘GET’."
(define* (parse-request-uri str #:optional (start 0) (end (string-length str)))
"Parse a URI from an HTTP request line. Note that URIs in requests do
-not have to have a scheme or host name. The result is a URI object."
+not have to have a scheme or host name. The result is a URI-reference
+object."
(cond
((= start end)
(bad-request "Missing Request-URI"))
@@ -1033,10 +1034,10 @@ not have to have a scheme or host name. The result is a URI object."
(let* ((q (string-index str #\? start end))
(f (string-index str #\# start end))
(q (and q (or (not f) (< q f)) q)))
- (build-uri 'http
- #:path (substring str start (or q f end))
- #:query (and q (substring str (1+ q) (or f end)))
- #:fragment (and f (substring str (1+ f) end)))))
+ (build-uri-reference
+ #:path (substring str start (or q f end))
+ #:query (and q (substring str (1+ q) (or f end)))
+ #:fragment (and f (substring str (1+ f) end)))))
(else
(or (string->uri (substring str start end))
(bad-request "Invalid URI: ~a" (substring str start end))))))
@@ -1053,11 +1054,17 @@ three values: the method, the URI, and the version."
(parse-http-version line (1+ d1) (string-length line)))
(bad-request "Bad Request-Line: ~s" line))))
+;; FIXME: The validation here should be reconsidered and moved to
+;; individual header validators if they do not already covered. Then
+;; this procedure should be using uri->string.
(define (write-uri uri port)
- (if (uri-host uri)
+ (if (uri-scheme uri)
(begin
(display (uri-scheme uri) port)
- (display "://" port)
+ (display #\: port)))
+ (if (uri-host uri)
+ (begin
+ (display "//" port)
(if (uri-userinfo uri)
(begin
(display (uri-userinfo uri) port)
@@ -1171,20 +1178,22 @@ treated specially, and is just returned as a plain string."
(declare-header! name
parse-non-negative-integer non-negative-integer? display))
-;; emacs: (put 'declare-uri-header! 'scheme-indent-function 1)
-(define (declare-uri-header! name)
+;; emacs: (put 'declare-absolute-uri-header! 'scheme-indent-function 1)
+(define (declare-absolute-uri-header! name)
(declare-header! name
- (lambda (str) (or (string->uri str) (bad-header-component 'uri str)))
- (@@ (web uri) absolute-uri?)
+ (lambda (str)
+ (or (string->absolute-uri str)
+ (bad-header-component 'absolute-uri str)))
+ 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)
- (bad-header-component 'uri str)))
- uri?
+ (or (string->uri-reference str)
+ (bad-header-component 'uri-reference str)))
+ uri-reference?
write-uri))
;; emacs: (put 'declare-quality-list-header! 'scheme-indent-function 1)
@@ -1449,7 +1458,7 @@ treated specially, and is just returned as a plain string."
;; Content-Location = ( absoluteURI | relativeURI )
;;
-(declare-relative-uri-header! "Content-Location")
+(declare-uri-reference-header! "Content-Location")
;; Content-MD5 = <base64 of 128 bit MD5 digest as per RFC 1864>
;;
@@ -1752,7 +1761,7 @@ treated specially, and is just returned as a plain string."
;; Referer = ( absoluteURI | relativeURI )
;;
-(declare-relative-uri-header! "Referer")
+(declare-uri-reference-header! "Referer")
;; TE = #( t-codings )
;; t-codings = "trailers" | ( transfer-extension [ accept-params ] )
@@ -1789,7 +1798,7 @@ treated specially, and is just returned as a plain string."
;; Location = absoluteURI
;;
-(declare-uri-header! "Location")
+(declare-absolute-uri-header! "Location")
;; Proxy-Authenticate = 1#challenge
;;
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 7fe0100..8a8e1d9 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -40,11 +40,15 @@
string->uri uri->string
uri-decode uri-encode
split-and-decode-uri-path
- encode-and-join-uri-path))
+ encode-and-join-uri-path
+
+ uri-reference? relative-ref? absolute-uri?
+ build-uri-reference build-relative-ref build-absolute-uri
+ string->uri-reference string->relative-ref string->absolute-uri))
(define-record-type <uri>
(make-uri scheme userinfo host port path query fragment)
- uri?
+ uri-reference?
(scheme uri-scheme)
(userinfo uri-userinfo)
(host uri-host)
@@ -53,8 +57,51 @@
(query uri-query)
(fragment uri-fragment))
+;;;
+;;; Predicates.
+;;;
+;;; These are quick, and assume rigid validation at construction time.
+
+;;; RFC 3986, #3.
+;;;
+;;; URI = scheme ":" hier-part [ "?" query ] [ "#" fragment ]
+;;;
+;;; hier-part = "//" authority path-abempty
+;;; / path-absolute
+;;; / path-rootless
+;;; / path-empty
+
+(define (uri? obj)
+ (and (uri-reference? obj)
+ (uri-scheme obj)))
+
+;;; RFC 3986, #4.2.
+;;;
+;;; relative-ref = relative-part [ "?" query ] [ "#" fragment ]
+;;;
+;;; relative-part = "//" authority path-abempty
+;;; / path-absolute
+;;; / path-noscheme
+;;; / path-empty
+
+(define (relative-ref? obj)
+ (and (uri-reference? obj)
+ (not (uri-scheme obj))))
+
+;;; RFC 3986, #4.3.
+;;;
+;;; absolute-URI = scheme ":" hier-part [ "?" query ]
+
(define (absolute-uri? obj)
- (and (uri? obj) (uri-scheme obj) #t))
+ (and (uri-reference? obj)
+ (uri-scheme obj)
+ (not (uri-fragment obj))))
+
+\f
+;;;
+;;; Constructors.
+;;;
+;;; Disable validation at your own peril!
(define (uri-error message . args)
(throw 'uri-error message args))
@@ -62,9 +109,13 @@
(define (positive-exact-integer? port)
(and (number? port) (exact? port) (integer? port) (positive? port)))
-(define (validate-uri scheme userinfo host port path query fragment)
+(define* (validate-uri-reference scheme userinfo host port path query fragment
+ #:key scheme? no-scheme? no-fragment?
+ (relative-part? (not scheme)))
(cond
- ((not (symbol? scheme))
+ ((and scheme no-scheme?)
+ (uri-error "Expected no scheme: ~s" scheme))
+ ((and (or scheme? scheme) (not (symbol? scheme)))
(uri-error "Expected a symbol for the URI scheme: ~s" scheme))
((and (or userinfo port) (not host))
(uri-error "Expected a host, given userinfo or port"))
@@ -76,9 +127,45 @@
(uri-error "Expected string for userinfo: ~s" userinfo))
((not (string? path))
(uri-error "Expected string for path: ~s" path))
- ((and host (not (string-null? path))
- (not (eqv? (string-ref path 0) #\/)))
- (uri-error "Expected path of absolute URI to start with a /: ~a" path))))
+ ((and query (not (string? query)))
+ (uri-error "Expected string for query: ~s" query))
+ ((and fragment no-fragment?)
+ (uri-error "Expected no fragment: ~s" fragment))
+ ((and fragment (not (string? fragment)))
+ (uri-error "Expected string for fragment: ~s" fragment))
+ ;; Strict validation of allowed paths, based on other components.
+ ;; Refer to RFC 3986 for the details.
+ ((not (string-null? path))
+ (if host
+ (cond
+ ((not (eqv? (string-ref path 0) #\/))
+ (uri-error
+ "Expected absolute path starting with \"/\": ~a" path)))
+ (cond
+ ((string-prefix? "//" path)
+ (uri-error
+ "Expected path not starting with \"//\" (no host): ~a" path))
+ ((and relative-part?
+ (not (eqv? (string-ref path 0) #\/))
+ (let ((colon (string-index path #\:)))
+ (and colon (not (string-index path #\/ 0 colon)))))
+ (uri-error
+ "Expected relative path's first segment without \":\": ~a"
+ path)))))))
+
+(define (validate-uri scheme userinfo host port path query fragment)
+ (validate-uri-reference scheme userinfo host port path query fragment
+ #:scheme? #t))
+
+(define (validate-relative-ref scheme userinfo host port path query fragment)
+ (validate-uri-reference scheme userinfo host port path query fragment
+ #:no-scheme? #t
+ #:relative-part? #t))
+
+(define (validate-absolute-uri scheme userinfo host port path query fragment)
+ (validate-uri-reference scheme userinfo host port path query fragment
+ #:scheme? #t
+ #:no-fragment? #t))
(define* (build-uri scheme #:key userinfo host port (path "") query fragment
(validate? #t))
@@ -91,6 +178,38 @@ is valid."
(validate-uri scheme userinfo host port path query fragment))
(make-uri scheme userinfo host port path query fragment))
+(define* (build-uri-reference #:key scheme userinfo host port
+ (path "") query fragment
+ (validate? #t))
+ "Construct a URI-reference object. Fields are the same as for
+‘build-uri’ except that SCHEME may also be ‘#f’."
+ (if validate?
+ (validate-uri-reference scheme userinfo host port path query fragment))
+ (make-uri scheme userinfo host port path query fragment))
+
+(define* (build-relative-ref #:key userinfo host port
+ (path "") query fragment
+ (validate? #t))
+ "Construct an absolute-URI object. Fields are the same as for
+‘build-uri’ except there is no scheme."
+ (if validate?
+ (validate-relative-ref #f userinfo host port path query fragment))
+ (make-uri #f userinfo host port path query fragment))
+
+(define* (build-absolute-uri #:key scheme userinfo host port
+ (path "") query
+ (validate? #t))
+ "Construct an absolute-URI object. Fields are the same as for
+‘build-uri’ except there is no fragment."
+ (if validate?
+ (validate-absolute-uri scheme userinfo host port path query #f))
+ (make-uri scheme userinfo host port path query #f))
+
+\f
+;;;
+;;; Converters.
+;;;
+
;; See RFC 3986 #3.2.2 for comments on percent-encodings, IDNA (RFC
;; 3490), and non-ASCII host names.
;;
@@ -173,9 +292,7 @@ is valid."
(define uri-regexp
(make-regexp uri-pat))
-(define (string->uri* string)
- "Parse STRING into a URI object. Return ‘#f’ if the string
-could not be parsed."
+(define (string->uri* string validate)
(% (let ((m (regexp-exec uri-regexp string)))
(if (not m) (abort))
(let ((scheme (let ((str (match:substring m 2)))
@@ -190,6 +307,7 @@ could not be parsed."
(parse-authority authority abort)
(values #f #f #f)))
(lambda (userinfo host port)
+ (validate scheme userinfo host port path query fragment)
(make-uri scheme userinfo host port path query fragment)))))
(lambda (k)
#f)))
@@ -197,8 +315,22 @@ could not be parsed."
(define (string->uri string)
"Parse STRING into a URI object. Return ‘#f’ if the string
could not be parsed."
- (let ((uri (string->uri* string)))
- (and uri (uri-scheme uri) uri)))
+ (string->uri* string validate-uri))
+
+(define (string->uri-reference string)
+ "Parse STRING into a URI-reference object. Return ‘#f’ if the string
+could not be parsed."
+ (string->uri* string validate-uri-reference))
+
+(define (string->relative-ref string)
+ "Parse STRING into a relative-ref object. Return ‘#f’ if the string
+could not be parsed."
+ (string->uri* string validate-relative-ref))
+
+(define (string->absolute-uri string)
+ "Parse STRING into an absolute-URI object. Return ‘#f’ if the string
+could not be parsed."
+ (string->uri* string validate-absolute-uri))
(define *default-ports* (make-hash-table))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 2913724..b836926 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -132,32 +132,33 @@
(with-test-prefix "read-request-line"
(pass-if-read-request-line "GET / HTTP/1.1"
GET
- (build-uri 'http
- #:path "/")
+ (build-uri-reference
+ #:path "/")
(1 . 1))
(pass-if-read-request-line "GET http://www.w3.org/pub/WWW/TheProject.html HTTP/1.1"
GET
- (build-uri 'http
- #:host "www.w3.org"
- #:path "/pub/WWW/TheProject.html")
+ (build-uri-reference
+ #:scheme 'http
+ #:host "www.w3.org"
+ #:path "/pub/WWW/TheProject.html")
(1 . 1))
(pass-if-read-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
GET
- (build-uri 'http
- #:path "/pub/WWW/TheProject.html")
+ (build-uri-reference
+ #:path "/pub/WWW/TheProject.html")
(1 . 1))
(pass-if-read-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
HEAD
- (build-uri 'http
- #:path "/etc/hosts"
- #:query "foo=bar")
+ (build-uri-reference
+ #:path "/etc/hosts"
+ #:query "foo=bar")
(1 . 1)))
(with-test-prefix "write-request-line"
(pass-if-write-request-line "GET / HTTP/1.1"
GET
- (build-uri 'http
- #:path "/")
+ (build-uri-reference
+ #:path "/")
(1 . 1))
;;; FIXME: Test fails due to scheme, host always being removed.
;;; However, it should be supported to request these be present, and
@@ -170,14 +171,14 @@
;; (1 . 1))
(pass-if-write-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
GET
- (build-uri 'http
- #:path "/pub/WWW/TheProject.html")
+ (build-uri-reference
+ #:path "/pub/WWW/TheProject.html")
(1 . 1))
(pass-if-write-request-line "HEAD /etc/hosts?foo=bar HTTP/1.1"
HEAD
- (build-uri 'http
- #:path "/etc/hosts"
- #:query "foo=bar")
+ (build-uri-reference
+ #:path "/etc/hosts"
+ #:query "foo=bar")
(1 . 1)))
(with-test-prefix "read-response-line"
@@ -252,6 +253,12 @@
(pass-if-parse content-length "010" 10)
(pass-if-parse content-location "http://foo/"
(build-uri 'http #:host "foo" #:path "/"))
+ (pass-if-parse content-location "//foo/"
+ (build-uri-reference #:host "foo" #:path "/"))
+ (pass-if-parse content-location "/etc/foo"
+ (build-uri-reference #:path "/etc/foo"))
+ (pass-if-parse content-location "foo"
+ (build-uri-reference #:path "foo"))
(pass-if-parse content-range "bytes 10-20/*" '(bytes (10 . 20) *))
(pass-if-parse content-range "bytes */*" '(bytes * *))
(pass-if-parse content-range "bytes */30" '(bytes * 30))
@@ -319,6 +326,14 @@
(pass-if-parse range "bytes=-20,-30" '(bytes (#f . 20) (#f . 30)))
(pass-if-parse referer "http://foo/bar?baz"
(build-uri 'http #:host "foo" #:path "/bar" #:query "baz"))
+ (pass-if-parse referer "//foo/bar?baz"
+ (build-uri-reference #:host "foo"
+ #:path "/bar"
+ #:query "baz"))
+ (pass-if-parse referer "/etc/foo"
+ (build-uri-reference #:path "/etc/foo"))
+ (pass-if-parse referer "foo"
+ (build-uri-reference #:path "foo"))
(pass-if-parse te "trailers" '((trailers)))
(pass-if-parse te "trailers,foo" '((trailers) (foo)))
(pass-if-parse user-agent "guile" "guile"))
@@ -333,6 +348,9 @@
(pass-if-parse etag "W/\"foo\"" '("foo" . #f))
(pass-if-parse location "http://other-place"
(build-uri 'http #:host "other-place"))
+ (pass-if-any-error location "//other-place")
+ (pass-if-any-error location "/etc/foo")
+ (pass-if-any-error location "foo")
(pass-if-parse proxy-authenticate "Basic realm=\"guile\""
'((basic (realm . "guile"))))
(pass-if-parse retry-after "Tue, 15 Nov 1994 08:12:31 GMT"
diff --git a/test-suite/tests/web-request.test b/test-suite/tests/web-request.test
index 8cf1c2e..68721d3 100644
--- a/test-suite/tests/web-request.test
+++ b/test-suite/tests/web-request.test
@@ -1,6 +1,6 @@
;;;; web-request.test --- HTTP requests -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -53,7 +53,8 @@ Accept-Language: en-gb, en;q=0.9\r
(pass-if (equal? (request-method r) 'GET))
- (pass-if (equal? (request-uri r) (build-uri 'http #:path "/qux")))
+ (pass-if (equal? (request-uri r)
+ (build-uri-reference #:path "/qux")))
(pass-if (equal? (read-request-body r) #f))
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 3f6e7e3..21d8044 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -27,7 +27,7 @@
(define* (uri=? uri #:key scheme userinfo host port path query fragment)
- (and (uri? uri)
+ (and (uri-reference? uri)
(equal? (uri-scheme uri) scheme)
(equal? (uri-userinfo uri) userinfo)
(equal? (uri-host uri) host)
@@ -123,6 +123,22 @@
"Expected.*host"
(build-uri 'http #:userinfo "foo")))
+(with-test-prefix "build-uri-reference"
+ (pass-if "//host/etc/foo"
+ (uri=? (build-uri-reference #:host "host"
+ #:path "/etc/foo")
+ #:host "host"
+ #:path "/etc/foo"))
+
+ (pass-if "/path/to/some/foo?query"
+ (uri=? (build-uri-reference #:path "/path/to/some/foo"
+ #:query "query")
+ #:path "/path/to/some/foo"
+ #:query "query"))
+
+ (pass-if "nextdoc/foo"
+ (uri=? (build-uri-reference #:path "nextdoc/foo")
+ #:path "nextdoc/foo")))
(with-test-prefix "string->uri"
(pass-if "ftp:"
@@ -212,6 +228,30 @@
#:scheme 'file
#:path "/etc/hosts")))
+(with-test-prefix "string->uri-reference"
+ (pass-if "/"
+ (uri=? (string->uri-reference "/")
+ #:path "/"))
+
+ (pass-if "/path/to/foo"
+ (uri=? (string->uri-reference "/path/to/foo")
+ #:path "/path/to/foo"))
+
+ (pass-if "//example.org"
+ (uri=? (string->uri-reference "//example.org")
+ #:host "example.org"
+ #:path ""))
+
+ (pass-if "//bar@example.org/path/to/foo"
+ (uri=? (string->uri-reference "//bar@example.org/path/to/foo")
+ #:userinfo "bar"
+ #:host "example.org"
+ #:path "/path/to/foo"))
+
+ (pass-if "nextdoc/foo"
+ (uri=? (string->uri-reference "nextdoc/foo")
+ #:path "nextdoc/foo")))
+
(with-test-prefix "uri->string"
(pass-if "ftp:"
(equal? "ftp:"
@@ -248,7 +288,27 @@
(pass-if "http://foo:/"
(equal? "http://foo/"
- (uri->string (string->uri "http://foo:/")))))
+ (uri->string (string->uri "http://foo:/"))))
+
+ (pass-if "/"
+ (equal? "/"
+ (uri->string (string->uri-reference "/"))))
+
+ (pass-if "/path/to/foo"
+ (equal? "/path/to/foo"
+ (uri->string (string->uri-reference "/path/to/foo"))))
+
+ (pass-if "//example.org"
+ (equal? "//example.org"
+ (uri->string (string->uri-reference "//example.org"))))
+
+ (pass-if "//bar@example.org/path/to/foo"
+ (equal? "//bar@example.org/path/to/foo"
+ (uri->string (string->uri-reference "//bar@example.org/path/to/foo"))))
+
+ (pass-if "nextdoc/foo"
+ (equal? "nextdoc/foo"
+ (uri->string (string->uri-reference "nextdoc/foo")))))
(with-test-prefix "decode"
(pass-if "foo%20bar"
--
1.7.10.4
next prev parent reply other threads:[~2013-03-16 14:25 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <CAN3veRcJ4EMJ53vWSRG0HXfwdXbhUmdvUu8EuLfVV7abjZEt1Q@mail.gmail.com>
2013-02-24 10:45 ` bug#12827: [PATCH] Tweak web modules, support relative URIs Mark H Weaver
[not found] ` <87vc9i6ld2.fsf@tines.lan>
2013-02-24 12:31 ` Daniel Hartwig
2013-02-24 19:55 ` Mark H Weaver
2013-03-13 11:05 ` Andy Wingo
2013-03-16 14:25 ` Daniel Hartwig [this message]
2013-03-20 10:20 ` Andy Wingo
2016-06-20 19:52 ` Andy Wingo
2016-06-21 13:22 ` Ludovic Courtès
2017-05-21 12:05 ` Andy Wingo
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to='CAN3veRcCsRm8DX8awJtzoMeT96=NPNzLQqeb9D-ZryuDLyusFw@mail.gmail.com' \
--to=mandyke@gmail.com \
--cc=12827@debbugs.gnu.org \
--cc=ludo@gnu.org \
--cc=wingo@pobox.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).