mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

web http: parse numeric time zones in headers

Browse source 
* module/web/http.scm (parse-zone-offset, normalize-date): New
  procedures.
  (parse-rfc-822-date, parse-rfc-850-date, parse-date): Update.
* test-suite/tests/web-http.test ("general headers"): Add test.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Daniel Hartwig 2013-03-15 22:25:10 +08:00 • committed by Ludovic Courtès
parent c548da6949
commit ffc8eca636
2 changed files with 49 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

61
module/web/http.scm
View file

@ -702,29 +702,50 @@ as an ordered alist."
(else (bad))))
(else (bad))))))
;; "GMT" | "+" 4DIGIT | "-" 4DIGIT
;;
;; RFC 2616 requires date values to use "GMT", but recommends accepting
;; the others as they are commonly generated by e.g. RFC 822 sources.
(define (parse-zone-offset str start)
(let ((s (substring str start)))
(define (bad)
(bad-header-component 'zone-offset s))
(cond
((string=? s "GMT")
0)
((string-match? s ".dddd")
(let ((sign (case (string-ref s 0)
((#\+) +1)
((#\-) -1)
(else (bad))))
(hours (parse-non-negative-integer s 1 3))
(minutes (parse-non-negative-integer s 3 5)))
(* sign 60 (+ (* 60 hours) minutes)))) ; seconds east of Greenwich
(else (bad)))))
;; RFC 822, updated by RFC 1123
;;
;; Sun, 06 Nov 1994 08:49:37 GMT
;; 01234567890123456789012345678
;; 0 1 2
(define (parse-rfc-822-date str)
(define (parse-rfc-822-date str space zone-offset)
;; We could verify the day of the week but we don't.
(cond ((string-match? str "aaa, dd aaa dddd dd:dd:dd GMT")
(cond ((string-match? (substring str 0 space) "aaa, dd aaa dddd dd: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 17 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 0)))
((string-match? str "aaa, d aaa dddd dd:dd:dd GMT")
(make-date 0 second minute hour date month year zone-offset)))
((string-match? (substring str 0 space) "aaa, d aaa dddd dd: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 16 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 0)))
(make-date 0 second minute hour date month year zone-offset)))
(else
(bad-header 'date str) ; prevent tail call
#f)))
@ -733,10 +754,10 @@ as an ordered alist."
;; Sunday, 06-Nov-94 08:49:37 GMT
;; 0123456789012345678901
;; 0 1 2
(define (parse-rfc-850-date str comma)
(define (parse-rfc-850-date str comma space zone-offset)
;; We could verify the day of the week but we don't.
(let ((tail (substring str (1+ comma))))
(if (not (string-match? tail " dd-aaa-dd dd:dd:dd GMT"))
(let ((tail (substring str (1+ comma) space)))
(if (not (string-match? tail " dd-aaa-dd dd:dd:dd"))
(bad-header 'date str))
(let ((date (parse-non-negative-integer tail 1 3))
(month (parse-month tail 4 7))
@ -750,7 +771,7 @@ as an ordered alist."
(cond ((< (+ then 50) now) (+ then 100))
((< (+ now 50) then) (- then 100))
(else then)))
0))))
zone-offset))))
;; ANSI C's asctime() format
;; Sun Nov 6 08:49:37 1994
@ -770,13 +791,23 @@ as an ordered alist."
(second (parse-non-negative-integer str 17 19)))
(make-date 0 second minute hour date month year 0)))
;; Convert all date values to GMT time zone, as per RFC 2616 appendix C.
(define (normalize-date date)
(if (zero? (date-zone-offset date))
date
(time-utc->date (date->time-utc date) 0)))
(define (parse-date str)
(if (string-suffix? " GMT" str)
(let ((comma (string-index str #\,)))
(cond ((not comma) (bad-header 'date str))
((= comma 3) (parse-rfc-822-date str))
(else (parse-rfc-850-date str comma))))
(parse-asctime-date str)))
(let* ((space (string-rindex str #\space))
(zone-offset (and space (false-if-exception
(parse-zone-offset str (1+ space))))))
(normalize-date
(if zone-offset
(let ((comma (string-index str #\,)))
(cond ((not comma) (bad-header 'date str))
((= comma 3) (parse-rfc-822-date str space zone-offset))
(else (parse-rfc-850-date str comma space zone-offset))))
(parse-asctime-date str)))))
(define (write-date date port)
(define (display-digits n digits port)

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

@ -216,6 +216,9 @@
(pass-if-parse date "Tue, 15 Nov 1994 08:12:31 GMT"
(string->date "Tue, 15 Nov 1994 08:12:31 +0000"
"~a, ~d ~b ~Y ~H:~M:~S ~z"))
(pass-if-parse date "Tue, 15 Nov 1994 16:12:31 +0800"
(string->date "Tue, 15 Nov 1994 08:12:31 +0000"
"~a, ~d ~b ~Y ~H:~M:~S ~z"))
(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"))