bug#10109: [PATCH] (web http): list-style headers do not validate

[Daniel Hartwig <mandyke@gmail.com>]

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

Hello again

My apologies for not noticing earlier, but I have spotted a couple
minor issues with both the previous patch and original code that are
corrected by the attached. All relate to the "Cache-Control" header:

- `max-stale' has optional value (previous code requires it)
- some directives do not have values (`no-store', etc.)
- there are `cache-extension' directives that may or may not have a value

Attached patch tidies this up, with explicit validation of all defined
directives, though it leaves open one issue with the cache-extension
directives:

;; cache-extension = token [ "=" ( token | quoted-string ) ]
scheme@(web http)> (read-header (open-input-string "Cache-Control:
foo=\"qstring\"\r\n"))
$102 = cache-control
$103 = ((foo . "qstring"))
scheme@(web http)> (write-header 'cache-control $103
(current-output-port)) (newline)
Cache-Control: foo=qstring

You see quotes around `qstring' are dropped, `parse-key-value-list'
appears inadequate to distinguish between a token and quoted-string
when passing values to the `val-parser'.  This looks like it will
raise itself in edge cases for some other headers.  Will file a new
bug if needed after investigation.


Regards

Daniel

On 23 November 2011 02:18, Daniel Hartwig <mandyke@gmail.com> wrote:
> Package: guile
> Version: 2.0.3
> Tags: patch
>
> Many of the list-style headers from (web http) do not validate
> correctly.  The test suite only checks that the header's parse and
> does not test the associated validators.
>
> Attached is a very quick patch (0002) which exposes the failing
> validators through the test-suite:
>
> $ ./guile-test tests/web-http.test
> Running tests/web-http.test
> ...
> FAIL: tests/web-http.test: general headers: cache-control:
> "no-transform" -> (no-transform)
> [...]

[-- Attachment #2: 0001-Extend-handling-of-Cache-Control-header.patch --]
[-- Type: text/x-patch, Size: 2311 bytes --]

From bf2a00213c60cc47c6c3257a0afe885fca044d27 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
Date: Sun, 27 Nov 2011 22:37:24 +0800
Subject: [PATCH] Extend handling of "Cache-Control" header.

* module/web/http.scm ("Cache-Control"): Value for `max-stale' is
  optional.  Strict validation for value-less directives (`no-store',
  etc.).  String values optional for "cache-extension" directives.
* test-suite/tests/web-http.test: Value for `max-stale' is optional.
---
 module/web/http.scm            |   12 +++++++++---
 test-suite/tests/web-http.test |    2 ++
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index dc742a1..20ea2aa 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1240,19 +1240,25 @@ phrase\"."
 (declare-key-value-list-header! "Cache-Control"
   (lambda (k v-str)
     (case k
-      ((max-age max-stale min-fresh s-maxage)
+      ((max-age min-fresh s-maxage)
        (parse-non-negative-integer v-str))
+      ((max-stale)
+       (and v-str (parse-non-negative-integer v-str)))
       ((private no-cache)
        (and v-str (split-header-names v-str)))
       (else v-str)))
   (lambda (k v)
     (case k
-      ((max-age max-stale min-fresh s-maxage)
+      ((max-age min-fresh s-maxage)
        (non-negative-integer? v))
+      ((max-stale)
+       (or (not v) (non-negative-integer? v)))
       ((private no-cache)
        (or (not v) (list-of-header-names? v)))
+      ((no-store no-transform only-if-cache must-revalidate proxy-revalidate)
+       (not v))
       (else
-       (not v))))
+       (or (not v) (string? v)))))
   (lambda (k v port)
     (cond
      ((string? v) (display v port))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index b6abbf3..b5247ab 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -83,6 +83,8 @@
                  '((private . (foo))))
   (pass-if-parse cache-control "no-cache,max-age=10"
                  '(no-cache (max-age . 10)))
+  (pass-if-parse cache-control "max-stale" '(max-stale))
+  (pass-if-parse cache-control "max-stale=10" '((max-stale . 10)))
 
   (pass-if-parse connection "close" '(close))
   (pass-if-parse connection "Content-Encoding" '(content-encoding))
-- 
1.7.2.5