web http: fix Ma -> Mar

[bpt/guile.git] / module / web / http.scm

diff --git a/module/web/http.scm b/module/web/http.scm
index dc742a1..879923f 100644 (file)
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -1,6 +1,6 @@
 ;;; HTTP messages
 
-;; Copyright (C)  2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C)  2010, 2011, 2012 Free Software Foundation, Inc.
 
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -205,7 +205,7 @@ header with name @var{sym}."
 (define (write-header sym val port)
   "Writes the given header name and value to @var{port}.  If @var{sym}
 is a known header, uses the specific writer registered for that header.
-Otherwise the value is written using @var{display}."
+Otherwise the value is written using @code{display}."
   (display (header->string sym) port)
   (display ": " port)
   ((header-writer sym) val port)
@@ -790,7 +790,7 @@ ordered alist."
              port)
     (display-digits (date-day date) 2 port)
     (display (case (date-month date)
-               ((1)  " Jan ") ((2)  " Feb ") ((3)  " Ma ")
+               ((1)  " Jan ") ((2)  " Feb ") ((3)  " Mar ")
                ((4)  " Apr ") ((5)  " May ") ((6)  " Jun ")
                ((7)  " Jul ") ((8)  " Aug ") ((9)  " Sep ")
                ((10) " Oct ") ((11) " Nov ") ((12) " Dec ")
@@ -805,9 +805,6 @@ ordered alist."
     (display-digits (date-second date) 2 port)
     (display " GMT" port)))
 
-(define (write-uri uri port)
-  (display (uri->string uri) port))
-
 (define (parse-entity-tag val)
   (if (string-prefix? "W/" val)
       (cons (parse-qstring val 2) #f)
@@ -1082,7 +1079,18 @@ three values: the method, the URI, and the version."
   "Write the first line of an HTTP request to @var{port}."
   (display method port)
   (display #\space port)
-  (write-uri uri port)
+  (let ((path (uri-path uri))
+        (query (uri-query uri)))
+    (if (not (string-null? path))
+        (display path port))
+    (if query
+        (begin
+          (display "?" port)
+          (display query port)))
+    (if (and (string-null? path)
+             (not query))
+        ;; Make sure we display something.
+        (display "/" port)))
   (display #\space port)
   (write-http-version version port)
   (display "\r\n" port))
@@ -1240,22 +1248,28 @@ phrase\"."
 (declare-key-value-list-header! "Cache-Control"
   (lambda (k v-str)
     (case k
-      ((max-age max-stale min-fresh s-maxage)
+      ((max-age min-fresh s-maxage)
        (parse-non-negative-integer v-str))
+      ((max-stale)
+       (and v-str (parse-non-negative-integer v-str)))
       ((private no-cache)
        (and v-str (split-header-names v-str)))
       (else v-str)))
   (lambda (k v)
     (case k
-      ((max-age max-stale min-fresh s-maxage)
+      ((max-age min-fresh s-maxage)
        (non-negative-integer? v))
+      ((max-stale)
+       (or (not v) (non-negative-integer? v)))
       ((private no-cache)
        (or (not v) (list-of-header-names? v)))
+      ((no-store no-transform only-if-cache must-revalidate proxy-revalidate)
+       (not v))
       (else
-       (not v))))
+       (or (not v) (string? v)))))
   (lambda (k v port)
     (cond
-     ((string? v) (display v port))
+     ((string? v) (default-val-writer k v port))
      ((pair? v)
       (display #\" port)
       (write-header-list v port)
@@ -1500,7 +1514,15 @@ phrase\"."
 
 ;; Expires = HTTP-date
 ;;
-(declare-date-header! "Expires")
+(define *date-in-the-past* (parse-date "Thu, 01 Jan 1970 00:00:00 GMT"))
+
+(declare-header! "Expires"
+  (lambda (str)
+    (if (member str '("0" "-1"))
+        *date-in-the-past*
+        (parse-date str)))
+  date?
+  write-date)
 
 ;; Last-Modified = HTTP-date
 ;;