21 lines
729 B
Scheme
21 lines
729 B
Scheme
|
;;; Text generation utilities.
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
|
||
|
|
(define (time->http-date-string time)
|
||
|
|
(format-date "~A, ~d-~b-~y ~H:~M:~S GMT" (date time 0)))
|
||
|
|
|
||
|
|
;;; Output the first chunk of a reply header.
|
||
|
|
|
||
|
|
(define (begin-http-header out reply-code)
|
||
|
|
(format out "~A ~d ~A\r~%"
|
||
|
|
server/protocol reply-code (reply-code->text reply-code))
|
||
|
|
(format out "Date: ~A\r~%" (time->http-date-string (time)))
|
||
|
|
(format out "Server: ~A\r~%" server/version))
|
||
|
|
|
||
|
|
(define (title-html out message new-protocol?)
|
||
|
|
(if new-protocol? (write-crlf out)) ; Separate html from headers.
|
||
|
|
(format out "<HEAD>~%<TITLE>~%~A~%</TITLE>~%</HEAD>~%~%" message)
|
||
|
|
(format out "<BODY>~%<H1>~A</H1>~%" message))
|
||
|
|
|
||
|
|
|