From e4c22e732cb5fc575d6f78253ab5e0877031b621 Mon Sep 17 00:00:00 2001
From: "Pierre R. Mai" <pmai@pmsf.de>
Date: Mon, 9 Oct 2000 22:01:14 +0000
Subject: [PATCH] Added driver for LispWorks for Windows/Linux.  This hasn't
 received much testing, but should work out alright.

---
 src/drivers/simple-lwl.cl | 53 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100755 src/drivers/simple-lwl.cl

diff --git a/src/drivers/simple-lwl.cl b/src/drivers/simple-lwl.cl
new file mode 100755
index 0000000..62d5439
--- /dev/null
+++ b/src/drivers/simple-lwl.cl
@@ -0,0 +1,53 @@
+;;;; CLASH --- The Common Lisp Adaptable Simple HTTP server
+;;;; This is copyrighted software.  See documentation for terms.
+;;;; 
+;;;; simple-lwl.cl --- Simple driver for LispWorks for Linux
+;;;; 
+;;;; Checkout Tag: $Name$
+;;;; $Id$
+
+(in-package :CLASH)
+
+;;;; %File Description:
+;;;; 
+;;;; 
+;;;; 
+
+(defclass lwl-connection (connection)
+  ((stream :initarg :stream :reader connection-stream)))
+
+(defmethod initialize-instance :after
+    ((instance lwl-connection) &rest initargs &key socket)
+  (declare (ignore initargs))
+  (setf (slot-value instance 'stream)
+	(make-instance 'comm:socket-stream
+		       :socket socket
+		       :direction :io
+		       :element-type 'base-char)))
+
+(defmethod connection-address ((connection lwl-connection))
+  (comm:ip-address-string
+   (comm:socket-stream-peer-address (connection-stream connection))))
+
+(defmethod connection-hostname ((connection lwl-connection))
+  (connection-address connection))
+  
+(defmethod close-connection ((connection lwl-connection))
+  (ignore-errors
+    (let ((stream (connection-stream connection)))
+      (finish-output stream)
+      (close stream))))
+
+(defun start-http-handler (fd server)
+  (let ((connection (make-instance 'lwl-connection :socket fd)))
+    (mp:process-run-function (format nil "HTTP connection from ~A"
+				     (connection-address connection))
+			     nil
+			     #'serve-connection
+			     server connection)))
+
+(defun start-http-listener (port server)
+  (comm:start-up-server :service port
+                        :function
+                        #'(lambda (fd) (start-http-handler fd server))))
+