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

Consolidated the event-driven CMU CL driver code and the
multi-processing CMU CL driver so that they share common code, like
the newly introduced connection sub-class and related methods.

src/drivers/simple-cmu.cl

@@ -10,8 +10,11 @@
 
 ;;;; %File Description:
 ;;;; 
+;;;; Simple MP and EVENT-driven drivers for CMU CL
 ;;;; 
-;;;; 
+
+
+;;; Connection handling
 
 (defun ip-address-string (address)
   (format nil "~D.~D.~D.~D"
@@ -20,6 +23,68 @@
 	  (ldb (byte 8 8)  address)
 	  (ldb (byte 8 0)  address)))
 
+(defclass cmucl-connection (connection)
+  ((binary-address :initarg :binary-address)
+   (stream :initarg :stream :reader connection-stream)))
+
+(defmethod initialize-instance :after
+    ((instance cmucl-connection) &rest initargs &key socket)
+  (declare (ignore initargs))
+  (setf (slot-value instance 'stream)
+	(sys:make-fd-stream socket :input t :output t
+			    #-MP :buffering #-MP :none)))
+
+(defmethod connection-address ((connection cmucl-connection))
+  (ip-address-string (slot-value connection 'binary-address)))
+
+(defmethod connection-hostname ((connection cmucl-connection))
+  (let* ((address (slot-value connection 'binary-address))
+	 (host-entry (ext:lookup-host-entry address)))
+    (if host-entry
+	(ext:host-entry-name host-entry)
+	(ip-address-string address))))
+
+(defmethod close-connection ((connection cmucl-connection))
+  (ignore-errors
+    (let ((stream (connection-stream connection)))
+      (finish-output stream)
+      (close stream))))
+
+;;; Event-driven handler
+
+#-MP
+(defvar *fd-handlers* (make-hash-table))
+
+#-MP
+(defvar *fd-addresses* (make-hash-table))
+
+#-MP
+(defun start-http-listener (port server)
+  (labels ((read-handler (socket)
+	     (let ((address (gethash socket *fd-addresses*)))
+	       (system:remove-fd-handler (gethash socket *fd-handlers*))
+	       (remhash socket *fd-handlers*)
+	       (remhash socket *fd-addresses*)
+	       (serve-connection server
+				 (make-instance 'cmucl-connection
+						:socket socket
+						:binary-address address))))
+	   (accept-handler (listener)
+	     (multiple-value-bind (socket remote-host)
+		 (ext:accept-tcp-connection listener)
+	       (setf (gethash socket *fd-addresses*) remote-host
+		     (gethash socket *fd-handlers*)
+		     (system:add-fd-handler socket :input #'read-handler)))))
+    (let ((fd (ext:create-inet-listener port)))
+      (setf (gethash fd *fd-handlers*)
+	    (system:add-fd-handler fd :input #'accept-handler)))))
+
+#-MP
+(defun initialize-clash (&optional idle-process)
+  (declare (ignore idle-process))
+  t)
+
+#+MP
 (defun http-listener (port server)
   (let ((fd (ext:create-inet-listener port)))
     (unless fd (error "Cannot bind port ~D." port))
@@ -42,10 +107,10 @@
 		 #+CLASH-DEBUG
 		 (format t "~&;;; At ~D Have Connection...~%"
 			 (get-internal-real-time))
-		 (let* ((host-entry (ext:lookup-host-entry remote-host))
+		 (let ((connection
-			(stream (sys:make-fd-stream new-fd :input t :output t))
+			(make-instance 'cmucl-connection
-			(connection (make-instance 'simple-connection
+				       :socket new-fd
-						   :stream stream)))
+				       :binary-address remote-host)))
 		   #+CLASH-DEBUG
 		   (format t "~&;;; At ~D Established Connection...~%"
 			   (get-internal-real-time))
@@ -53,13 +118,13 @@
 		    #'(lambda ()
 			(serve-connection server connection))
 		    :name (format nil "HTTP connection from ~A"
-				  (if host-entry
+				  (connection-hostname connection)))))))
-				      (ext:host-entry-name host-entry)
-				      (ip-address-string remote-host))))))))
       (when fd (unix:unix-close fd)))))
 
+#+MP
 (defun start-http-listener (port server)
   (make-process #'(lambda () (http-listener port server))))
 
+#+MP
 (defun initialize-clash (&optional (idle-process mp::*initial-process*))
   (setf mp::*idle-process* idle-process))