>From dfd68f4f2dc6c2b3b86191e550a50a19533522d3 Mon Sep 17 00:00:00 2001 From: Derek Upham Date: Sun, 19 Jan 2020 16:55:10 -0800 Subject: [PATCH 2/2] Properly handle unquoted and quoted etags. --- module/web/http.scm | 20 +++++++++++++------- test-suite/tests/web-http.test | 1 + 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/module/web/http.scm b/module/web/http.scm index c5e559bea..0d495ff69 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -875,8 +875,10 @@ as an ordered alist." ;; Following https://tools.ietf.org/html/rfc7232#section-2.3, an entity ;; 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. +;; servers that emit strong and weak etags as unquoted strings. We have +;; to handle all four combinations of quoted/unquoted and strong/weak. +;; (Use the heuristic that an unquoted entity tag with an initial 'W/' +;; is a weak tag, with the tag following the slash.) (define* (parse-entity-tag val #:optional (start 0) (end (string-length val)) #:key sloppy-delimiters) (define (parse-proper-etag-at start strong?) @@ -888,16 +890,20 @@ as an ordered alist." (values (cons tag strong?) next)))) (else (values (cons (parse-qstring val start end) strong?) end)))) + (define (parse-unquoted-etag-at start strong?) + (let ((delim (or (and sloppy-delimiters + (string-index val sloppy-delimiters start end)) + end))) + (values (cons (substring val start delim) strong?) delim))) (cond - ((string-prefix? "W/" val 0 2 start end) + ((string-prefix? "W/\"" val 0 3 start end) (parse-proper-etag-at (+ start 2) #f)) + ((string-prefix? "W/" val 0 2 start end) + (parse-unquoted-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))))) + (parse-unquoted-etag-at start #t)))) (define (entity-tag? val) (match val diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test index 843936bb5..0cf3b6129 100644 --- a/test-suite/tests/web-http.test +++ b/test-suite/tests/web-http.test @@ -410,6 +410,7 @@ (pass-if-parse etag "\"foo\"" '("foo" . #t)) (pass-if-parse etag "W/\"foo\"" '("foo" . #f)) (pass-if-parse etag "foo" '("foo" . #t)) + (pass-if-parse etag "W/foo" '("foo" . #t)) (pass-if-parse location "http://other-place" (build-uri 'http #:host "other-place")) (pass-if-only-parse location "#foo" -- 2.25.1