Pierre R. Mai
5e8ff59588
parameter. This is part of an ongoing drive to restructure standard message generation to be more modular. Still lots to be done...
48 lines
1.5 KiB
Common Lisp
48 lines
1.5 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
|
|
(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 "<!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
|
|
(server (status-code (eql +HTTP-Code-Moved-Temporarily+)) &rest args
|
|
&key location)
|
|
(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))
|