From 30062d25df68442cad7a651a2d18b6fbca824b27 Mon Sep 17 00:00:00 2001 From: sperber Date: Tue, 21 Jan 2003 12:45:54 +0000 Subject: [PATCH] Add RFC822-TIME->STRING to RFC 822 and use that instead of the old and broken code that was part of the Web server. --- doc/latex/rfc822.tex | 12 ++++++++++++ scheme/httpd/core.scm | 2 +- scheme/httpd/response.scm | 4 ---- scheme/lib/rfc822.scm | 3 +++ scheme/packages.scm | 8 ++++---- 5 files changed, 20 insertions(+), 9 deletions(-) diff --git a/doc/latex/rfc822.tex b/doc/latex/rfc822.tex index f064f8a..d5be6c9 100644 --- a/doc/latex/rfc822.tex +++ b/doc/latex/rfc822.tex @@ -89,6 +89,18 @@ the same form as they were originally provided. and \ex{read-rfc822-field-with-line-breaks}. \end{desc} +\defun{rfc822-time->string}{time}{string} +\begin{desc} + This formats a time value (as returned by scsh's \ex{time}) + according to the requirements of the RFC~822 \ex{Date} header + field. The format looks like this: +% +\begin{verbatim} +Sun, 06 Nov 1994 08:49:37 GMT +\end{verbatim} +\end{desc} + + %%% Local Variables: %%% mode: latex %%% TeX-master: "man" diff --git a/scheme/httpd/core.scm b/scheme/httpd/core.scm index bc5cac3..d942b35 100644 --- a/scheme/httpd/core.scm +++ b/scheme/httpd/core.scm @@ -327,7 +327,7 @@ (send-http-header-fields (list (cons 'server (string-append "Scheme Untergrund " sunet-version-identifier)) (cons 'content-type (response-mime response)) - (cons 'date (time->http-date-string (response-seconds response)))) + (cons 'date (rfc822-time->string (response-seconds response)))) port) (send-http-header-fields (response-extras response) port) diff --git a/scheme/httpd/response.scm b/scheme/httpd/response.scm index d239a2a..79cd524 100644 --- a/scheme/httpd/response.scm +++ b/scheme/httpd/response.scm @@ -244,10 +244,6 @@ response of a gateway.~%") (format out "~%~%~A~%~%~%~%" message) (format out "~%

~A

~%" message)) -(define (time->http-date-string time) - (format-date "~A, ~d-~b-~y ~H:~M:~S GMT" (date time 0))) - - ;; Creates a redirect response. The server will serve the new file indicated by ;; NEW-LOCATION. NEW-LOCATION must be uri-encoded and begin with a slash. (define (make-redirect-response new-location) diff --git a/scheme/lib/rfc822.scm b/scheme/lib/rfc822.scm index d4355a6..cb0a472 100644 --- a/scheme/lib/rfc822.scm +++ b/scheme/lib/rfc822.scm @@ -108,3 +108,6 @@ (make-read-rfc822-headers read-rfc822-field)) (define read-rfc822-headers-with-line-breaks (make-read-rfc822-headers read-rfc822-field-with-line-breaks)) + +(define (rfc822-time->string time) + (format-date "~a, ~d ~b ~Y ~H:~M:~S GMT" (date time 0))) diff --git a/scheme/packages.scm b/scheme/packages.scm index 6a7afd0..ef66451 100644 --- a/scheme/packages.scm +++ b/scheme/packages.scm @@ -44,7 +44,8 @@ (export read-rfc822-headers read-rfc822-headers-with-line-breaks read-rfc822-field - read-rfc822-field-with-line-breaks)) + read-rfc822-field-with-line-breaks + rfc822-time->string)) (define-interface uri-interface (export parse-uri @@ -297,8 +298,7 @@ number->status-code make-error-response - make-redirect-response - time->http-date-string)) + make-redirect-response)) (define-interface httpd-basic-handlers-interface (export make-predicate-handler @@ -557,7 +557,7 @@ thread-fluids ; fork-thread receiving crlf-io ; write-crlf, read-crlf-line - rfc822 ; read-rfc822-headers + rfc822 handle ; ignore-errors conditions ; condition-stuff uri