scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add RFC822-TIME->STRING to RFC 822 and use that instead of the old and 

broken code that was part of the Web server.
This commit is contained in:
sperber 2003-01-21 12:45:54 +00:00
parent 7fb6f21b4e
commit 30062d25df
5 changed files with 20 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
doc/latex/rfc822.tex
View File

@ -89,6 +89,18 @@ the same form as they were originally provided.
and \ex{read-rfc822-field-with-line-breaks}. and \ex{read-rfc822-field-with-line-breaks}.
\end{desc} \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: %%% Local Variables:
%%% mode: latex %%% mode: latex
%%% TeX-master: "man" %%% TeX-master: "man"

2
scheme/httpd/core.scm
View File

@ -327,7 +327,7 @@
(send-http-header-fields (send-http-header-fields
(list (cons 'server (string-append "Scheme Untergrund " sunet-version-identifier)) (list (cons 'server (string-append "Scheme Untergrund " sunet-version-identifier))
(cons 'content-type (response-mime response)) (cons 'content-type (response-mime response))
(cons 'date (time->http-date-string (response-seconds response)))) (cons 'date (rfc822-time->string (response-seconds response))))
port) port)
(send-http-header-fields (response-extras response) port) (send-http-header-fields (response-extras response) port)

4
scheme/httpd/response.scm
View File

@ -244,10 +244,6 @@ response of a gateway.~%")
(format out "<HEAD>~%<TITLE>~%~A~%</TITLE>~%</HEAD>~%~%" message) (format out "<HEAD>~%<TITLE>~%~A~%</TITLE>~%</HEAD>~%~%" message)
(format out "<BODY>~%<H1>~A</H1>~%" message)) (format out "<BODY>~%<H1>~A</H1>~%" 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 ;; 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. ;; NEW-LOCATION. NEW-LOCATION must be uri-encoded and begin with a slash.
(define (make-redirect-response new-location) (define (make-redirect-response new-location)

3
scheme/lib/rfc822.scm
View File

@ -108,3 +108,6 @@
(make-read-rfc822-headers read-rfc822-field)) (make-read-rfc822-headers read-rfc822-field))
(define read-rfc822-headers-with-line-breaks (define read-rfc822-headers-with-line-breaks
(make-read-rfc822-headers read-rfc822-field-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)))

8
scheme/packages.scm
View File

@ -44,7 +44,8 @@
(export read-rfc822-headers (export read-rfc822-headers
read-rfc822-headers-with-line-breaks read-rfc822-headers-with-line-breaks
read-rfc822-field read-rfc822-field
read-rfc822-field-with-line-breaks)) read-rfc822-field-with-line-breaks
rfc822-time->string))
(define-interface uri-interface (define-interface uri-interface
(export parse-uri (export parse-uri
@ -297,8 +298,7 @@
number->status-code number->status-code
make-error-response make-error-response
make-redirect-response make-redirect-response))
time->http-date-string))
(define-interface httpd-basic-handlers-interface (define-interface httpd-basic-handlers-interface
(export make-predicate-handler (export make-predicate-handler
@ -557,7 +557,7 @@
thread-fluids ; fork-thread thread-fluids ; fork-thread
receiving receiving
crlf-io ; write-crlf, read-crlf-line crlf-io ; write-crlf, read-crlf-line
rfc822 ; read-rfc822-headers rfc822
handle ; ignore-errors handle ; ignore-errors
conditions ; condition-stuff conditions ; condition-stuff
uri uri