[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-38-g4855c6
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-38-g4855c63 |
Date: |
Wed, 23 Nov 2011 22:36:31 +0000 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-38-g4855c63,
Andy Wingo <=