bug#12827: [PATCH] Tweak web modules, support relative URIs (was: bug#12827: [2.0.6] web client: fails to parse 404 header)

[Daniel Hartwig <mandyke@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 3250 bytes --]

On 24 November 2012 23:34, Daniel Hartwig <mandyke@gmail.com> wrote:
> The API seems less clean, and it is not immediately clear
> that uri? is not the top of the URI-like type hierarchy.  The other
> functions only indicate “uri” in their name.  I did not
> wish to introduce parallel “build-uri-reference”, etc. for each of
> these, and did consider adding #:reference? on some to select
> weaker validation.
>
> I think I prefer to keep the base type predicate as uri?, and use
> relative-ref? and absolute-uri? to distinguish.  This would mean
> deviating from the RFC by:
> - permitting fragments in absolute-uri?;
> - not requiring a scheme in uri?;
>
> which are both forgivable.
>
> Maybe I am just too fussy!

Hello now

Revisting this old thread, I have complete the bulk of the work now.
Attached are a few patches to generally clean up the web modules a
bit, followed by a larger one introducing the promised relative URI
support.

* Terminology

The terminology used in latest URI spec. (RFC 3986) is not widely used
elsewhere.  Not by Guile, not by the HTTP spec., or other sources.
Specifically, it defines these terms:

- URI: scheme rest ... [fragment]
- Absolute-URI: scheme rest ... [fragment]
- Relative-Ref: rest ... [fragment]
- URI-Reference: Absolute-URI | Relative-Ref

where as HTTP and other sources use the terms from an earlier URI
spec. (RFC 2396):

- Absolute-URI: scheme rest ... [fragment]
- Relative-URI: rest ... [fragment]
- URI, URI-Reference: Absolute-URI | Relative-URI

With this patch I have opted to use the later, more common terms.
This has the advantage of not requiring massive renaming or
duplicating of most procedures to include, e.g.
‘uri-reference-scheme’, as we just use the term ‘uri’ to refer to
either type.

If this is undesired, it can easily be reworked to use the terminology
from RFC 3986.

* API compatability

Presently, all APIs work only with absolute URIs.  You can not use
string->uri or build-uri to produce any relative URIs, neither are
other procedures (generally) expected to work correctly if given them.

What we have in this patch is that <uri> grows to encompass both
relative and absolute URIs.  ‘uri?’ is a general type predicate,
‘build-uri’ will produce and validate either type, and there are pairs
of converters and predicates to distinguish between relative and
absolute.

Effectively, a pseudo-type heirarchy, with uri? at the top and
absolute-uri? and relative-uri? beneath it.

* To be done

Barely touched request, response, client, or server modules.  Though
these will continue to work with current usage patterns and I have
added some notes about future work.

Also, I believe it will pay to extend http-get et. al to accept a
relative URI with separate Host header or keyword option.  Also allow
write-request-line to display exactly the URI passed to it, rather
than always chopping off the scheme and host (e.g. the HTTP spec.
allows such lines and they are require to write some types of proxy
software).

Coming along soon is a procedure to resolve a relative URI against a
base, absolute URI.  The same algorithm documented in the RFC.


Regards

[-- Attachment #2: 0001-minor-tweaks-to-web-documentation.patch --]
[-- Type: application/octet-stream, Size: 17969 bytes --]

From a25a817be56821d2656da43bcbae4f2a816a801f Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sat, 23 Feb 2013 13:39:14 +0800
Subject: [PATCH 1/4] minor tweaks to web documentation

* doc/ref/web.texi: Say `World Wide Web'; the hyphenated form is almost
  never used (c.f. w3.org).

  General predicate arguments are named `obj'.  Fill in arguments
  omitted from some procedure definitions (e.g. request-method).

  Minor tweaks, such as using en-dash and missing markup as appropriate.
  Wrap very long deffn lines.

  (HTTP): `parse-header' and `write-header' use `sym' to be consistent
  with other procedures and docstrings.

* module/web/*.scm: Expand texinfo markup in docstrings.  Synchronize
  with changes in web.texi.
---
 doc/ref/web.texi        |   89 +++++++++++++++++++++++++++--------------------
 module/web/client.scm   |    6 ++--
 module/web/http.scm     |    6 ++--
 module/web/response.scm |    6 ++--
 module/web/uri.scm      |   28 +++++++--------
 5 files changed, 73 insertions(+), 62 deletions(-)

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 6c33f32..82ef31b 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -10,7 +10,7 @@
 @cindex HTTP
 
 It has always been possible to connect computers together and share
-information between them, but the rise of the World-Wide Web over the
+information between them, but the rise of the World Wide Web over the
 last couple of decades has made it much easier to do so.  The result is
 a richly connected network of computation, in which Guile forms a part.
 
@@ -206,9 +206,10 @@ The following procedures can be found in the @code{(web uri)}
 module. Load it into your Guile, using a form like the above, to have
 access to them.
 
-@deffn {Scheme Procedure} build-uri scheme [#:userinfo=@code{#f}] [#:host=@code{#f}] @
-       [#:port=@code{#f}] [#:path=@code{""}] [#:query=@code{#f}] @
-       [#:fragment=@code{#f}] [#:validate?=@code{#t}]
+@deffn {Scheme Procedure} build-uri scheme @
+       [#:userinfo=@code{#f}] [#:host=@code{#f}] [#:port=@code{#f}] @
+       [#:path=@code{""}] [#:query=@code{#f}] [#:fragment=@code{#f}] @
+       [#:validate?=@code{#t}]
 Construct a URI object.  @var{scheme} should be a symbol, @var{port}
 either a positive, exact integer or @code{#f}, and the rest of the
 fields are either strings or @code{#f}.  If @var{validate?} is true,
@@ -216,7 +217,7 @@ also run some consistency checks to make sure that the constructed URI
 is valid.
 @end deffn
 
-@deffn {Scheme Procedure} uri? x
+@deffn {Scheme Procedure} uri? obj
 @deffnx {Scheme Procedure} uri-scheme uri
 @deffnx {Scheme Procedure} uri-userinfo uri
 @deffnx {Scheme Procedure} uri-host uri
@@ -249,9 +250,9 @@ Percent-decode the given @var{str}, according to @var{encoding}, which
 should be the name of a character encoding.
 
 Note that this function should not generally be applied to a full URI
-string. For paths, use split-and-decode-uri-path instead. For query
-strings, split the query on @code{&} and @code{=} boundaries, and decode
-the components separately.
+string. For paths, use @code{split-and-decode-uri-path} instead. For
+query strings, split the query on @code{&} and @code{=} boundaries, and
+decode the components separately.
 
 Note also that percent-encoded strings encode @emph{bytes}, not
 characters.  There is no guarantee that a given byte sequence is a valid
@@ -378,7 +379,8 @@ For more on the set of headers that Guile knows about out of the box,
 @pxref{HTTP Headers}.  To add your own, use the @code{declare-header!}
 procedure:
 
-@deffn {Scheme Procedure} declare-header! name parser validator writer [#:multiple?=@code{#f}]
+@deffn {Scheme Procedure} declare-header! name parser validator writer @
+       [#:multiple?=@code{#f}]
 Declare a parser, validator, and writer for a given header.
 @end deffn
 
@@ -421,12 +423,12 @@ Returns the end-of-file object for both values if the end of the message
 body was reached (i.e., a blank line).
 @end deffn
 
-@deffn {Scheme Procedure} parse-header name val
+@deffn {Scheme Procedure} parse-header sym val
 Parse @var{val}, a string, with the parser for the header named
-@var{name}.  Returns the parsed value.
+@var{sym}.  Returns the parsed value.
 @end deffn
 
-@deffn {Scheme Procedure} write-header name val port
+@deffn {Scheme Procedure} write-header sym val port
 Write the given header name and value to @var{port}, using the writer
 from @code{header-writer}.
 @end deffn
@@ -450,7 +452,7 @@ like @code{GET}.
 @end deffn
 
 @deffn {Scheme Procedure} parse-http-version str [start] [end]
-Parse an HTTP version from @var{str}, returning it as a major-minor
+Parse an HTTP version from @var{str}, returning it as a major--minor
 pair. For example, @code{HTTP/1.1} parses as the pair of integers,
 @code{(1 . 1)}.
 @end deffn
@@ -471,7 +473,7 @@ Write the first line of an HTTP request to @var{port}.
 
 @deffn {Scheme Procedure} read-response-line port
 Read the first line of an HTTP response from @var{port}, returning three
-values: the HTTP version, the response code, and the "reason phrase".
+values: the HTTP version, the response code, and the ``reason phrase''.
 @end deffn
 
 @deffn {Scheme Procedure} write-response-line version code reason-phrase port
@@ -1130,13 +1132,13 @@ any loss of generality.
 
 @subsubsection Request API
 
-@deffn {Scheme Procedure} request? 
-@deffnx {Scheme Procedure} request-method 
-@deffnx {Scheme Procedure} request-uri 
-@deffnx {Scheme Procedure} request-version 
-@deffnx {Scheme Procedure} request-headers 
-@deffnx {Scheme Procedure} request-meta 
-@deffnx {Scheme Procedure} request-port 
+@deffn {Scheme Procedure} request? obj
+@deffnx {Scheme Procedure} request-method request
+@deffnx {Scheme Procedure} request-uri request
+@deffnx {Scheme Procedure} request-version request
+@deffnx {Scheme Procedure} request-headers request
+@deffnx {Scheme Procedure} request-meta request
+@deffnx {Scheme Procedure} request-port request
 A predicate and field accessors for the request type.  The fields are as
 follows:
 @table @code
@@ -1170,7 +1172,9 @@ request, you may read the body separately, and likewise for writing
 requests.
 @end deffn
 
-@deffn {Scheme Procedure} build-request uri [#:method='GET] [#:version='(1 . 1)] [#:headers='()] [#:port=#f] [#:meta='()] [#:validate-headers?=#t]
+@deffn {Scheme Procedure} build-request uri [#:method='GET] @
+       [#:version='(1 . 1)] [#:headers='()] [#:port=#f] [#:meta='()] @
+       [#:validate-headers?=#t]
 Construct an HTTP request object. If @var{validate-headers?} is true,
 the headers are each run through their respective validators.
 @end deffn
@@ -1237,7 +1241,8 @@ more information on the format of parsed headers.
 Return the given request header, or @var{default} if none was present.
 @end deffn
 
-@deffn {Scheme Procedure} request-absolute-uri r [default-host=#f] [default-port=#f]
+@deffn {Scheme Procedure} request-absolute-uri r @
+       [default-host=#f] [default-port=#f]
 A helper routine to determine the absolute URI of a request, using the
 @code{host} header and the default host and port.
 @end deffn
@@ -1253,12 +1258,12 @@ A helper routine to determine the absolute URI of a request, using the
 As with requests (@pxref{Requests}), Guile offers a data type for HTTP
 responses.  Again, the body is represented separately from the request.
 
-@deffn {Scheme Procedure} response? 
-@deffnx {Scheme Procedure} response-version 
-@deffnx {Scheme Procedure} response-code 
+@deffn {Scheme Procedure} response? obj
+@deffnx {Scheme Procedure} response-version response
+@deffnx {Scheme Procedure} response-code response
 @deffnx {Scheme Procedure} response-reason-phrase response
-@deffnx {Scheme Procedure} response-headers 
-@deffnx {Scheme Procedure} response-port 
+@deffnx {Scheme Procedure} response-headers response
+@deffnx {Scheme Procedure} response-port response
 A predicate and field accessors for the response type.  The fields are as
 follows:
 @table @code
@@ -1284,7 +1289,9 @@ As a side effect, sets the encoding on @var{port} to ISO-8859-1
 discussion of character sets in @ref{Responses}, for more information.
 @end deffn
 
-@deffn {Scheme Procedure} build-response [#:version='(1 . 1)] [#:code=200] [#:reason-phrase=#f] [#:headers='()] [#:port=#f] [#:validate-headers?=#t]
+@deffn {Scheme Procedure} build-response [#:version='(1 . 1)] @
+       [#:code=200] [#:reason-phrase=#f] [#:headers='()] [#:port=#f] @
+       [#:validate-headers?=#t]
 Construct an HTTP response object. If @var{validate-headers?} is true,
 the headers are each run through their respective validators.
 @end deffn
@@ -1384,6 +1391,10 @@ Return @code{#t} if @var{type}, a symbol as returned by
 @code{(web client)} provides a simple, synchronous HTTP client, built on
 the lower-level HTTP, request, and response modules.
 
+@example
+(use-modules (web client))
+@end example
+
 @deffn {Scheme Procedure} open-socket-for-uri uri
 Return an open input/output port for a connection to URI.
 @end deffn
@@ -1419,9 +1430,9 @@ If you already have a port open, pass it as @var{port}.  Otherwise, a
 connection will be opened to the server corresponding to @var{uri}.  Any
 extra headers in the alist @var{headers} will be added to the request.
 
-If @var{body} is not #f, a message body will also be sent with the HTTP
-request.  If @var{body} is a string, it is encoded according to the
-content-type in @var{headers}, defaulting to UTF-8.  Otherwise
+If @var{body} is not @code{#f}, a message body will also be sent with
+the HTTP request.  If @var{body} is a string, it is encoded according to
+the content-type in @var{headers}, defaulting to UTF-8.  Otherwise
 @var{body} should be a bytevector, or @code{#f} for no body.  Although a
 message body may be sent with any request, usually only @code{POST} and
 @code{PUT} requests have bodies.
@@ -1480,8 +1491,8 @@ The life cycle of a server goes as follows:
 
 @enumerate
 @item
-The @code{open} hook is called, to open the server. @code{open} takes 0 or
-more arguments, depending on the backend, and returns an opaque
+The @code{open} hook is called, to open the server. @code{open} takes
+zero or more arguments, depending on the backend, and returns an opaque
 server socket object, or signals an error.
 
 @item
@@ -1578,8 +1589,8 @@ in, allowing the user's handler to explicitly manage its state.
 @end deffn
 
 @deffn {Scheme Procedure} sanitize-response request response body
-"Sanitize" the given response and body, making them appropriate for the
-given request.
+``Sanitize'' the given response and body, making them appropriate for
+the given request.
 
 As a convenience to web handler authors, @var{response} may be given as
 an alist of headers, in which case it is used to construct a default
@@ -1615,7 +1626,8 @@ and body, and write the response to the client.  Return the new state
 produced by the handler procedure.
 @end deffn
 
-@deffn {Scheme Procedure} run-server handler [impl='http] [open-params='()] . state
+@deffn {Scheme Procedure} run-server handler [impl='http] @
+       [open-params='()] . state
 Run Guile's built-in web server.
 
 @var{handler} should be a procedure that takes two or more arguments,
@@ -1636,7 +1648,8 @@ explicitly manage its state.
 The default web server implementation is @code{http}, which binds to a
 socket, listening for request on that port.
 
-@deffn {HTTP Implementation} http [#:host=#f] [#:family=AF_INET] [#:addr=INADDR_LOOPBACK] [#:port 8080] [#:socket]
+@deffn {HTTP Implementation} http [#:host=#f] [#:family=AF_INET] @
+       [#:addr=INADDR_LOOPBACK] [#:port 8080] [#:socket]
 The default HTTP implementation.  We document it as a function with
 keyword arguments, because that is precisely the way that it is -- all
 of the @var{open-params} to @code{run-server} get passed to the
diff --git a/module/web/client.scm b/module/web/client.scm
index 9fbb25b..7d5ea49 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -248,10 +248,10 @@ pass it as PORT.  The port will be closed at the end of the
 request unless KEEP-ALIVE? is true.  Any extra headers in the
 alist HEADERS will be added to the request.
 
-If BODY is not #f, a message body will also be sent with the HTTP
+If BODY is not ‘#f’, a message body will also be sent with the HTTP
 request.  If BODY is a string, it is encoded according to the
 content-type in HEADERS, defaulting to UTF-8.  Otherwise BODY should be
-a bytevector, or #f for no body.  Although it's allowed to send a
+a bytevector, or ‘#f’ for no body.  Although it's allowed to send a
 message body along with any request, usually only POST and PUT requests
 have bodies.  See ‘http-put’ and ‘http-post’ documentation, for more.
 
@@ -317,7 +317,7 @@ This function is similar to ‘http-get’, except it uses the \"HEAD\"
 method.  See ‘http-get’ for full documentation on the various keyword
 arguments that are accepted by this function.
 
-Returns two values: the resulting response, and #f.  Responses to HEAD
+Returns two values: the resulting response, and ‘#f’.  Responses to HEAD
 requests do not have a body.  The second value is only returned so that
 other procedures can treat all of the http-foo verbs identically.")
 
diff --git a/module/web/http.scm b/module/web/http.scm
index c79d57d..712208b 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -167,7 +167,7 @@ The default writer is ‘display’."
 (define *eof* (call-with-input-string "" read))
 
 (define (read-header port)
-  "Reads one HTTP header from PORT. Returns two values: the header
+  "Read one HTTP header from PORT. Return two values: the header
 name and the parsed Scheme value. May raise an exception if the header
 was known but the value was invalid.
 
@@ -220,7 +220,7 @@ as an ordered alist."
 
 (define (write-headers headers port)
   "Write the given header alist to PORT.  Doesn't write the final
-@samp{\\r\\n}, as the user might want to add another header."
+‘\\r\\n’, as the user might want to add another header."
   (let lp ((headers headers))
     (if (pair? headers)
         (begin
@@ -971,7 +971,7 @@ as an ordered alist."
 (define *known-versions* '())
 
 (define* (parse-http-version str #:optional (start 0) (end (string-length str)))
-  "Parse an HTTP version from STR, returning it as a major-minor
+  "Parse an HTTP version from STR, returning it as a major–minor
 pair. For example, ‘HTTP/1.1’ parses as the pair of integers,
 ‘(1 . 1)’."
   (or (let lp ((known *known-versions*))
diff --git a/module/web/response.scm b/module/web/response.scm
index 7e14f4d..de38abc 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -267,10 +267,10 @@ closes PORT, unless KEEP-ALIVE? is true."
 (define* (response-body-port r #:key (decode? #t) (keep-alive? #t))
   "Return an input port from which the body of R can be read.  The
 encoding of the returned port is set according to R's ‘content-type’
-header, when it's textual, except if DECODE? is #f.  Return #f when no
-body is available.
+header, when it's textual, except if DECODE? is ‘#f’.  Return ‘#f’ when
+no body is available.
 
-When KEEP-ALIVE? is #f, closing the returned port also closes R's
+When KEEP-ALIVE? is ‘#f’, closing the returned port also closes R's
 response port."
   (define port
     (if (member '(chunked) (response-transfer-encoding r))
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 25406b3..33db1d1 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -53,8 +53,8 @@
   (query uri-query)
   (fragment uri-fragment))
 
-(define (absolute-uri? x)
-  (and (uri? x) (uri-scheme x) #t))
+(define (absolute-uri? obj)
+  (and (uri? obj) (uri-scheme obj) #t))
 
 (define (uri-error message . args)
   (throw 'uri-error message args))
@@ -309,17 +309,16 @@ serialization."
 which should be the name of a character encoding.
 
 Note that this function should not generally be applied to a full URI
-string. For paths, use split-and-decode-uri-path instead. For query
+string. For paths, use ‘split-and-decode-uri-path’ instead. For query
 strings, split the query on ‘&’ and ‘=’ boundaries, and decode
 the components separately.
 
-Note also that percent-encoded strings encode @emph{bytes}, not
-characters.  There is no guarantee that a given byte sequence is a valid
-string encoding. Therefore this routine may signal an error if the
-decoded bytes are not valid for the given encoding. Pass ‘#f’ for
-ENCODING if you want decoded bytes as a bytevector directly.
-@xref{Ports, ‘set-port-encoding!’}, for more information on
-character encodings.
+Note also that percent-encoded strings encode _bytes_, not characters.
+There is no guarantee that a given byte sequence is a valid string
+encoding. Therefore this routine may signal an error if the decoded
+bytes are not valid for the given encoding. Pass ‘#f’ for ENCODING if
+you want decoded bytes as a bytevector directly.  See
+‘set-port-encoding!’ for more information on character encodings.
 
 Returns a string of the decoded characters, or a bytevector if
 ENCODING was ‘#f’."
@@ -380,11 +379,10 @@ ENCODING was ‘#f’."
 UNESCAPED-CHARS.
 
 The default character set includes alphanumerics from ASCII, as well as
-the special characters @samp{-}, @samp{.}, @samp{_}, and @samp{~}.  Any
-other character will be percent-encoded, by writing out the character to
-a bytevector within the given ENCODING, then encoding each byte as
-‘%HH’, where HH is the hexadecimal representation of
-the byte."
+the special characters ‘-’, ‘.’, ‘_’, and ‘~’.  Any other character will
+be percent-encoded, by writing out the character to a bytevector within
+the given ENCODING, then encoding each byte as ‘%HH’, where HH is the
+hexadecimal representation of the byte."
   (define (needs-escaped? ch)
     (not (char-set-contains? unescaped-chars ch)))
   (if (string-index str needs-escaped?)
-- 
1.7.10.4


[-- Attachment #3: 0002-web-public-access-to-default-port-information.patch --]
[-- Type: application/octet-stream, Size: 3078 bytes --]

From c5b77b2735f688182846c9955eaf451f49d71bef Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sat, 23 Feb 2013 13:51:50 +0800
Subject: [PATCH 2/4] web: public access to default-port information

* module/web/uri.scm (default-port): New procedure.
  (default-port?): Export.  Add docstring.

* module/web/http.scm (write-uri): Use `default-port?'.

* doc/ref/web.texi (Universal Resouce Identifiers): Document.
---
 doc/ref/web.texi    |   11 +++++++++++
 module/web/http.scm |    2 +-
 module/web/uri.scm  |   12 ++++++++++--
 3 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 82ef31b..963ae3f 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -245,6 +245,17 @@ serialization.
 Declare a default port for the given URI scheme.
 @end deffn
 
+@deffn {Scheme Procedure} default-port scheme
+Return the default port for @var{scheme} if one has been declared,
+otherwise @code{#f}.
+@end deffn
+
+@deffn {Scheme Procedure} default-port? scheme port
+Return @code{#t} when @var{port} @emph{matches} the default port for
+@var{scheme}.  Note that @var{port} may be @code{#f}, which implies a
+match and consequent return value of @code{#t}.
+@end deffn
+
 @deffn {Scheme Procedure} uri-decode str [#:encoding=@code{"utf-8"}]
 Percent-decode the given @var{str}, according to @var{encoding}, which
 should be the name of a character encoding.
diff --git a/module/web/http.scm b/module/web/http.scm
index 712208b..5671330 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1064,7 +1064,7 @@ three values: the method, the URI, and the version."
               (display #\@ port)))
         (display (uri-host uri) port)
         (let ((p (uri-port uri)))
-          (if (and p (not (eqv? p 80)))
+          (if (not (default-port? (uri-scheme uri) p))
               (begin
                 (display #\: port)
                 (display p port))))))
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 33db1d1..2e8c4a6 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -36,7 +36,7 @@
             uri-path uri-query uri-fragment
 
             build-uri
-            declare-default-port!
+            declare-default-port! default-port default-port?
             string->uri uri->string
             uri-decode uri-encode
             split-and-decode-uri-path
@@ -206,9 +206,17 @@ could not be parsed."
   "Declare a default port for the given URI scheme."
   (hashq-set! *default-ports* scheme port))
 
+(define (default-port scheme)
+  "Return the default port for SCHEME if one has been declared,
+otherwise ‘#f’."
+  (hashq-ref *default-ports* scheme))
+
 (define (default-port? scheme port)
+  "Return ‘#t’ when PORT _matches_ the default port for SCHEME.  Note
+that PORT may be ‘#f’, which implies a match and consequent return value
+of ‘#t’."
   (or (not port)
-      (eqv? port (hashq-ref *default-ports* scheme))))
+      (eqv? port (default-port scheme))))
 
 (declare-default-port! 'http 80)
 (declare-default-port! 'https 443)
-- 
1.7.10.4


[-- Attachment #4: 0003-add-tests-for-read-request-line-etc.patch --]
[-- Type: application/octet-stream, Size: 5619 bytes --]

From 2bf9660cfdf7c4f0ffbc10a80433910eb2d23bf6 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sat, 23 Feb 2013 15:15:33 +0800
Subject: [PATCH 3/4] add tests for read-request-line, etc.

* test-suite/web/web-http.test ("read-request-line"):
  ("write-request-line", "read-response-line", "write-response-line"):
  Add.
---
 test-suite/tests/web-http.test |  107 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 107 insertions(+)

diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 97f5559..6fa16bd 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -85,6 +85,113 @@
                #t
                (error "unexpected exception" component arg))))))))
 
+(define-syntax pass-if-read-request-line
+  (syntax-rules ()
+    ((_ str expected-method expected-uri expected-version)
+     (pass-if str
+       (equal? (call-with-values
+                   (lambda ()
+                     (read-request-line (open-input-string
+                                         (string-append str "\r\n"))))
+                 list)
+               (list 'expected-method
+                     expected-uri
+                     'expected-version))))))
+
+(define-syntax pass-if-write-request-line
+  (syntax-rules ()
+    ((_ expected-str method uri version)
+     (pass-if expected-str
+       (equal? (string-append expected-str "\r\n")
+               (call-with-output-string
+                (lambda (port)
+                  (write-request-line 'method uri 'version port))))))))
+
+(define-syntax pass-if-read-response-line
+  (syntax-rules ()
+    ((_ str expected-version expected-code expected-phrase)
+     (pass-if str
+       (equal? (call-with-values
+                   (lambda ()
+                     (read-response-line (open-input-string
+                                          (string-append str "\r\n"))))
+                 list)
+               (list 'expected-version
+                     expected-code
+                     expected-phrase))))))
+
+(define-syntax pass-if-write-response-line
+  (syntax-rules ()
+    ((_ expected-str version code phrase)
+     (pass-if expected-str
+       (equal? (string-append expected-str "\r\n")
+               (call-with-output-string
+                (lambda (port)
+                  (write-response-line 'version code phrase port))))))))
+
+(with-test-prefix "read-request-line"
+  (pass-if-read-request-line "GET / HTTP/1.1"
+                             GET
+                             (build-uri 'http
+                                        #: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")
+                             (1 . 1))
+  (pass-if-read-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+                             GET
+                             (build-uri 'http
+                                        #: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")
+                             (1 . 1)))
+
+(with-test-prefix "write-request-line"
+  (pass-if-write-request-line "GET / HTTP/1.1"
+                              GET
+                              (build-uri 'http
+                                         #:path "/")
+                              (1 . 1))
+  ;;; FIXME: Test fails due to scheme, host always being removed.
+  ;;; However, it should be supported to request these be present, and
+  ;;; that is possible with absolute/relative URI support.
+  ;; (pass-if-write-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")
+  ;;                             (1 . 1))
+  (pass-if-write-request-line "GET /pub/WWW/TheProject.html HTTP/1.1"
+                              GET
+                              (build-uri 'http
+                                         #: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")
+                              (1 . 1)))
+
+(with-test-prefix "read-response-line"
+  (pass-if-read-response-line "HTTP/1.0 404 Not Found"
+                              (1 . 0) 404 "Not Found")
+  (pass-if-read-response-line "HTTP/1.1 200 OK"
+                              (1 . 1) 200 "OK"))
+
+(with-test-prefix "write-response-line"
+  (pass-if-write-response-line "HTTP/1.0 404 Not Found"
+                               (1 . 0) 404 "Not Found")
+  (pass-if-write-response-line "HTTP/1.1 200 OK"
+                               (1 . 1) 200 "OK"))
+
 (with-test-prefix "general headers"
 
   (pass-if-parse cache-control "no-transform" '(no-transform))
-- 
1.7.10.4


[-- Attachment #5: 0004-extend-support-for-relative-URIs-to-public-interface.patch --]
[-- Type: application/octet-stream, Size: 22649 bytes --]

From b70bcaba50bf208a81841be2550b3f187967114c Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sat, 23 Feb 2013 15:49:20 +0800
Subject: [PATCH 4/4] extend support for relative URIs to public interface

* module/web/uri.scm (absolute-uri?, relative-uri?): New predicates.

  (validate-uri): SCHEME can be `#f' as for a relative URI.
  (build-uri): SCHEME is optional.  Validation is relaxed to also
  permit relative URIs.

  (string->uri): Fold in `string->uri*' and parse _any_ URI string,
  absolute or relative.
  (string->absolute-uri, string->relative-uri): New procedures.  Parse
  only strings representing the specific type of URI.

* module/web/http.scm (declare-absolute-uri-header!): Rename from
  `declare-uri-header!' to reflect new terminology.  Use new public uri
  interfaces to parse and validate.
  (declare-uri-header!): Rename from `declare-relative-uri-header!' to
  reflect new terminology.  Use new public uri interfaces to parsing.

  (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'.

  (parse-request-uri): Use new `string->absolute-uri' in the else
  clause.  No longer imply that scheme is `http', which was wrong for
  HTTPS.  Add note to later support "authority" form used by the CONNECT
  method.

* test-suite/tests/web-http.test ("read-request-line"):
  ("write-request-line"): Remove scheme from URIs as appropriate.

  ("entity headers", "request headers"): content-location and refer
  should also parse relative URIs.
  ("response headers"): location should not parse relative URIs.

* test-suite/tests/web-request.test ("example-1"): Do not expect any
  uri-scheme.

* test-suite/tests/web-uri.test ("build-uri"): Add tests for relative
  URIs.
  ("string->uri", "uri->string"): Add symmetric tests for handling of
  relative URIs.
  ("string->absolute-uri", "string->relative-uri"): New tests.

* doc/ref/web.texi (URIs): Add introductory note about absolute
  vs. relative URIs.  Document new procedures.

  (HTTP Headers): Note that some headers are absolute URIs.
---
 doc/ref/web.texi                  |   43 ++++++++++++----
 module/web/http.scm               |   40 ++++++++------
 module/web/uri.scm                |   39 +++++++++-----
 test-suite/tests/web-http.test    |   33 +++++++-----
 test-suite/tests/web-request.test |    2 +-
 test-suite/tests/web-uri.test     |  103 +++++++++++++++++++++++++++++++++++--
 6 files changed, 205 insertions(+), 55 deletions(-)

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 963ae3f..7cfd9e5 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -198,6 +198,15 @@ 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.
 
+Finally, there are URI-like objects that omit the scheme part.
+Depending on these reference, these either are or are not considered
+proper URIs.  In Guile there is a single URI record type that holds any
+URI-like object.  This manual uses the term @dfn{absolute URI} to refer
+to a URI object with a scheme, and @dfn{relative URI} to refer to one
+without.  In cases where either type will do, the term @dfn{URI} is
+used.  For example, @indicateurl{/path/to/foo} is a relative URI, where
+as all of the previous examples are absolute URIs.
+
 @example
 (use-modules (web uri))
 @end example
@@ -206,15 +215,15 @@ The following procedures can be found in the @code{(web uri)}
 module. Load it into your Guile, using a form like the above, to have
 access to them.
 
-@deffn {Scheme Procedure} build-uri scheme @
+@deffn {Scheme Procedure} build-uri [scheme] @
        [#:userinfo=@code{#f}] [#:host=@code{#f}] [#:port=@code{#f}] @
        [#:path=@code{""}] [#:query=@code{#f}] [#:fragment=@code{#f}] @
        [#:validate?=@code{#t}]
-Construct a URI object.  @var{scheme} should be a symbol, @var{port}
-either a positive, exact integer or @code{#f}, and the rest of the
-fields are either strings or @code{#f}.  If @var{validate?} is true,
-also run some consistency checks to make sure that the constructed URI
-is valid.
+Construct a URI object.  @var{scheme} should be a symbol, @var{port} a
+positive, exact integer, and the rest of the fields are strings.  Any
+field except @var{port} may also be @code{#f} to indicate it is not
+present.  If @var{validate?} is true, also run some consistency checks
+to make sure that the constructed URI is valid.
 @end deffn
 
 @deffn {Scheme Procedure} uri? obj
@@ -226,8 +235,13 @@ is valid.
 @deffnx {Scheme Procedure} uri-query uri
 @deffnx {Scheme Procedure} uri-fragment uri
 A predicate and field accessors for the URI record type.  The URI scheme
-will be a symbol, the port either a positive, exact integer or @code{#f},
-and the rest either strings or @code{#f} if not present.
+will be a symbol, the port a positive, exact integer, and the rest
+either strings.  Any field except port may be @code{#f} if not present.
+@end deffn
+
+@deffn {Scheme Procedure} absolute-uri? obj
+@deffnx {Scheme Procedure} relative-uri? obj
+Return @code{#t} iff @var{obj} is a URI object of the indicated type.
 @end deffn
 
 @deffn {Scheme Procedure} string->uri string
@@ -235,6 +249,12 @@ Parse @var{string} into a URI object.  Return @code{#f} if the string
 could not be parsed.
 @end deffn
 
+@deffn {Scheme Procedure} string->absolute-uri string
+@deffnx {Scheme Procedure} string->relative-uri string
+Parse @var{string} into a URI object of the indicated type.  Return
+@code{#f} if the string could not be parsed.
+@end deffn
+
 @deffn {Scheme Procedure} uri->string uri
 Serialize @var{uri} to a string.  If the URI has a port that is the
 default port for its scheme, the port is not included in the
@@ -986,9 +1006,10 @@ The entity-tag of the resource.
 @end example
 @end deftypevr
 
-@deftypevr {HTTP Header} URI location
-A URI on which a request may be completed.  Used in combination with a
-redirecting status code to perform client-side redirection.
+@deftypevr {HTTP Header} Absolute-URI location
+An absolute URI on which a request may be completed.  Used in
+combination with a redirecting status code to perform client-side
+redirection.
 @example
 (parse-header 'location "http://example.com/other")
 @result{} #<uri ...>
diff --git a/module/web/http.scm b/module/web/http.scm
index 5671330..2db64d0 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1021,6 +1021,9 @@ symbol, like ‘GET’."
    ((string= str "TRACE" start end) 'TRACE)
    (else (bad-request "Invalid method: ~a" (substring str start end)))))
 
+;; FIXME: At the moment we do not support the CONNECT form (see above)
+;; but we should and this requires to support a request-URI which is
+;; just "authority" (i.e. [userinfo "@"] host [":" port]).
 (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."
@@ -1033,12 +1036,11 @@ 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))
+      (build-uri #: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))
+    (or (string->absolute-uri (substring str start end))
         (bad-request "Invalid URI: ~a" (substring str start end))))))
 
 (define (read-request-line port)
@@ -1053,11 +1055,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 #\:)))
+  (if (uri-host uri)
+      (begin
+        (display "//" port)
         (if (uri-userinfo uri)
             (begin
               (display (uri-userinfo uri) port)
@@ -1171,18 +1179,20 @@ 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-header! 'scheme-indent-function 1)
+(define (declare-uri-header! name)
   (declare-header! name
     (lambda (str)
-      (or ((@@ (web uri) string->uri*) str)
+      (or (string->uri str)
           (bad-header-component 'uri str)))
     uri?
     write-uri))
@@ -1449,7 +1459,7 @@ treated specially, and is just returned as a plain string."
 
 ;; Content-Location = ( absoluteURI | relativeURI )
 ;;
-(declare-relative-uri-header! "Content-Location")
+(declare-uri-header! "Content-Location")
 
 ;; Content-MD5 = <base64 of 128 bit MD5 digest as per RFC 1864>
 ;;
@@ -1738,7 +1748,7 @@ treated specially, and is just returned as a plain string."
 
 ;; Referer = ( absoluteURI | relativeURI )
 ;;
-(declare-relative-uri-header! "Referer")
+(declare-uri-header! "Referer")
 
 ;; TE = #( t-codings )
 ;; t-codings = "trailers" | ( transfer-extension [ accept-params ] )
@@ -1775,7 +1785,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 2e8c4a6..440e620 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -31,13 +31,14 @@
   #:use-module (ice-9 control)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
-  #:export (uri?
+  #:export (uri? absolute-uri? relative-uri?
             uri-scheme uri-userinfo uri-host uri-port
             uri-path uri-query uri-fragment
 
             build-uri
             declare-default-port! default-port default-port?
             string->uri uri->string
+            string->absolute-uri string->relative-uri
             uri-decode uri-encode
             split-and-decode-uri-path
             encode-and-join-uri-path))
@@ -54,8 +55,13 @@
   (fragment uri-fragment))
 
 (define (absolute-uri? obj)
+  "Return ‘#t’ iff OBJ is an absolute URI object."
   (and (uri? obj) (uri-scheme obj) #t))
 
+(define (relative-uri? obj)
+  "Return ‘#t’ iff OBJ is a relative URI object."
+  (and (uri? obj) (not (uri-scheme obj))))
+
 (define (uri-error message . args)
   (throw 'uri-error message args))
 
@@ -64,7 +70,7 @@
 
 (define (validate-uri scheme userinfo host port path query fragment)
   (cond
-   ((not (symbol? scheme))
+   ((and 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"))
@@ -80,13 +86,14 @@
          (not (eqv? (string-ref path 0) #\/)))
     (uri-error "Expected path of absolute URI to start with a /: ~a" path))))
 
-(define* (build-uri scheme #:key userinfo host port (path "") query fragment
+(define* (build-uri #:optional scheme #:key
+                    userinfo host port (path "") query fragment
                     (validate? #t))
-  "Construct a URI object.  SCHEME should be a symbol, PORT
-either a positive, exact integer or ‘#f’, and the rest of the
-fields are either strings or ‘#f’.  If VALIDATE? is true,
-also run some consistency checks to make sure that the constructed URI
-is valid."
+  "Construct a URI object.  SCHEME should be a symbol, PORT a positive,
+exact integer, and the rest of the fields are strings.  Any field except
+PORT may also be ‘#f’ to indicate it is not present.  If VALIDATE? is
+true, also run some consistency checks to make sure that the constructed
+URI is valid."
   (if validate?
       (validate-uri scheme userinfo host port path query fragment))
   (make-uri scheme userinfo host port path query fragment))
@@ -173,7 +180,7 @@ is valid."
 (define uri-regexp
   (make-regexp uri-pat))
 
-(define (string->uri* string)
+(define (string->uri string)
   "Parse STRING into a URI object.  Return ‘#f’ if the string
 could not be parsed."
   (% (let ((m (regexp-exec uri-regexp string)))
@@ -194,11 +201,17 @@ could not be parsed."
      (lambda (k)
        #f)))
 
-(define (string->uri string)
-  "Parse STRING into a URI object.  Return ‘#f’ if the string
+(define (string->absolute-uri string)
+  "Parse STRING into an absolute URI object.  Return ‘#f’ if the string
+could not be parsed."
+  (let ((uri (string->uri string)))
+    (and (absolute-uri? uri) uri)))
+
+(define (string->relative-uri string)
+  "Parse STRING into a relative URI object.  Return ‘#f’ if the string
 could not be parsed."
-  (let ((uri (string->uri* string)))
-    (and uri (uri-scheme uri) uri)))
+  (let ((uri (string->uri string)))
+    (and (relative-uri? uri) uri)))
 
 (define *default-ports* (make-hash-table))
 
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 6fa16bd..80dbd55 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -132,8 +132,7 @@
 (with-test-prefix "read-request-line"
   (pass-if-read-request-line "GET / HTTP/1.1"
                              GET
-                             (build-uri 'http
-                                        #:path "/")
+                             (build-uri #:path "/")
                              (1 . 1))
   (pass-if-read-request-line "GET http://www.w3.org/pub/WWW/TheProject.html HTTP/1.1"
                              GET
@@ -143,21 +142,18 @@
                              (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 #: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"
+                             (build-uri #: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 #: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,13 +166,11 @@
   ;;                             (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 #: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"
+                              (build-uri #:path "/etc/hosts"
                                          #:query "foo=bar")
                               (1 . 1)))
 
@@ -252,6 +246,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 #:host "foo" #:path "/"))
+  (pass-if-parse content-location "/etc/foo"
+                 (build-uri #:path "/etc/foo"))
+  (pass-if-parse content-location "foo"
+                 (build-uri #: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))
@@ -315,6 +315,12 @@
   (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 #:host "foo" #:path "/bar" #:query "baz"))
+  (pass-if-parse referer "/etc/foo"
+                 (build-uri #:path "/etc/foo"))
+  (pass-if-parse referer "foo"
+                 (build-uri #:path "foo"))
   (pass-if-parse te "trailers" '((trailers)))
   (pass-if-parse te "trailers,foo" '((trailers) (foo)))
   (pass-if-parse user-agent "guile" "guile"))
@@ -329,6 +335,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..1574d69 100644
--- a/test-suite/tests/web-request.test
+++ b/test-suite/tests/web-request.test
@@ -53,7 +53,7 @@ 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 #: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..5db1442 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -121,8 +121,23 @@
 
   (pass-if-uri-exception "http://foo@"
                          "Expected.*host"
-                         (build-uri 'http #:userinfo "foo")))
+                         (build-uri 'http #:userinfo "foo"))
 
+  (pass-if "//host/etc/foo"
+    (uri=? (build-uri #:host "host"
+                      #:path "/etc/foo")
+           #:host "host"
+           #:path "/etc/foo"))
+
+  (pass-if "/path/to/some/foo?query"
+    (uri=? (build-uri #:path "/path/to/some/foo"
+                      #:query "query")
+           #:path "/path/to/some/foo"
+           #:query "query"))
+
+  (pass-if "nextdoc/foo"
+    (uri=? (build-uri #:path "nextdoc/foo")
+           #:path "nextdoc/foo")))
 
 (with-test-prefix "string->uri"
   (pass-if "ftp:"
@@ -210,7 +225,30 @@
   (pass-if "file:///etc/hosts"
     (uri=? (string->uri "file:///etc/hosts")
            #:scheme 'file
-           #:path "/etc/hosts")))
+           #:path "/etc/hosts"))
+
+  (pass-if "/"
+    (uri=? (string->uri "/")
+           #:path "/"))
+
+  (pass-if "/path/to/foo"
+    (uri=? (string->uri "/path/to/foo")
+           #:path "/path/to/foo"))
+
+  (pass-if "//example.org"
+    (uri=? (string->uri "//example.org")
+           #:host "example.org"
+           #:path ""))
+
+  (pass-if "//bar@example.org/path/to/foo"
+    (uri=? (string->uri "//bar@example.org/path/to/foo")
+           #:userinfo "bar"
+           #:host "example.org"
+           #:path "/path/to/foo"))
+
+  (pass-if "nextdoc/foo"
+    (uri=? (string->uri "nextdoc/foo")
+           #:path "nextdoc/foo")))
 
 (with-test-prefix "uri->string"
   (pass-if "ftp:"
@@ -248,7 +286,66 @@
   
   (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 "/"))))
+
+  (pass-if "/path/to/foo"
+    (equal? "/path/to/foo"
+            (uri->string (string->uri "/path/to/foo"))))
+
+  (pass-if "//example.org"
+    (equal? "//example.org"
+            (uri->string (string->uri "//example.org"))))
+
+  (pass-if "//bar@example.org/path/to/foo"
+    (equal? "//bar@example.org/path/to/foo"
+            (uri->string (string->uri "//bar@example.org/path/to/foo"))))
+
+  (pass-if "nextdoc/foo"
+    (equal? "nextdoc/foo"
+            (uri->string (string->uri "nextdoc/foo")))))
+
+(with-test-prefix "string->absolute-uri"
+  (pass-if "ftp:"
+    (uri=? (string->absolute-uri "ftp:")
+           #:scheme 'ftp
+           #:path ""))
+
+  (pass-if "/"
+    (not (string->absolute-uri "/")))
+
+  (pass-if "/path/to/foo"
+    (not (string->absolute-uri "/path/to/foo")))
+
+  (pass-if "//example.org"
+    (not (string->absolute-uri "//example.org")))
+
+  (pass-if "nextdoc/foo"
+    (not (string->absolute-uri "nextdoc/foo"))))
+
+(with-test-prefix "string->relative-uri"
+  (pass-if "ftp:"
+    (not (string->relative-uri "ftp:")))
+
+  (pass-if "/"
+    (uri=? (string->relative-uri "/")
+           #:path "/"))
+
+  (pass-if "/path/to/foo"
+    (uri=? (string->relative-uri "/path/to/foo")
+           #:path "/path/to/foo"))
+
+  (pass-if "//example.org"
+    (uri=? (string->relative-uri "//example.org")
+           #:host "example.org"
+           #:path ""))
+
+  (pass-if "nextdoc/foo"
+    (uri=? (string->relative-uri "nextdoc/foo")
+           #:path "nextdoc/foo")))
 
 (with-test-prefix "decode"
   (pass-if "foo%20bar"
-- 
1.7.10.4