Changeset 14572 in project


Ignore:
Timestamp:
05/09/09 15:59:28 (10 years ago)
Author:
sjamaan
Message:

Implement http-date unparsers. Change all date unparsers to http-date-unparsers

Location:
release/4/intarweb/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/header-parsers.scm

    r14429 r14572  
    6969    (if (null? contents)
    7070        default
    71         (vector-ref (car contents) 0))))
     71        (get-value (car contents)))))
    7272
    7373;; Get the value from one header entry
     
    281281
    282282;; rfc1123-date | rfc850-date | asctime-date
    283 (define (http-time-parser str)
     283(define (http-date-parser str)
    284284  (or (rfc1123-string->time str)
    285285      (rfc850-string->time str)
    286286      (asctime-string->time str)
    287287      (signal-http-condition "Error parsing date/time"
    288                              'http-time-parser 'value str)))
     288                             'http-date-parser 'value str)))
    289289
    290290;; [W/]<string>
     
    333333(define if-range-parser identity)
    334334
    335 ;; Either delta-seconds or RFC1123 timestamp
     335;; Either delta-seconds or http-date
    336336(define (retry-after-parser contents)
    337337  (if (string-match "[ \t]*[0-9]+[ \t]*" contents)
    338338      (natnum-parser contents)
    339       (rfc1123-parser contents)))
     339      (http-date-parser contents)))
    340340
    341341;; Tricky - see 2616 14.45
     
    517517                    "")))
    518518        (get-value (car header-contents)))))
     519
     520(define (rfc1123-unparser header-name header-contents)
     521  (let-locale ((LC_TIME "POSIX"))
     522              (time->string (get-value (car header-contents))
     523                            "%a, %d %b %Y %X GMT")))
  • release/4/intarweb/trunk/intarweb.scm

    r14429 r14572  
    265265     (content-range . ,(single range-parser))
    266266     (content-type . ,(single symbol-parser-ci))
    267      (date . ,(single http-time-parser))
     267     (date . ,(single http-date-parser))
    268268     (etag . ,entity-tag-parser)
    269269     (expect . ,(single key/values))
    270      (expires . ,(single rfc1123-parser))
     270     (expires . ,(single http-date-parser))
    271271     (from . ,(multiple mailbox-parser))
    272272     (host . ,(single host-parser))
    273273     (if-match . ,(multiple entity-tag-parser))
    274      (if-modified-since . ,(single rfc1123-parser))
     274     (if-modified-since . ,(single http-date-parser))
    275275     (if-none-match . ,(multiple entity-tag-parser))
    276276     (if-range . ,(multiple if-range-parser))
    277      (if-unmodified-since . ,(single rfc1123-parser))
    278      (last-modified . ,(single rfc1123-parser))
     277     (if-unmodified-since . ,(single http-date-parser))
     278     (last-modified . ,(single http-date-parser))
    279279     (location . ,(single normalized-uri))
    280280     (max-forwards . ,(single natnum-parser))
     
    396396  (make-parameter
    397397   `((etag . ,entity-tag-unparser)
     398     (expires . ,rfc1123-unparser)
    398399     (host . ,host-unparser)
     400     (if-modified-since . ,rfc1123-unparser)
     401     (if-unmodified-since . ,rfc1123-unparser)
     402     (last-modified . ,rfc1123-unparser)
    399403     (user-agent . ,product-unparser)
    400404     (server . ,product-unparser))))
  • release/4/intarweb/trunk/tests/run.scm

    r14429 r14572  
    180180            (header-value 'content-range headers))))
    181181
    182   (test-group "http-time-parser"
     182  (test-group "http-date-parser"
    183183    (let ((headers (test-read-headers "Date: Sun, 06 Nov 1994 08:49:37 GMT")))
    184184      (test "RFC1123 time"
     
    377377          "Etag: \"W/blah\"\r\n"
    378378          (test-unparse-headers `((etag (strong . "W/blah"))))))
     379  ;; http-dates are all deserialized as rfc1123
     380  (test-group "Date/time unparser"
     381    (test "RFC1123 time"
     382          "If-Modified-Since: Sun, 06 Nov 1994 08:49:37 GMT\r\n"
     383          ;; Having to specify a vector here twice is sucky and counter-intuitive
     384          (test-unparse-headers
     385           `((if-modified-since #(#(37 49 08 06 10 94 0 310 #f 0) ()))))))
    379386  (test-group "Host unparser"
    380387    (test "Default port is 80, left out"
Note: See TracChangeset for help on using the changeset viewer.