OSCL/CLASH
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improved error response generation. We now keep track of the last

Browse Source 
request read on a connection, which allows us to generate the correct
type of response in case of an error which is handled through
`handle-server-error'.

Also added code to correctly escape text that is inserted into error
messages.  This is also a first step towards preventing cross-scripting
attacks through CLASH, although most of the code still has to be audited
for unfiltered passing through of user-supplied text.
This commit is contained in:
Pierre R. Mai
2001-02-07 14:06:14 +00:00
parent 57583b37ce
commit a803c62958
4 changed files with 56 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

51
src/main/server.cl
View File

@ -92,7 +92,8 @@ passed to `make-instance'."))
(:documentation
"Forward the calculated response object to the connection."))
(defgeneric get-error-response-class-using-server (server connection condition)
(:documentation "Calculate the response class for the error response."))
(defgeneric handle-server-error (server connection condition)
(:documentation
@ -160,6 +161,13 @@ Server Response-Header."))
:status-code status-code
args))
(defmethod get-error-response-class-using-server (server connection condition)
(declare (ignore condition))
(let ((last-request (connection-last-request connection)))
(if last-request
(get-response-class-using-server server last-request)
(find-class 'response/0.9))))
;;; Basic 0.9 server
(defclass http-server/0.9 (simple-http-server)
@ -180,16 +188,18 @@ Server Response-Header."))
(defmethod handle-server-error ((server http-server/0.9) connection condition)
(ignore-errors
(let ((response (make-instance
'response/0.9
:server server
:status-code
+HTTP-Code-Internal-Server-Error+
:entity
(make-instance 'string-entity
:body
(format nil
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>500 Internal Server Error</TITLE>~%</HEAD>~%<BODY>~%<H1>Internal Server Error</H1>~%<P>An internal server error occured:</P>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>" condition)))))
(let ((response
(make-instance
(get-error-response-using-server server connection condition)
:server server
:status-code +HTTP-Code-Internal-Server-Error+
:entity
(make-instance 'string-entity
:body
(format nil
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>500 Internal Server Error</TITLE>~%</HEAD>~%<BODY>~%<H1>Internal Server Error</H1>~%<P>An internal server error occured:</P>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>"
(escape-text-for-html
(princ-to-string condition)))))))
(write-response server connection response)))
(throw 'exit-connection nil))
@ -228,7 +238,8 @@ Server Response-Header."))
(typecase condition
(clash-error
(apply #'make-instance
'response/1.0
(get-error-response-class-using-server
server connection condition)
:server server
:status-code (clash-error-code condition)
:entity
@ -237,20 +248,24 @@ Server Response-Header."))
:body
(format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~3D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~2:*~3D ~A</H1>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>"
(clash-error-code condition)
(HTTP-Code-Description (clash-error-code condition))
condition)
(HTTP-Code-Description
(clash-error-code condition))
(escape-text-for-html
(princ-to-string condition)))
(clash-error-entity-initargs condition))
(clash-error-response-initargs condition)))
(error
(make-instance
'response/1.0
(get-error-response-class-using-server
server connection condition)
:server server
:status-code
+HTTP-Code-Internal-Server-Error+
:status-code +HTTP-Code-Internal-Server-Error+
:entity
(make-instance 'string-entity
:body
(format nil
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>500 Internal Server Error</TITLE>~%</HEAD>~%<BODY>~%<H1>Internal Server Error</H1>~%<P>An internal server error occured:</P>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>" condition)))))))
"<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>500 Internal Server Error</TITLE>~%</HEAD>~%<BODY>~%<H1>Internal Server Error</H1>~%<P>An internal server error occured:</P>~%<PRE>~%~A~%</PRE>~%</BODY></HTML>"
(escape-text-for-html
(princ-to-string condition)))))))))
(write-response server connection response)))
(throw 'exit-connection nil))