mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

http: Accept date strings with a leading space for hours.

Browse source 
Fixes <http://bugs.gnu.org/23421>.
Reported by Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>.

* 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.
This commit is contained in:
Ludovic Courtès 2016-05-08 21:52:33 +02:00 • committed by Andy Wingo
parent 140496cc00
commit b9f6e89a27
2 changed files with 30 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

20
module/web/http.scm
View file

@ -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)))

10
test-suite/tests/web-http.test
View file

@ -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")