From d9cf8a69652f45a6a4422a9ee411fe3633e6b7ba Mon Sep 17 00:00:00 2001
From: "Pierre R. Mai" <pmai@pmsf.de>
Date: Sun, 19 Sep 1999 12:55:29 +0000
Subject: [PATCH] Modified the selection of request and response classes to
 take into account the server we are servicing, so that each server only sees
 and creates request/response classes he knows he can handle.  This also makes
 it possible to add request/response classes in a running system, and to run
 servers of different versions side-by-side in an image without affecting each
 other...

---
 src/main/messages.cl   |  9 +++++----
 src/main/server.cl     | 20 +++++++++++++++++++-
 src/test/basic-demo.cl |  6 +-----
 3 files changed, 25 insertions(+), 10 deletions(-)

diff --git a/src/main/messages.cl b/src/main/messages.cl
index 8d7e4c1..7b3a443 100644
--- a/src/main/messages.cl
+++ b/src/main/messages.cl
@@ -75,10 +75,11 @@ request object, which references the given server."))
 (defmethod parse-request (server stream)
   (multiple-value-bind (method url version)
       (parse-request-line stream)
-    (let ((request (make-instance (get-request-class version)
-				  :server server
-				  :method method
-				  :url url)))
+    (let ((request (make-instance
+		    (get-request-class-using-server server version)
+		    :server server
+		    :method method
+		    :url url)))
       (parse-request-remainder request stream)
       request)))
 
diff --git a/src/main/server.cl b/src/main/server.cl
index 2a09338..63589b9 100644
--- a/src/main/server.cl
+++ b/src/main/server.cl
@@ -34,6 +34,11 @@ generic function handle-server-error to handle server errors."))
 	   (setf (connection-state connection) :processing-request))
   (:documentation "Read a request from the connection."))
 
+(defgeneric get-request-class-using-server (server version)
+  (:documentation
+   "Based on the version given, return the appropriate class for the
+request."))
+
 (defgeneric serve-request (server request)
   (:documentation
    "Let the server handle the request, creating a valid response
@@ -46,6 +51,13 @@ request, using the detailed information provided by the resource, via
 CREATE-RESPONSE.  A server must implement apropriate methods for this
 generic function, to ensure conformant generation of response messages."))
 
+(defgeneric get-response-class-using-server (server request)
+  (:documentation
+   "Return the class to be used in creating the response object based
+on the server and the class of the request object passed.  This shall
+be used by `create-response-using-server' to determine the class to be
+passed to `make-instance'."))
+
 (defgeneric write-response (server connection response)
   (:method :before (server connection response)
 	   (declare (ignorable server response))
@@ -88,6 +100,9 @@ connection."))
 (defmethod read-request ((server http-server/0.9) connection)
   (parse-request server (connection-stream connection)))
 
+(defmethod get-request-class-using-server ((server http-server/0.9) version)
+  (get-request-class nil))
+
 (defmethod serve-request ((server http-server/0.9) request)
   (let ((resource (namespace-lookup-url (http-server-namespace server)
 					(request-url request))))
@@ -105,12 +120,15 @@ connection."))
 (defmethod create-response-using-server
     ((server http-server/0.9) request status-code &rest args)
   (apply #'make-instance
-	 (get-response-class (get-http-version 0 9))
+	 (get-response-class-using-server server request)
 	 :server server
 	 :request request
 	 :status-code status-code
 	 args))
 
+(defmethod get-response-class-using-server ((server http-server/0.9) request)
+  (get-response-class (get-http-version 0 9)))
+
 (defmethod handle-server-error ((server http-server/0.9) connection condition)
   (ignore-errors
     (let ((response (make-instance
diff --git a/src/test/basic-demo.cl b/src/test/basic-demo.cl
index 8e9c459..1179d42 100644
--- a/src/test/basic-demo.cl
+++ b/src/test/basic-demo.cl
@@ -29,10 +29,6 @@
 	  "~&;;; At ~D Finished serving of ~A~%"
 	  (get-internal-real-time) connection))
 
-;;; Fudge default request class
-(defmethod get-request-class (version)
-  (find-class 'request/0.9))
-
 ;;; Define Server class
 (defclass my-server (http-server/0.9 basic-logging-mixin)
   ())
@@ -55,7 +51,7 @@
   (write-line
    "<IMG SRC=\"pic/logo.jpg\" ALT=\"CLASH Logo\">" s)
   (write-line "</P></CENTER>" s)
-  (write-line "<CENTER><H1>Welcom to CLASH!</H1></CENTER>" s)
+  (write-line "<CENTER><H1>Welcome to CLASH!</H1></CENTER>" s)
   (format s "<HR><P>You are visitor number ~D.</P>" (incf *main-visits*))
   (write-line "</BODY></HTML>" s))