From 89f92b208a053ba9a242c054b9905a38b1ee3c52 Mon Sep 17 00:00:00 2001 From: "Taylor R. Campbell" Date: Wed, 18 Feb 2009 07:57:41 +0000 Subject: [PATCH] Fix parsing and unparsing XML-RPC's `dateTime.iso8601' format, which might be a confused, bastard hybrid of ISO 8601's extended and basic formats without time zones, depending on how strictly one reads the `specification'. Accept liberally, generate conservatively, &c. Yechhh. --- v7/src/runtime/datime.scm | 92 +++++++++++++++++++++++++++++++------- v7/src/runtime/runtime.pkg | 10 +++-- v7/src/xml/xml-rpc.scm | 6 +-- 3 files changed, 85 insertions(+), 23 deletions(-) diff --git a/v7/src/runtime/datime.scm b/v7/src/runtime/datime.scm index 23ab380a1..134fe2d2c 100644 --- a/v7/src/runtime/datime.scm +++ b/v7/src/runtime/datime.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: datime.scm,v 14.56 2008/10/26 20:14:34 cph Exp $ +$Id: datime.scm,v 14.57 2009/02/18 07:57:41 riastradh Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -519,7 +519,8 @@ USA. ;;; This implements a subset of the ISO 8601 specification. It ;;; accepts only complete date+time representations. It does not ;;; support either truncation or expansion. On output, it uses a -;;; single format. +;;; single format. The XML-RPC `specification' uses a bastard hybrid +;;; of the basic and extended formats -- maybe. (define (iso8601-string->decoded-time string #!optional start end) (let ((v (*parse-string parser:iso8601-date/time string start end))) @@ -527,23 +528,65 @@ USA. (error:bad-range-argument string 'ISO8601-STRING->DECODED-TIME)) (vector-ref v 0))) +(define (xml-rpc-iso8601-string->decoded-time string #!optional start end) + (let ((v (*parse-string parser:xml-rpc-iso8601-date/time string start end))) + (if (not v) + (error:bad-range-argument string + 'XML-RPC-ISO8601-STRING->DECODED-TIME)) + (vector-ref v 0))) + (define (decoded-time->iso8601-string dt) (call-with-output-string (lambda (port) - (write-decoded-time-as-iso8601 dt port)))) + (write-decoded-time-as-iso8601-extended dt port)))) + +(define (decoded-time->xml-rpc-iso8601-string dt) + (call-with-output-string + (lambda (port) + (write-decoded-time-as-xml-rpc-iso8601 dt port)))) + +(define (write-decoded-time-as-iso8601-basic dt port) + (write-decoded-time-iso8601-basic-date dt port) + (write-char #\T port) + (write-decoded-time-iso8601-basic-time dt port) + (write-decoded-time-iso8601-zone dt port)) + +(define (write-decoded-time-as-iso8601-extended dt port) + (write-decoded-time-iso8601-extended-date dt port) + (write-char #\T port) + (write-decoded-time-iso8601-extended-time dt port) + (write-decoded-time-iso8601-zone dt port)) + +(define (write-decoded-time-as-xml-rpc-iso8601 dt port) + (write-decoded-time-iso8601-basic-date dt port) + (write-char #\T port) + (write-decoded-time-iso8601-extended-time dt port)) + +(define (write-decoded-time-iso8601-basic-date dt port) + (write (decoded-time/year dt) port) + (write-d2 (decoded-time/month dt) port) + (write-d2 (decoded-time/day dt) port)) -(define (write-decoded-time-as-iso8601 dt port) +(define (write-decoded-time-iso8601-extended-date dt port) (write (decoded-time/year dt) port) (write-char #\- port) (write-d2 (decoded-time/month dt) port) (write-char #\- port) - (write-d2 (decoded-time/day dt) port) - (write-char #\T port) + (write-d2 (decoded-time/day dt) port)) + +(define (write-decoded-time-iso8601-basic-time dt port) + (write-d2 (decoded-time/hour dt) port) + (write-d2 (decoded-time/minute dt) port) + (write-d2 (decoded-time/second dt) port)) + +(define (write-decoded-time-iso8601-extended-time dt port) (write-d2 (decoded-time/hour dt) port) (write-char #\: port) (write-d2 (decoded-time/minute dt) port) (write-char #\: port) - (write-d2 (decoded-time/second dt) port) + (write-d2 (decoded-time/second dt) port)) + +(define (write-decoded-time-iso8601-zone dt port) (let ((zone (decoded-time/zone dt))) (if zone (let ((minutes @@ -580,18 +623,33 @@ USA. (decoded-time->file-time (iso8601-string->decoded-time string))) (define parser:iso8601-date/time - ;; The ISO spec says that a date/time must be either entirely in - ;; basic format or entirely in extended format. But the XML-RPC - ;; "spec" has usage that's a mix between the formats. Hence we - ;; accept any combination of the two formats. Use of the space - ;; separator isn't allowed, but we used to generate strings with it, - ;; so don't barf if we see it. + ;; Use of the space separator isn't allowed, but we used to generate + ;; strings with it, so don't barf if we see it. + (*parser + (encapsulate convert-8601-date/time + (alt (seq parse-basic-8601-date + (alt "T" " ") + parse-basic-8601-time + parse-basic-8601-zone) + (seq parse-extended-8601-date + (alt "T" " ") + parse-extended-8601-time + parse-extended-8601-zone))))) + +;;; A literal interpretation of the XML-RPC `specification' at +;;; might suggest that the only valid +;;; date/time string is `19980717T14:08:55', which is the solitary +;;; example given for the `dateTime.iso8601' element. Who knows what +;;; bizarre beasts pretending to be ISO 8601 strings might turn up in +;;; the wild? + +(define parser:xml-rpc-iso8601-date/time (*parser (encapsulate convert-8601-date/time - (seq (alt parse-basic-8601-date parse-extended-8601-date) - (alt "T" " ") - (alt parse-basic-8601-time parse-extended-8601-time) - (alt parse-basic-8601-zone parse-extended-8601-zone))))) + (seq (alt parse-extended-8601-date parse-basic-8601-date) + "T" + (alt parse-extended-8601-time parse-basic-8601-time) + (alt parse-extended-8601-zone parse-basic-8601-zone))))) (define (convert-8601-date/time v) (let ((year (vector-ref v 0)) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index c482d5631..2b3f64a59 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.688 2008/09/29 05:41:51 cph Exp $ +$Id: runtime.pkg,v 14.689 2009/02/18 07:57:41 riastradh Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -1280,6 +1280,7 @@ USA. decoded-time->iso8601-string decoded-time->rfc2822-string decoded-time->universal-time + decoded-time->xml-rpc-iso8601-string decoded-time/date-string decoded-time/day decoded-time/day-of-week @@ -1339,9 +1340,12 @@ USA. universal-time->local-rfc2822-string write-decoded-time-as-ctime write-decoded-time-as-http - write-decoded-time-as-iso8601 + (write-decoded-time-as-iso8601 + write-decoded-time-as-iso8601-extended) write-decoded-time-as-rfc2822 - write-time-zone)) + write-decoded-time-as-xml-rpc-iso8601 + write-time-zone + xml-rpc-iso8601-string->decoded-time)) (define-package (runtime debugger) (files "debug") diff --git a/v7/src/xml/xml-rpc.scm b/v7/src/xml/xml-rpc.scm index 8cd8c1663..832b95550 100644 --- a/v7/src/xml/xml-rpc.scm +++ b/v7/src/xml/xml-rpc.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml-rpc.scm,v 1.15 2008/10/02 17:58:05 riastradh Exp $ +$Id: xml-rpc.scm,v 1.16 2009/02/18 07:57:41 riastradh Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -223,7 +223,7 @@ USA. ((nil) #!default) ((|dateTime.iso8601|) - (safe-call iso8601-string->decoded-time (content-string elt))) + (safe-call xml-rpc-iso8601-string->decoded-time (content-string elt))) ((double) (let ((x (string->number (content-string elt)))) (require (and x (flo:flonum? x))) @@ -294,7 +294,7 @@ USA. ((symbol? object) (encode-string (symbol->utf8-string object))) ((decoded-time? object) - (rpc-elt:date-time (decoded-time->iso8601-string object))) + (rpc-elt:date-time (decoded-time->xml-rpc-iso8601-string object))) ((and (pair? object) (list-of-type? object (lambda (item) -- 2.25.1