summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-08-28 13:46:31 +0200
committerAndy Wingo <wingo@pobox.com>2016-08-28 13:48:42 +0200
commit342bd8dfb325eab6610e7c4450aaf810ef71884f (patch)
tree37bee6d7332f2605f0abeec214c871ae7ff2a6fb /module
parent57aff02646287dc8c74a1abb34dd24440d0f96eb (diff)
downloadguile-342bd8dfb325eab6610e7c4450aaf810ef71884f.tar.gz
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.
Diffstat (limited to 'module')
-rw-r--r--module/web/http.scm52
1 files changed, 33 insertions, 19 deletions
diff --git a/module/web/http.scm b/module/web/http.scm
index 8e95fc755..c9fb195d7 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?))