unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* [PATCH] Tweak web modules, support relative URIs (was: bug#12827: [2.0.6] web client: fails to parse 404 header)
@ 2013-02-23  8:11 Daniel Hartwig
  2013-02-24 10:45 ` [PATCH] Tweak web modules, support relative URIs Mark H Weaver
  0 siblings, 1 reply; 4+ messages in thread
From: Daniel Hartwig @ 2013-02-23  8:11 UTC (permalink / raw)
  To: guile-devel; +Cc: 12827, Ludovic Courtès

[-- 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


^ permalink raw reply related	[flat|nested] 4+ messages in thread

* Re: [PATCH] Tweak web modules, support relative URIs
  2013-02-23  8:11 [PATCH] Tweak web modules, support relative URIs (was: bug#12827: [2.0.6] web client: fails to parse 404 header) Daniel Hartwig
@ 2013-02-24 10:45 ` Mark H Weaver
  2013-02-24 12:31   ` bug#12827: " Daniel Hartwig
  0 siblings, 1 reply; 4+ messages in thread
From: Mark H Weaver @ 2013-02-24 10:45 UTC (permalink / raw)
  To: Daniel Hartwig; +Cc: 12827, Ludovic Courtès, guile-devel

Hi Daniel,

Daniel Hartwig <mandyke@gmail.com> writes:
> * 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.

Thanks for your careful work on this, and especially for calling our
attention to the terminology changes introduced in the latest URI spec.

My preference would be to use the newer RFC 3986 terms.  To my mind, the
key question is: which type (Absolute-URI or URI-Reference) is more
commonly appropriate in user code, and thus more deserving of the short
term "URI".

I would argue that Absolute-URIs are more often appropriate in typical
user code.  The reason is that outside of URI-handling libraries, most
code that deals with URIs simply use them as universal pointers,
i.e. they implicitly assume that each URI is sufficient by itself to
identify any resource in universe.

Working with URI-References is inherently trickier and more error-prone,
because code that handles them must do some additional bookkeeping to
associate each URI-Reference with its _context_.  It is inconvenient to
mix URI-References from different contexts, and they must be converted
when moved from one context to another.

For typical code, the simplest and safest strategy for dealing with
URI-References is to convert them to Absolute-URIs as early as possible,
preferably as the document is being read.  (Of course, there are special
cases such as editors where it is important to preserve the
URI-References, but that is not the typical case).

Therefore, I think that Absolute-URI is more deserving of the short term
"URI", and furthermore that existing code outside of (web uri) that
refers to URIs should, by default, be assumed to be talking about
Absolute-URIs.  Only after some thought about whether a procedure
handles relative references properly should its type be changed to
accept URI-References.

> * 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.

For the reasons given above, I think that it is a virtue, not a flaw,
i.e. I think that latest URI spec (RFC 3986) got this right.  

It is important to clearly distinguish Absolute-URIs from
URI-References.  Despite their overlapping syntax, they are very
different concepts, and must not be conflated.

Here's what I suggest: instead of extending 'string->uri' and
'build-uri' to produce relative URIs, rename those extended procedures
'string->uri-reference' and 'build-uri-reference'.  These are long
names, but that's okay because users should think twice before using
them, and that's seldom needed.

Then, we extend 'string->uri' and 'build-uri' in a different way: we
extend them to handle relative references in their *inputs*, but
continue to provide absolute *outputs*, by adding an optional keyword
argument '#:base-uri'.  This would make it easy to implement the
simplest and safest strategy outlined above with a minimum of code
changes.

What do you think?

    Mark



^ permalink raw reply	[flat|nested] 4+ messages in thread

* bug#12827: [PATCH] Tweak web modules, support relative URIs
  2013-02-24 10:45 ` [PATCH] Tweak web modules, support relative URIs Mark H Weaver
@ 2013-02-24 12:31   ` Daniel Hartwig
  2013-02-24 19:55     ` Mark H Weaver
  0 siblings, 1 reply; 4+ messages in thread
From: Daniel Hartwig @ 2013-02-24 12:31 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: 12827, Ludovic Courtès, guile-devel

On 24 February 2013 18:45, Mark H Weaver <mhw@netris.org> wrote:
> Hi Daniel,
>
> Daniel Hartwig <mandyke@gmail.com> writes:
>> * 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
>>

> My preference would be to use the newer RFC 3986 terms.  To my mind, the
> key question is: which type (Absolute-URI or URI-Reference) is more
> commonly appropriate in user code, and thus more deserving of the short
> term "URI".
>
> I would argue that Absolute-URIs are more often appropriate in typical
> user code.  The reason is that outside of URI-handling libraries, most
> code that deals with URIs simply use them as universal pointers,
> i.e. they implicitly assume that each URI is sufficient by itself to
> identify any resource in universe.

Right.  RFC 3986 makes a convincing argument for the new terminology.
These notes about usage also reflect the sentiment in that document.

FWIW, I sat mostly on the fence, finally going away from URI-Reference
due to these concerns I expressed in an earlier email:
> 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.

and looking at some other Scheme URI modules.

However, having read over your comments I think that we could
reasonably get away with just introducing the procedures you mention
below and not bother about renaming (or duplicating) the field getters
to ‘uri-reference-path’ etc..

> Here's what I suggest: instead of extending 'string->uri' and
> 'build-uri' to produce relative URIs, rename those extended procedures
> 'string->uri-reference' and 'build-uri-reference'.  These are long
> names, but that's okay because users should think twice before using
> them, and that's seldom needed.

In your proposed solution, ‘uri?’ and ‘uri-reference?’ are the
predicates and they respond according to the RFC rather than internal
Guile details?  That is:

  (uri? (string->uri-reference "http://example.net/"))
  => #t
  (uri-reference? (string->uri-reference "http://example.net/"))
  => #t
  (uri? (string->uri-reference "foo"))
  => #f

or …?

> Then, we extend 'string->uri' and 'build-uri' in a different way: we
> extend them to handle relative references in their *inputs*, but
> continue to provide absolute *outputs*, by adding an optional keyword
> argument '#:base-uri'.  This would make it easy to implement the
> simplest and safest strategy outlined above with a minimum of code
> changes.

This strategy does reflect the recommendation of RFC 3986 to resolve
the references as they are read.  Also an elegant API, as it
encourages immedately resolving uri-references and never creating (or
considering to create) the context-sensitive relative-refs.

>
> What do you think?
>

I quite like it, particularly the last part about #:base-uri.

Ludo, I think this is basically what you were suggesting in the first place? :-)

.





^ permalink raw reply	[flat|nested] 4+ messages in thread

* Re: [PATCH] Tweak web modules, support relative URIs
  2013-02-24 12:31   ` bug#12827: " Daniel Hartwig
@ 2013-02-24 19:55     ` Mark H Weaver
  0 siblings, 0 replies; 4+ messages in thread
From: Mark H Weaver @ 2013-02-24 19:55 UTC (permalink / raw)
  To: Daniel Hartwig; +Cc: 12827, Ludovic Courtès, guile-devel

Daniel Hartwig <mandyke@gmail.com> writes:

> On 24 February 2013 18:45, Mark H Weaver <mhw@netris.org> wrote:
>> I would argue that Absolute-URIs are more often appropriate in typical
>> user code.  The reason is that outside of URI-handling libraries, most
>> code that deals with URIs simply use them as universal pointers,
>> i.e. they implicitly assume that each URI is sufficient by itself to
>> identify any resource in universe.
>
> Right.  RFC 3986 makes a convincing argument for the new terminology.
> These notes about usage also reflect the sentiment in that document.
>
> FWIW, I sat mostly on the fence, finally going away from URI-Reference
> due to these concerns I expressed in an earlier email:
>> 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.
>
> and looking at some other Scheme URI modules.
>
> However, having read over your comments I think that we could
> reasonably get away with just introducing the procedures you mention
> below and not bother about renaming (or duplicating) the field getters
> to ‘uri-reference-path’ etc..

Hmm.  The cleanest solution would probably be to duplicate the field
getters, and make the 'uri-*' variants (e.g. 'uri-path') raise an error
when applied to a relative reference.  However, it's probably not that
important, so if you think it's better to simply extend 'uri-path' etc
to apply to all URI-References, I'm okay with that.

>> Here's what I suggest: instead of extending 'string->uri' and
>> 'build-uri' to produce relative URIs, rename those extended procedures
>> 'string->uri-reference' and 'build-uri-reference'.  These are long
>> names, but that's okay because users should think twice before using
>> them, and that's seldom needed.
>
> In your proposed solution, ‘uri?’ and ‘uri-reference?’ are the
> predicates and they respond according to the RFC rather than internal
> Guile details?

What do you mean by "rather than internal Guile details"?

Here's how I like to think about these types: URI-Reference is at the
top of the type hierarchy, and URI (a.k.a. Absolute-URI) and
Relative-Ref are subtypes.  Furthermore, every URI-Reference is either
an Absolute-URI or a Relative-Ref.

In other words, if you create a URI-Reference that happens to be
absolute, then you'll end up with a URI, in the same sense that if you
create a complex number whose imaginary part happens to be exact zero,
you'll end up with a real number.

> That is:
>
>   (uri? (string->uri-reference "http://example.net/"))
>   => #t
>   (uri-reference? (string->uri-reference "http://example.net/"))
>   => #t
>   (uri? (string->uri-reference "foo"))
>   => #f

Yes.

>> Then, we extend 'string->uri' and 'build-uri' in a different way: we
>> extend them to handle relative references in their *inputs*, but
>> continue to provide absolute *outputs*, by adding an optional keyword
>> argument '#:base-uri'.  This would make it easy to implement the
>> simplest and safest strategy outlined above with a minimum of code
>> changes.
>
> This strategy does reflect the recommendation of RFC 3986 to resolve
> the references as they are read.  Also an elegant API, as it
> encourages immedately resolving uri-references and never creating (or
> considering to create) the context-sensitive relative-refs.
>
>>
>> What do you think?
>>
>
> I quite like it, particularly the last part about #:base-uri.
>
> Ludo, I think this is basically what you were suggesting in the first place? :-)

Excellent!  BTW, to be clear, I suggest that 'string->uri' and
'build-uri' should be guaranteed to produce Absolute-URIs.  In other
words, they should raise an error if not given enough information to
produce an Absolute-URI.  Does that make sense?

Thanks again for your work on this :)

     Mark



^ permalink raw reply	[flat|nested] 4+ messages in thread

end of thread, other threads:[~2013-02-24 19:55 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-02-23  8:11 [PATCH] Tweak web modules, support relative URIs (was: bug#12827: [2.0.6] web client: fails to parse 404 header) Daniel Hartwig
2013-02-24 10:45 ` [PATCH] Tweak web modules, support relative URIs Mark H Weaver
2013-02-24 12:31   ` bug#12827: " Daniel Hartwig
2013-02-24 19:55     ` Mark H Weaver

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).