diff options
author | Daniel Hartwig <mandyke@gmail.com> | 2013-03-15 22:25:10 +0800 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-03-27 18:09:49 +0100 |
commit | ffc8eca636a8e9311d35c9adba2fc80476ab11ca (patch) | |
tree | 6a5a0c2de4e92e2029ae8ce7fa00f5aa36838098 /module/web/http.scm | |
parent | c548da6949fef565dd1267afa5bbf2c21edda366 (diff) | |
download | guile-ffc8eca636a8e9311d35c9adba2fc80476ab11ca.tar.gz |
web http: parse numeric time zones in headers
* 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>
Diffstat (limited to 'module/web/http.scm')
-rw-r--r-- | module/web/http.scm | 61 |
1 files changed, 46 insertions, 15 deletions
diff --git a/module/web/http.scm b/module/web/http.scm index b5202b69c..35169ef5c 100644 --- a/module/web/http.scm +++ b/module/web/http.scm @@ -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) |