;;;; 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
(http-message-server request)
status-code args))
args))
(defgeneric standard-response-body (server status-code &rest args))
(defmethod standard-response-body (server status-code &rest args)
(declare (ignore server args))
(format nil "~%~%~3D ~A~%~%~%~2:*~3D ~A
~%~%"
status-code
(HTTP-Code-Description status-code)))
(defmethod standard-response-body
(server (status-code (eql +HTTP-Code-Moved-Temporarily+)) &rest args
&key location)
(declare (ignore server args))
(format nil "~%~%~3D ~A~%~%~%~2:*~3D ~A
~%The new location is ~:*~A.
~%~%"
status-code
(HTTP-Code-Description status-code)
location))