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

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 6d7c09c8a9900794a855b9c69c57c3d1736506ed
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            |   13 +++++++++----
 test-suite/tests/web-http.test |    3 ++-
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/module/web/http.scm b/module/web/http.scm
index a157cf0..8a07f6d 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1,6 +1,6 @@
 ;;; HTTP messages
 
-;; Copyright (C)  2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C)  2010, 2011, 2012, 2013, 2014, 2016 Free Software Foundation, 
Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -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 dfc9677..f01a832 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -1,6 +1,6 @@
 ;;;; web-uri.test --- URI library          -*- mode: scheme; coding: utf-8; -*-
 ;;;;
-;;;;   Copyright (C) 2010, 2011, 2014 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2010, 2011, 2014, 2016 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -343,6 +343,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 location "#foo"