Changes that bring CLASH up to extended HTTP/1.0 support:

The machinery in this file is used for the automatic creation of
responses in standardized (error) situations based on the information
contained in a condition.
This commit is contained in:
2000-07-22 00:42:03 +00:00
parent a9e2f4c553
commit 2fbc5a621d

45
src/main/responses.cl Normal file
View File

@ -0,0 +1,45 @@
;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
;;;; This is copyrighted software. See documentation for terms.
;;;;
;;;; responses.cl --- Creation of standardized responses
;;;;
;;;; Checkout Tag: $Name$
;;;; $Id$
(in-package :CLASH)
;;;; %File Description:
;;;;
;;;;
;;;;
(defgeneric create-standard-response (request status-code &rest args))
(defmethod create-standard-response ((request request) status-code &rest args)
(apply #'create-response-using-server
(http-message-server request)
request
status-code
:entity
(make-instance 'string-entity
:content-type "text/html"
:body
(apply #'standard-response-body status-code args))
args))
(defgeneric standard-response-body (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>~%"
status-code
(HTTP-Code-Description status-code)))
(defmethod standard-response-body
((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>~%"
status-code
(HTTP-Code-Description status-code)
location))