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

-move XHTML stuff from responses.scm to htmlout.scm 

-don't use WRITE-STRING with \n (\n within strings is not in R5RS),
instead use FORMAT with ~%
-use EMIT-PROLOG and EMIT-TAG from htmlout.scm
This commit is contained in:
vibr 2004-08-13 15:37:31 +00:00
parent c089e26e96
commit 96f0ae41d5
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
scheme/httpd/response.scm
View File

@ -164,7 +164,7 @@
(if (not (null? args))
(format port "<br/>~%Further Information:~%"))
(for-each (lambda (x) (format port "<br/>~%~s~%" x)) args)
(write-string "</p>\n</body>\n</html>\n" port)))
(format port "</p>~%</body>~%</html>~%")))
(create-response
(lambda (headers writer-proc)
@ -201,7 +201,7 @@
'()
(lambda (port options)
(generic-title port)
(write-string "The request the client sent could not be understood by this server due to malformed syntax.\n Report to client maintainer.\n" port)
(format port "The request the client sent could not be understood by this server due to malformed syntax.~% Report to client maintainer.~%")
(close-html port extras))))
;; This error response requires one arg:
@ -227,7 +227,7 @@
(list (cons 'WWW-Authenticate (car extras)))
(lambda (port options)
(title-html port "Authentication Required")
(write-string "Client not authentication-capable or authentication failed.\n" port)
(format port "Client not authentication-capable or authentication failed.~%")
(close-html port (cdr extras)))))
((eq? code (status-code forbidden))
@ -235,7 +235,7 @@
'()
(lambda (port options)
(title-html port "Request not allowed.")
(write-string "The request the client sent is not allowed.\n Retrying won't help.\n" port)
(format port "The request the client sent is not allowed.~% Retrying won't help.~%")
(close-html port extras))))
((eq? code (status-code not-found))
@ -243,7 +243,7 @@
'()
(lambda (port options)
(title-html port "Resource not found")
(format port "The requested resource ~A was not found on this server.\n"
(format port "The requested resource ~A was not found on this server.~%"
(http-url->string (request-url req)))
(close-html port extras))))
@ -262,7 +262,7 @@
'()
(lambda (port options)
(generic-title port)
(format port "This server does not recognize or does not implement the requested method \"~A\".~%"
(format port "This server does not recognize or does not implement the requested method ~A.~%"
(request-method req))
(close-html port extras))))
@ -274,13 +274,12 @@
(format port "This server received an invalid response from the upstream server it accessed in attempting to fulfill the request.~%")
(close-html port extras)))))))
(define (title-html out message)
;;produce valid XHTML 1.0 Strict
(write-string
"<?xml version=\"1.0\" encoding=\"iso-8859-1\" ?>
<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">\n" out)
(format out "<head>~%<title>~%~A~%</title>~%</head>~%~%" message)
(emit-prolog out)
(emit-tag out 'html xmlnsdecl-attr)
(format out "~%<head>~%<title>~%~A~%</title>~%</head>~%" message)
(format out "<body>~%<h1>~A</h1>~%<p>~%" message))
;; Creates a redirect response. The server will serve the new file