[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-38-g4855c63

[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=4855c63441c5f11a58b8157c877e5890a7b0ffe1

The branch, stable-2.0 has been updated
       via  4855c63441c5f11a58b8157c877e5890a7b0ffe1 (commit)
       via  69b8c5df14dbc1f9602925788507d371a529dfbe (commit)
      from  2db1dbfe275986c4762d247209a02417818f62f8 (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 4855c63441c5f11a58b8157c877e5890a7b0ffe1
Author: Daniel Hartwig <address@hidden>
Date:   Wed Nov 23 20:56:30 2011 +0100

    web-http.test validates headers
    
    * test-suite/tests/web-http.test (pass-if-parse): Validate header values
      as well.

commit 69b8c5df14dbc1f9602925788507d371a529dfbe
Author: Daniel Hartwig <address@hidden>
Date:   Wed Nov 23 20:56:10 2011 +0100

    fix validators for various list-style headers
    
    * module/web/http.scm (default-val-validator): Valid with no value.
      (key-value-list?): Keys are always symbols, do not accept strings.
      (validate-param-list): Apply `valid?' to list elements.
      (validate-credentials): Validate param for Basic scheme, which
      is parsed as a string.
      (declare-symbol-list-header!): `list-of?' args were in wrong order.
      ("Cache-Control"): Replace `default-val-validator' with more
      specific procedure.
      ("Accept"): Validate on first param which has no value.

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

Summary of changes:
 module/web/http.scm            |   26 ++++++++++++++++++--------
 test-suite/tests/web-http.test |    5 +++--
 2 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index e8765f3..dc742a1 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -470,7 +470,7 @@ ordered alist."
   val)
 
 (define (default-val-validator k val)
-  (string? val))
+  (or (not val) (string? val)))
 
 (define (default-val-writer k val port)
   (if (or (string-index val #\;)
@@ -518,9 +518,9 @@ ordered alist."
                ((pair? elt)
                 (let ((k (car elt))
                       (v (cdr elt)))
-                  (and (or (string? k) (symbol? k))
+                  (and (symbol? k)
                        (valid? k v))))
-               ((or (string? elt) (symbol? elt))
+               ((symbol? elt)
                 (valid? elt #f))
                (else #f)))))
 
@@ -611,7 +611,7 @@ ordered alist."
                               (valid? default-val-validator))
   (list-of? list
             (lambda (elt)
-              (key-value-list? list valid?))))
+              (key-value-list? elt valid?))))
 
 (define* (write-param-list list port #:optional
                            (val-writer default-val-writer))
@@ -871,7 +871,10 @@ ordered alist."
          (cons scheme (parse-key-value-list str default-val-parser delim 
end)))))))
 
 (define (validate-credentials val)
-  (and (pair? val) (symbol? (car val)) (key-value-list? (cdr val))))
+  (and (pair? val) (symbol? (car val))
+       (case (car val)
+         ((basic) (string? (cdr val)))
+         (else (key-value-list? (cdr val))))))
 
 (define (write-credentials val port)
   (display (car val) port)
@@ -1137,7 +1140,7 @@ phrase\"."
     (lambda (str)
       (map string->symbol (split-and-trim str)))
     (lambda (v)
-      (list-of? symbol? v))
+      (list-of? v symbol?))
     (lambda (v port)
       (write-list v port display ", "))))
 
@@ -1242,7 +1245,14 @@ phrase\"."
       ((private no-cache)
        (and v-str (split-header-names v-str)))
       (else v-str)))
-  default-val-validator
+  (lambda (k v)
+    (case k
+      ((max-age max-stale min-fresh s-maxage)
+       (non-negative-integer? v))
+      ((private no-cache)
+       (or (not v) (list-of-header-names? v)))
+      (else
+       (not v))))
   (lambda (k v port)
     (cond
      ((string? v) (display v port))
@@ -1522,7 +1532,7 @@ phrase\"."
   (lambda (k v)
     (if (eq? k 'q)
         (valid-quality? v)
-        (string? v)))
+        (or (not v) (string? v))))
   (lambda (k v port)
     (if (eq? k 'q)
         (write-quality v port)
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index e4d6efb..b6abbf3 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -41,8 +41,9 @@
   (syntax-rules ()
     ((_ sym str val)
      (pass-if (format #f "~a: ~s -> ~s" 'sym str val)
-       (equal? (parse-header 'sym str)
-               val)))))
+       (and (equal? (parse-header 'sym str)
+                    val)
+            (valid-header? 'sym val))))))
 
 (define-syntax pass-if-any-error
   (syntax-rules ()


hooks/post-receive
-- 
GNU Guile