Pierre R. Mai
2fbc5a621d
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.
46 lines
1.4 KiB
Common Lisp
46 lines
1.4 KiB
Common Lisp
;;;; 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))
|