[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/01: ETag list headers accept sloppy etags
From: |
Andy Wingo |
Subject: |
[Guile-commits] 01/01: ETag list headers accept sloppy etags |
Date: |
Sun, 28 Aug 2016 11:48:50 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit 342bd8dfb325eab6610e7c4450aaf810ef71884f
Author: Andy Wingo <address@hidden>
Date: Sun Aug 28 13:46:31 2016 +0200
ETag list headers accept sloppy etags
* module/web/http.scm (parse-entity-tag): Add #:sloppy-delimiters
keyword argument, and return a second value indicating the end
position.
(parse-entity-tag-list): Use parse-entity-tag, so that we also accept
sloppy etags that aren't qstrings.
* test-suite/tests/web-http.test ("request headers"): Add a test.
---
module/web/http.scm | 52 +++++++++++++++++++++++++---------------
test-suite/tests/web-http.test | 2 ++
2 files changed, 35 insertions(+), 19 deletions(-)
diff --git a/module/web/http.scm b/module/web/http.scm
index 8e95fc7..c9fb195 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -872,11 +872,27 @@ as an ordered alist."
;; tag should really be a qstring. However there are a number of
;; servers that emit etags as unquoted strings. Assume that if the
;; value doesn't start with a quote, it's an unquoted strong etag.
-(define (parse-entity-tag val)
+(define* (parse-entity-tag val #:optional (start 0) (end (string-length val))
+ #:key sloppy-delimiters)
+ (define (parse-proper-etag-at start strong?)
+ (cond
+ (sloppy-delimiters
+ (call-with-values (lambda ()
+ (parse-qstring val start end #:incremental? #t))
+ (lambda (tag next)
+ (values (cons tag strong?) next))))
+ (else
+ (values (cons (parse-qstring val start end) strong?) end))))
(cond
- ((string-prefix? "W/" val) (cons (parse-qstring val 2) #f))
- ((string-prefix? "\"" val) (cons (parse-qstring val) #t))
- (else (cons val #t))))
+ ((string-prefix? "W/" val 0 2 start end)
+ (parse-proper-etag-at (+ start 2) #f))
+ ((string-prefix? "\"" val 0 1 start end)
+ (parse-proper-etag-at start #t))
+ (else
+ (let ((delim (or (and sloppy-delimiters
+ (string-index val sloppy-delimiters start end))
+ end)))
+ (values (cons (substring val start delim) #t) delim)))))
(define (entity-tag? val)
(and (pair? val)
@@ -889,21 +905,19 @@ as an ordered alist."
(define* (parse-entity-tag-list val #:optional
(start 0) (end (string-length val)))
- (let ((strong? (not (string-prefix? "W/" val 0 2 start end))))
- (call-with-values (lambda ()
- (parse-qstring val (if strong? start (+ start 2))
- end #:incremental? #t))
- (lambda (tag next)
- (acons tag strong?
- (let ((next (skip-whitespace val next end)))
- (if (< next end)
- (if (eqv? (string-ref val next) #\,)
- (parse-entity-tag-list
- val
- (skip-whitespace val (1+ next) end)
- end)
- (bad-header-component 'entity-tag-list val))
- '())))))))
+ (call-with-values (lambda ()
+ (parse-entity-tag val start end #:sloppy-delimiters #\,))
+ (lambda (etag next)
+ (cons etag
+ (let ((next (skip-whitespace val next end)))
+ (if (< next end)
+ (if (eqv? (string-ref val next) #\,)
+ (parse-entity-tag-list
+ val
+ (skip-whitespace val (1+ next) end)
+ end)
+ (bad-header-component 'entity-tag-list val))
+ '()))))))
(define (entity-tag-list? val)
(list-of? val entity-tag?))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 3fda4f9..762f78c 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -331,6 +331,8 @@
"~a, ~d ~b ~Y ~H:~M:~S ~z"))
(pass-if-parse if-none-match "\"xyzzy\", W/\"qux\""
'(("xyzzy" . #t) ("qux" . #f)))
+ (pass-if-parse if-none-match "xyzzy, W/\"qux\""
+ '(("xyzzy" . #t) ("qux" . #f)))
(pass-if-parse if-none-match "*" '*)
(pass-if-parse if-range "\"foo\"" '("foo" . #t))
(pass-if-parse if-range "Tue, 15 Nov 1994 08:12:31 GMT"