[Guile-commits] 45/47: http: Accept date strings with a leading space for hours.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit b9f6e89a271c04741231b64b03fe7fc294723f1d
Author: Ludovic Courtès <address@hidden>
Date:   Sun May 8 21:52:33 2016 +0200

    http: Accept date strings with a leading space for hours.
    
    Fixes <http://bugs.gnu.org/23421>.
    Reported by Ricardo Wurmus <address@hidden>.
    
    * module/web/http.scm (parse-rfc-822-date): Add two clauses for hours
    with a leading space.
    * test-suite/tests/web-http.test ("general headers"): Add two tests.
---
 module/web/http.scm            |   20 ++++++++++++++++++++
 test-suite/tests/web-http.test |   10 ++++++++++
 2 files changed, 30 insertions(+)

diff --git a/module/web/http.scm b/module/web/http.scm
index 0bcd905..8e95fc7 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -751,6 +751,26 @@ as an ordered alist."
                (minute (parse-non-negative-integer str 19 21))
                (second (parse-non-negative-integer str 22 24)))
            (make-date 0 second minute hour date month year zone-offset)))
+
+        ;; The next two clauses match dates that have a space instead of
+        ;; a leading zero for hours, like " 8:49:37".
+        ((string-match? (substring str 0 space) "aaa, dd aaa dddd  d:dd:dd")
+         (let ((date (parse-non-negative-integer str 5 7))
+               (month (parse-month str 8 11))
+               (year (parse-non-negative-integer str 12 16))
+               (hour (parse-non-negative-integer str 18 19))
+               (minute (parse-non-negative-integer str 20 22))
+               (second (parse-non-negative-integer str 23 25)))
+           (make-date 0 second minute hour date month year zone-offset)))
+        ((string-match? (substring str 0 space) "aaa, d aaa dddd  d:dd:dd")
+         (let ((date (parse-non-negative-integer str 5 6))
+               (month (parse-month str 7 10))
+               (year (parse-non-negative-integer str 11 15))
+               (hour (parse-non-negative-integer str 17 18))
+               (minute (parse-non-negative-integer str 19 21))
+               (second (parse-non-negative-integer str 22 24)))
+           (make-date 0 second minute hour date month year zone-offset)))
+
         (else
          (bad-header 'date str)         ; prevent tail call
          #f)))
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index f88f011..3fda4f9 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -236,6 +236,16 @@
   (pass-if-parse date "Wed, 7 Sep 2011 11:25:00 GMT"
                  (string->date "Wed, 7 Sep 2011 11:25:00 +0000"
                                "~a,~e ~b ~Y ~H:~M:~S ~z"))
+
+  ;; This is a non-conforming date (lack of leading zero for the hours)
+  ;; that some HTTP servers provide.  See <http://bugs.gnu.org/23421>.
+  (pass-if-parse date "Sun, 06 Nov 1994  8:49:37 GMT"
+                 (string->date "Sun, 6 Nov 1994 08:49:37 +0000"
+                               "~a,~e ~b ~Y ~H:~M:~S ~z"))
+  (pass-if-parse date "Sun, 6 Nov 1994  8:49:37 GMT"
+                 (string->date "Sun, 6 Nov 1994 08:49:37 +0000"
+                               "~a,~e ~b ~Y ~H:~M:~S ~z"))
+
   (pass-if-parse-error date "Tue, 15 Nov 1994 08:12:31 EST" date)
   (pass-if-any-error date "Tue, 15 Qux 1994 08:12:31 EST")