From 2fbc5a621d31d38e46f18125b067878b3e65cd1b Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Sat, 22 Jul 2000 00:42:03 +0000 Subject: [PATCH] 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. --- src/main/responses.cl | 45 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 src/main/responses.cl diff --git a/src/main/responses.cl b/src/main/responses.cl new file mode 100644 index 0000000..61d4351 --- /dev/null +++ b/src/main/responses.cl @@ -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 "~%~%~3D ~A~%~%~%

~:*~A

~%~%" + 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 "~%~%~3D ~A~%~%~%

~:*~A

~%

The new location is ~:*~A.

~%~%" + status-code + (HTTP-Code-Description status-code) + location))