[Guile-commits] 01/02: web: Be less strict when parsing entity tags.

[Ludovic Courtès]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit c5dac3595f42afbd76ab9110d7473bf4d16b0520
Author: Andy Wingo <address@hidden>
Date:   Thu Jan 7 10:53:57 2016 +0100

    web: Be less strict when parsing entity tags.
    
    * module/web/http.scm (parse-entity-tag): Be less strict, accepting
      unquoted strings as well.
    
    * test-suite/tests/web-http.test ("response headers"): Add a test for
      etag parsing.
---
 module/web/http.scm            |   11 ++++++++---
 test-suite/tests/web-http.test |    1 +
 2 files changed, 9 insertions(+), 3 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index a1c0de4..88d6db1 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -848,10 +848,15 @@ as an ordered alist."
     (display-digits (date-second date) 2 port)
     (display " GMT" port)))
 
+;; 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.
 (define (parse-entity-tag val)
-  (if (string-prefix? "W/" val)
-      (cons (parse-qstring val 2) #f)
-      (cons (parse-qstring val) #t)))
+  (cond
+   ((string-prefix? "W/" val) (cons (parse-qstring val 2) #f))
+   ((string-prefix? "\"" val) (cons (parse-qstring val) #t))
+   (else (cons val #t))))
 
 (define (entity-tag? val)
   (and (pair? val)
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index b1684fb..e0ffc22 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -353,6 +353,7 @@
   (pass-if-parse age "30" 30)
   (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 location "http://other-place";
                  (build-uri 'http #:host "other-place"))
   (pass-if-parse proxy-authenticate "Basic realm=\"guile\""