From b9f6e89a271c04741231b64b03fe7fc294723f1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 8 May 2016 21:52:33 +0200 Subject: [PATCH] http: Accept date strings with a leading space for hours. Fixes . Reported by Ricardo Wurmus . * 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 0bcd9058b..8e95fc755 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 f88f011a6..3fda4f9fb 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 . + (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")