1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

HTTP: Fix qstring writing of cache-extension values

* module/web/http.scm ("Cache-Control"): Write string values using the
  default val writer, to get quoting correct.

* test-suite/tests/web-http.test (pass-if-round-trip): New helper.
  ("general headers"): Check that cache-extensions round trip properly.
This commit is contained in:
Andy Wingo 2011-12-22 08:18:05 -05:00
parent 321770b2a3
commit 61fe8eafc2
2 changed files with 17 additions and 1 deletions

View file

@ -1261,7 +1261,7 @@ phrase\"."
(or (not v) (string? v))))) (or (not v) (string? v)))))
(lambda (k v port) (lambda (k v port)
(cond (cond
((string? v) (display v port)) ((string? v) (default-val-writer k v port))
((pair? v) ((pair? v)
(display #\" port) (display #\" port)
(write-header-list v port) (write-header-list v port)

View file

@ -45,6 +45,18 @@
val) val)
(valid-header? 'sym val)))))) (valid-header? 'sym val))))))
(define-syntax pass-if-round-trip
(syntax-rules ()
((_ str)
(pass-if (format #f "~s round trip" str)
(equal? (call-with-output-string
(lambda (port)
(call-with-values
(lambda () (read-header (open-input-string str)))
(lambda (sym val)
(write-header sym val port)))))
str)))))
(define-syntax pass-if-any-error (define-syntax pass-if-any-error
(syntax-rules () (syntax-rules ()
((_ sym str) ((_ sym str)
@ -85,6 +97,10 @@
'(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" '(max-stale))
(pass-if-parse cache-control "max-stale=10" '((max-stale . 10))) (pass-if-parse cache-control "max-stale=10" '((max-stale . 10)))
(pass-if-round-trip "Cache-Control: acme-cache-extension\r\n")
(pass-if-round-trip "Cache-Control: acme-cache-extension=20\r\n")
(pass-if-round-trip "Cache-Control: acme-cache-extension=100 quux\r\n")
(pass-if-round-trip "Cache-Control: acme-cache-extension=\"100, quux\"\r\n")
(pass-if-parse connection "close" '(close)) (pass-if-parse connection "close" '(close))
(pass-if-parse connection "Content-Encoding" '(content-encoding)) (pass-if-parse connection "Content-Encoding" '(content-encoding))