Changes that bring CLASH up to extended HTTP/1.0 support:

Added interface to directly export resources from a server.
Restructured code and added HTTP/1.0 support.  Various miscellaneous
changes.

src/main/server.cl

@@ -16,6 +16,20 @@
 (defclass http-server ()
   ((namespace :initarg :namespace :accessor http-server-namespace)))
 
+(defgeneric export-resource (server url resource-class &rest initargs)
+  (:documentation
+   "Create an instance of the given `resource-class' using the
+supplied `initargs', and add the created resource to the namespace of
+the given `server' at the given `url' and return it."))
+
+(defmethod export-resource
+    ((server http-server) url resource-class &rest initargs)
+  (namespace-add-url (http-server-namespace server)
+		     (ctypecase url
+		       (url url)
+		       (string (parse-url-from-string url)))
+		     (apply #'make-instance resource-class initargs)))
+
 (defgeneric serve-connection (server connection)
   (:documentation
    "Let the server serve the connection.  The
@@ -68,6 +82,18 @@ passed to `make-instance'."))
   (:documentation
    "Forward the calculated response object to the connection."))
 
+(defgeneric write-response-to-request (server connection response)
+  (:method :before (server connection response)
+	   (declare (ignorable server response))
+	   (setf (connection-state connection) :write-request))
+  (:method :after (server connection response)
+	   (declare (ignorable server response))
+	   (setf (connection-state connection) :idle))
+  (:documentation
+   "Forward the calculated response object to the connection."))
+
+
+
 (defgeneric handle-server-error (server connection condition)
   (:documentation
    "Handle the condition that occurred while server served the given
@@ -86,39 +112,33 @@ connection."))
 				    condition))))
 	   ,@body)))))
 
-(defclass http-server/0.9 (http-server)
+;;; Simple Server
-  ()
-  (:default-initargs :namespace (make-instance 'simple-namespace)))
 
-(defmethod serve-connection ((server http-server/0.9) connection)
+(defclass simple-http-server (http-server)
+  ())
+
+(defmethod serve-connection ((server simple-http-server) connection)
   (with-server-handler (server connection)
     (let* ((request (read-request server connection))
 	   (response (serve-request server request)))
       (write-response server connection response)))
   (close-connection connection))
 
-(defmethod read-request ((server http-server/0.9) connection)
+(defmethod read-request ((server simple-http-server) connection)
   (parse-request server (connection-stream connection)))
 
-(defmethod get-request-class-using-server ((server http-server/0.9) version)
+(defmethod serve-request ((server simple-http-server) request)
-  (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))))
     (unless resource
       (error 'clash-error :code +HTTP-Code-Not-Found+))
     (access-resource resource request)))
 
-(defmethod write-response ((server http-server/0.9) connection response)
+(defmethod write-response ((server simple-http-server) connection response)
   (princ response (connection-stream connection)))
 
-(defmethod write-response :after ((server http-server/0.9) connection response)
-  (declare (ignorable server response))
-  (setf (connection-state connection) :finished))
-
 (defmethod create-response-using-server
-    ((server http-server/0.9) request status-code &rest args)
+    ((server simple-http-server) request status-code &rest args)
   (apply #'make-instance
 	 (get-response-class-using-server server request)
 	 :server server
@@ -126,8 +146,23 @@ connection."))
 	 :status-code status-code
 	 args))
 
+;;; Basic 0.9 server
+
+(defclass http-server/0.9 (simple-http-server)
+  ()
+  (:default-initargs :namespace (make-instance 'hierarchical-namespace)))
+
+(defmethod get-request-class-using-server ((server http-server/0.9) version)
+  (declare (ignore version))
+  (find-class 'request/0.9))
+
+(defmethod write-response :after ((server http-server/0.9) connection response)
+  (declare (ignorable server response))
+  (setf (connection-state connection) :finished))
+
 (defmethod get-response-class-using-server ((server http-server/0.9) request)
-  (get-response-class (get-http-version 0 9)))
+  (declare (ignore request))
+  (find-class 'response/0.9))
 
 (defmethod handle-server-error ((server http-server/0.9) connection condition)
   (ignore-errors
@@ -137,9 +172,72 @@ connection."))
 		     :status-code
 		     +HTTP-Code-Internal-Server-Error+
 		     :entity
-		     (make-instance 'simple-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)))))
       (write-response server connection response)))
   (throw 'exit-connection nil))
+
+
+;;;; HTTP/1.0
+
+(defclass http-server/1.0 (simple-http-server)
+  ()
+  (:default-initargs :namespace (make-instance 'hierarchical-namespace)))
+
+(defmethod get-request-class-using-server
+    ((server http-server/1.0) (version (eql (get-http-version 0 9))))
+  (find-class 'request/0.9))
+
+(defmethod get-request-class-using-server
+    ((server http-server/1.0) (version null))
+  (find-class 'request/0.9))
+
+(defmethod get-request-class-using-server
+    ((server http-server/1.0) version)
+  (if (= 1 (http-version-major version))
+      (find-class 'request/1.0)
+      (error 'clash-error :code +HTTP-Code-HTTP-Version-Not-Supported+)))
+
+(defmethod get-response-class-using-server
+    ((server http-server/1.0) (request request/0.9))
+  (find-class 'response/0.9))
+
+(defmethod get-response-class-using-server
+    ((server http-server/1.0) (request request/1.0))
+  (find-class 'response/1.0))
+
+(defmethod handle-server-error ((server http-server/1.0) connection condition)
+  (ignore-errors
+    (let ((response
+	   (typecase condition
+	     (clash-error
+	      (apply #'make-instance
+		     'response/1.0
+		     :server server
+		     :status-code (clash-error-code condition)
+		     :entity
+		     (apply #'make-instance
+			    'string-entity
+			    :body
+			    (format nil "<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">~%<HTML><HEAD>~%<TITLE>~D ~A</TITLE>~%</HEAD>~%<BODY>~%<H1>~A</H1>~%<P>~A</P>~%</BODY></HTML>"
+				    (clash-error-code condition)
+				    (HTTP-Code-Description (clash-error-code condition))
+				    (HTTP-Code-Description (clash-error-code condition))
+				    (HTTP-Code-Description (clash-error-code condition)))
+			    (clash-error-entity-initargs condition))
+		     (clash-error-response-initargs condition)))
+	     (error
+	      (make-instance
+	       'response/1.0
+	       :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)))))))
+      (write-response server connection response)))
+  (throw 'exit-connection nil))