Adjusted `standard-response-body' to take the server as an additional

parameter.  This is part of an ongoing drive to restructure standard
message generation to be more modular.  Still lots to be done...
This commit is contained in:
2000-10-09 22:53:46 +00:00
parent 932ce6a843
commit 5e8ff59588

View File

@ -24,22 +24,24 @@
(make-instance 'string-entity
:content-type "text/html"
:body
(apply #'standard-response-body status-code args))
(apply #'standard-response-body
(http-message-server request)
status-code args))
args))
(defgeneric standard-response-body (status-code &rest args))
(defgeneric standard-response-body (server status-code &rest args))
(defmethod standard-response-body (status-code &rest args)
(declare (ignore args))
(format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~3D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~:*~A</H1>~%</BODY></HTML>~%"
(defmethod standard-response-body (server status-code &rest args)
(declare (ignore server args))
(format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~3D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~2:*~3D ~A</H1>~%</BODY></HTML>~%"
status-code
(HTTP-Code-Description status-code)))
(defmethod standard-response-body
((status-code (eql +HTTP-Code-Moved-Temporarily+)) &rest args
(server (status-code (eql +HTTP-Code-Moved-Temporarily+)) &rest args
&key location)
(declare (ignore args))
(format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~3D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~:*~A</H1>~%<P>The new location is <A HREF=\"~A\">~:*~A</A>.</P>~%</BODY></HTML>~%"
(declare (ignore server args))
(format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~3D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~2:*~3D ~A</H1>~%<P>The new location is <A HREF=\"~A\">~:*~A</A>.</P>~%</BODY></HTML>~%"
status-code
(HTTP-Code-Description status-code)
location))