[Guile-commits] GNU Guile branch, master, updated. release_1-9-13-197-g1148d02

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1148d029736fea3e3e5002f7a042565a1ecc6623

The branch, master has been updated
       via  1148d029736fea3e3e5002f7a042565a1ecc6623 (commit)
       via  adc91e41bf958fa68819c4cd1c7c242b44f9fe5d (commit)
       via  25731543d4b6c61484ce3e5aef2e341a62d6137c (commit)
      from  ac7f17e3ca30ad965dca6067720cc2a05f35063f (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1148d029736fea3e3e5002f7a042565a1ecc6623
Author: Andy Wingo <address@hidden>
Date:   Thu Dec 16 19:06:41 2010 +0100

    add section on format of parsed http headers
    
    * doc/ref/web.texi (HTTP Headers): New section. Needs some examples,
      though.

commit adc91e41bf958fa68819c4cd1c7c242b44f9fe5d
Author: Andy Wingo <address@hidden>
Date:   Thu Dec 16 18:12:08 2010 +0100

    http: lists of header names parse better
    
    * module/web/http.scm (list-of-strings?, write-list-of-strings): Move
      definitions up.
      (split-header-names, list-of-header-names?, write-header-list): New
      helpers.
      (declare-header-list-header): New helper.
      (cache-control): Use split-header-names for private and no-cache.
      (trailer): Use declare-header-list-header to parse known headers to
      symbols.
      (vary): Likewise, use split-header-names et al.
    
    * test-suite/tests/web-http.test ("general headers"): Add a test.

commit 25731543d4b6c61484ce3e5aef2e341a62d6137c
Author: Andy Wingo <address@hidden>
Date:   Thu Dec 16 17:56:03 2010 +0100

    better cache-control: private, no-cache parsing
    
    * module/web/http.scm (cache-control): Parse private and no-cache
      better.
    * test-suite/tests/web-http.test ("general headers"): Update.

-----------------------------------------------------------------------

Summary of changes:
 doc/ref/web.texi               |  243 ++++++++++++++++++++++++++++++++++++++++
 module/web/http.scm            |   55 +++++++--
 test-suite/tests/web-http.test |    9 +-
 3 files changed, 293 insertions(+), 14 deletions(-)

diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index 13ec7a1..90e7edf 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -33,6 +33,7 @@ the thing?  Read on!
 @menu
 * URIs::                        Universal Resource Identifiers.
 * HTTP::                        The Hyper-Text Transfer Protocol.
+* HTTP Headers::                How Guile represents specific header values.
 * Requests::                    HTTP requests.
 * Responses::                   HTTP responses.
 * Web Handlers::                A simple web application interface.
@@ -298,6 +299,248 @@ Write the first line of an HTTP response to @var{port}.
 @end defun
 
 
address@hidden HTTP Headers
address@hidden HTTP Headers
+
+The @code{(web http)} module defines parsers and unparsers for all
+headers defined in the HTTP/1.1 standard.  This section describes the
+parsed format of the various headers.
+
+We cannot describe the function of all of these headers, however, in
+sufficient detail.  The interested reader would do well to download a
+copy of RFC 2616 and have it on hand.
+
+To begin with, we should make a few definitions:
+
address@hidden @dfn
address@hidden key-value list
+A key-value list is a list of values.  Each value may be a string,
+a symbol, or a pair.  Known keys are parsed to symbols; otherwise keys
+are left as strings.  Keys with values are parsed to pairs, the car of
+which is the symbol or string key, and the cdr is the parsed value.
+Parsed values for known keys have key-dependent formats.  Parsed values
+for unknown keys are strings.
+
address@hidden param list
+A param list is a list of key-value lists.  When serialized to a string,
+items in the inner lists are separated by semicolons.  Again, known keys
+are parsed to symbols.
+
address@hidden quality
+A number of headers have quality values in them, which are decimal
+fractions between zero and one indicating a preference for various kinds
+of responses, which the server may choose to heed.  Given that only
+three digits are allowed in the fractional part, Guile parses quality
+values to integers between 0 and 1000 instead of inexact numbers between
+0.0 and 1.0.
+
address@hidden quality list
+A list of pairs, the car of which is a quality value.
+
address@hidden entity tag
+A pair, the car of which is an opaque string, and the cdr of which is
+true iff the entity tag is a ``strong'' entity tag.
address@hidden table
+
+
address@hidden General Headers
+
address@hidden @code
address@hidden cache-control
+A key-value list of cache-control directives. Known keys are
address@hidden, @code{max-stale}, @code{min-fresh},
address@hidden, @code{no-cache}, @code{no-store},
address@hidden, @code{only-if-cached}, @code{private},
address@hidden, @code{public}, and @code{s-maxage}.
+
+If present, parameters to @code{max-age}, @code{max-stale},
address@hidden, and @code{s-maxage} are all parsed as non-negative
+integers.
+
+If present, parameters to @code{private} and @code{no-cache} are parsed
+as lists of header names, represented as symbols if they are known
+headers or strings otherwise.
+
address@hidden connection
+A list of connection tokens.  A connection token is a string.
+
address@hidden date
+A SRFI-19 date record.
+
address@hidden pragma
+A key-value list of pragma directives.  @code{no-cache} is the only
+known key.
+
address@hidden trailer
+A list of header names.  Known header names are parsed to symbols,
+otherwise they are left as strings.
+
address@hidden transfer-encoding
+A param list of transfer codings.  @code{chunked} is the only known key.
+
address@hidden upgrade
+A list of strings.
+
address@hidden via
+A list of strings.  There may be multiple @code{via} headers in ne
+message.
+
address@hidden warning
+A list of warnings.  Each warning is a itself a list of four elements: a
+code, as an exact integer between 0 and 1000, a host as a string, the
+warning text as a string, and either @code{#f} or a SRFI-19 date.
+
+There may be multiple @code{warning} headers in one message.
address@hidden table
+
+
address@hidden Entity Headers
+
address@hidden @code
address@hidden allow
+A list of methods, as strings.  Methods are parsed as strings instead of
address@hidden so as to allow for new methods.
+
address@hidden content-encoding
+A list of content codings, as strings.
+
address@hidden content-language
+A list of language tags, as strings.
+
address@hidden content-length
+An exact, non-negative integer.
+
address@hidden content-location
+A URI record.
+
address@hidden content-md5
+A string.
+
address@hidden content-range
+A list of three elements: the symbol @code{bytes}, either the symbol
address@hidden or a pair of integers, indicating the byte rage, and either
address@hidden or an integer, for the instance length.
+
address@hidden content-type
+A pair, the car of which is the media type as a string, and the cdr is
+an alist of parameters, with strings as keys and values.
+
+For example, @code{"text/plain"} parses as @code{("text/plain")}, and
address@hidden"text/plain;charset=utf-8"} parses as @code{("text/plain"
+("charset" . "utf-8"))}.
+
address@hidden expires
+A SRFI-19 date.
+
address@hidden last-modified
+A SRFI-19 date.
+
address@hidden table
+
+
address@hidden Request Headers
+
address@hidden @code
address@hidden accept
+A param list.  Each element in the list indicates one media-range
+with accept-params.  They only known key is @code{q}, whose value is
+parsed as a quality value.
+
address@hidden accept-charset
+A quality-list of charsets, as strings.
+
address@hidden accept-encoding
+A quality-list of content codings, as strings.
+
address@hidden accept-language
+A quality-list of languages, as strings.
+
address@hidden authorization
+A string.
+
address@hidden expect
+A param list of expectations.  The only known key is
address@hidden
+
address@hidden from
+A string.
+
address@hidden host
+A pair of the host, as a string, and the port, as an integer. If no port
+is given, port is @code{#f}.
+
address@hidden if-match
+Either the symbol @code{*}, or a list of entity tags (see above).
+
address@hidden if-modified-since
+A SRFI-19 date.
+
address@hidden if-none-match
+Either the symbol @code{*}, or a list of entity tags (see above).
+
address@hidden if-range
+Either an entity tag, or a SRFI-19 date.
+
address@hidden if-unmodified-since
+A SRFI-19 date.
+
address@hidden max-forwards
+An exact non-negative integer.
+
address@hidden proxy-authorization
+A string.
+
address@hidden range
+A pair whose car is the symbol @code{bytes}, and whose cdr is a list of
+pairs. Each element of the cdr indicates a range; the car is the first
+byte position and the cdr is the last byte position, as integers, or
address@hidden if not given.
+
address@hidden referer
+A URI.
+
address@hidden te
+A param list of transfer-codings.  The only known key is
address@hidden
+
address@hidden user-agent
+A string.
address@hidden table
+
+
address@hidden Response Headers
+
address@hidden @code
address@hidden accept-ranges
+A list of strings.
+
address@hidden age
+An exact, non-negative integer.
+
address@hidden etag
+An entity tag.
+
address@hidden location
+A URI.
+
address@hidden proxy-authenticate
+A string.
+
address@hidden retry-after
+Either an exact, non-negative integer, or a SRFI-19 date.
+
address@hidden server
+A string.
+
address@hidden vary
+Either the symbol @code{*}, or a list of headers, with known headers
+parsed to symbols.
+
address@hidden www-authenticate
+A string.
address@hidden table
+
+
 @node Requests
 @subsection HTTP Requests
 
diff --git a/module/web/http.scm b/module/web/http.scm
index d02b336..f2f0866 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -269,6 +269,31 @@ ordered alist."
           (cons tok (split-and-trim str delim (if idx (1+ idx) end) end)))
         '())))
 
+(define (list-of-strings? val)
+  (list-of? val string?))
+
+(define (write-list-of-strings val port)
+  (write-list val port display ", "))
+
+(define (split-header-names str)
+  (map (lambda (f)
+         (or (and=> (lookup-header-decl f) header-decl-sym)
+             f))
+       (split-and-trim str)))
+
+(define (list-of-header-names? val)
+  (list-of? val (lambda (x) (or (string? x) (symbol? x)))))
+
+(define (write-header-list val port)
+  (write-list val port
+              (lambda (x port)
+                (display (or (and (symbol? x)
+                                  (and=> (lookup-header-decl x)
+                                         header-decl-name))
+                             x)
+                         port))
+              ", "))
+
 (define (collect-escaped-string from start len escapes)
   (let ((to (make-string len)))
     (let lp ((start start) (i 0) (escapes escapes))
@@ -588,12 +613,6 @@ ordered alist."
      (write-key-value-list item port val-writer ";"))
    ","))
 
-(define (list-of-strings? val)
-  (list-of? val string?))
-
-(define (write-list-of-strings val port)
-  (write-list val port display ", "))
-
 (define (parse-date str)
   ;; Unfortunately, there is no way to make string->date parse out the
   ;; "GMT" bit, so we play string games to append a format it will
@@ -849,6 +868,14 @@ phrase\"."
        name
        split-and-trim list-of-strings? write-list-of-strings))))
 
+;; emacs: (put 'declare-header-list-header 'scheme-indent-function 1)
+(define-syntax declare-header-list-header
+  (syntax-rules ()
+    ((_ sym name)
+     (declare-header sym
+       name
+       split-header-names list-of-header-names? write-header-list))))
+
 ;; emacs: (put 'declare-integer-header 'scheme-indent-function 1)
 (define-syntax declare-integer-header
   (syntax-rules ()
@@ -966,14 +993,18 @@ phrase\"."
       ((max-age max-stale min-fresh s-maxage)
        (cons k (parse-non-negative-integer v-str)))
       ((private no-cache)
-       (cons k (if v-str (split-and-trim v-str) #t)))
+       (if v-str
+           (cons k (split-header-names v-str))
+           k))
       (else (if v-str (cons k v-str) k))))
   default-kv-validator
   (lambda (k v port)
     (cond
      ((string? v) (display v port))
      ((pair? v)
-      (write-qstring (string-join v ", ") port))
+      (display #\" port)
+      (write-header-list v port)
+      (display #\" port))
      ((integer? v)
       (display v port))
      (else
@@ -1004,7 +1035,7 @@ phrase\"."
 
 ;; Trailer  = "Trailer" ":" 1#field-name
 ;;
-(declare-string-list-header trailer
+(declare-header-list-header trailer
   "Trailer")
 
 ;; Transfer-Encoding = "Transfer-Encoding" ":" 1#transfer-coding
@@ -1523,13 +1554,13 @@ phrase\"."
   (lambda (str)
     (if (equal? str "*")
         '*
-        (split-and-trim str)))
+        (split-header-names str)))
   (lambda (val)
-    (or (eq? val '*) (list-of-strings? val)))
+    (or (eq? val '*) (list-of-header-names? val)))
   (lambda (val port)
     (if (eq? val '*)
         (display "*" port)
-        (write-list-of-strings val port))))
+        (write-header-list val port))))
 
 ;; WWW-Authenticate = 1#challenge
 ;;
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 4d1fe6c..068523e 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -76,9 +76,13 @@
 
   (pass-if-parse cache-control "no-transform" '(no-transform))
   (pass-if-parse cache-control "no-transform,foo" '(no-transform "foo"))
-  (pass-if-parse cache-control "no-cache" '((no-cache . #t)))
+  (pass-if-parse cache-control "no-cache" '(no-cache))
+  (pass-if-parse cache-control "no-cache=\"Authorization, Date\""
+                 '((no-cache . (authorization date))))
+  (pass-if-parse cache-control "private=\"Foo\""
+                 '((private . ("Foo"))))
   (pass-if-parse cache-control "no-cache,max-age=10"
-                 '((no-cache . #t) (max-age . 10)))
+                 '(no-cache (max-age . 10)))
 
   (pass-if-parse connection "close" '("close"))
   (pass-if-parse connection "close, foo" '("close" "foo"))
@@ -93,6 +97,7 @@
   (pass-if-parse pragma "no-cache, foo" '(no-cache "foo"))
 
   (pass-if-parse trailer "foo, bar" '("foo" "bar"))
+  (pass-if-parse trailer "connection, bar" '(connection "bar"))
 
   (pass-if-parse transfer-encoding "foo, chunked" '(("foo") (chunked)))
 


hooks/post-receive
-- 
GNU Guile