From cb60460c044d8e4c1270b30acd43853ef4ef8f94 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 8 Jul 2003 06:43:29 +0000
Subject: [PATCH] r5250: *** empty log message ***

---
 base.lisp           |  79 +++++++-----
 compat.lisp         | 295 ++++++++++++++++++++++++++++++++++++++++++++
 demo.lisp           |  37 +++++-
 impl-lispworks.lisp |   3 +-
 modlisp.asd         |  11 +-
 package.lisp        |   3 +-
 server.lisp         |  76 ++++++------
 utils.lisp          |  10 +-
 variables.lisp      |  21 ++--
 9 files changed, 442 insertions(+), 93 deletions(-)
 create mode 100644 compat.lisp

diff --git a/base.lisp b/base.lisp
index a72ac57..bcf84b5 100644
--- a/base.lisp
+++ b/base.lisp
@@ -7,26 +7,28 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: base.lisp,v 1.5 2003/07/05 22:59:56 kevin Exp $
+;;;; $Id: base.lisp,v 1.6 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:modlisp)
 
 (defun modlisp-start (&key (port +default-apache-port+)
-			   (function 'demo-apache-command-processor)
-			   (function-args nil))
-  (let ((listener (make-instance 'listener)))
+			   (processor 'demo-apache-command-processor)
+			   (processor-args nil))
+  (let ((listener (make-instance 'listener :port port
+				 :name (next-server-name)
+				 :function 'apache-command-issuer
+				 :function-args (cons processor processor-args)
+				 :format :text
+				 :wait nil)))
     (handler-case
-	(make-socket-server (next-server-name) function port listener
-			    :format :text :wait nil
-			    :function-args function-args)
+	(make-socket-server listener)
       (error (e)
 	(format t "~&Error while trying to start modlisp server~&  ~A" e)
 	(decf *listener-count*)
 	(values nil nil))
-      (:no-error (process socket)
-	(setf (process listener) process)
-	(setf (socket listener) socket)
+      (:no-error (res)
+	(declare (ignore res))
 	(push listener *active-listeners*)
 	listener))))
     
@@ -35,18 +37,21 @@
     (cmsg "listener is NIL in modlisp-stop")
     (return-from modlisp-stop))
   (dolist (worker (workers listener))
-    (close-active-socket (socket worker))
+    (close-active-socket (connection worker))
     (destroy-process (process worker)))
   (setf (workers listener) nil)
   (with-slots (process socket) listener
-    (handler-case
-	  (destroy-process process)
-      (error (e)
-	(format t "~&Error while trying to kill modlisp server~&  ~A" e)))
-    (when socket
-      (ignore-errors (close-passive-socket socket))))
+    (errorset (close-passive-socket socket) t)
+    (errorset (destroy-process process) t))
   (setq *active-listeners* (remove listener *active-listeners*)))
-    
+
+(defun modlisp-stop-all ()
+  (dolist (listener *active-listeners*)
+    (ignore-errors
+     (progn
+       (modlisp-stop listener)
+       (setq *active-listeners* (remove listener *active-listeners*))))))
+
 (defun next-server-name ()
   (format nil "modlisp-socket-server-~d" (incf *listener-count*))) 
 
@@ -57,20 +62,21 @@
       (*number-worker-requests* 0)
       (*close-apache-socket* t))
   
-  (defun apache-command-issuer (*apache-socket* processor-fun &rest args)
+  (defun apache-command-issuer (*apache-socket* processor &rest args)
     "generates commands from apache, issues commands to processor-fun"
     (unwind-protect
 	 (progn
 	   (setq *number-worker-requests* 0)
 	   (do ((command (read-apache-command) (read-apache-command)))
-	       ((null command) 'done)
-	     (apply processor-fun command args)
+	       ((null command))
+	     (apply processor command args)
 	     (force-output *apache-socket*)
 	     (incf *number-worker-requests*)
 	     (incf *number-server-requests*)
 	     (when *close-apache-socket*
 	       (return))))
-      (close *apache-socket*)))
+      (close-active-socket *apache-socket*)))
+  
 
   (defun get-number-worker-requests ()
     *number-worker-requests*)
@@ -83,25 +89,32 @@
   
   ) ;; closure
 
+(defun header-value (header key)
+  (cdr (assoc key header :test #'string=)))
+
 (defun read-apache-command ()
   (ignore-errors
     (let* ((header (read-apache-header))
-	  (content-length (cdr (assoc "content-length" header :test #'equal)))
-	  (content (when content-length 
-		     (make-string
-		      (parse-integer content-length :junk-allowed t)))))
+	   (content-length (header-value header "content-length"))
+	   (content (when content-length 
+		      (make-string
+		       (parse-integer content-length :junk-allowed t)))))
      (when content
        (read-sequence content *apache-socket*)
        (push (cons "posted-content" content) header))
      header)))
 
+(defun read-apache-line ()
+  (kmrcl:string-left-trim-one-char  #\return
+				    (read-line *apache-socket* nil nil)))
+
 (defun read-apache-header ()
-  (loop for key = (read-line *apache-socket* nil nil)
-			while (and key
-				   (string-not-equal key "end")
-				   (> (length key) 1))
-		      for value = (read-line *apache-socket* nil nil)
-		      collect (cons key value)))
+  (loop for key = (read-apache-line)
+      while (and key
+		 (string-not-equal key "end")
+		 (> (length key) 1))
+      for value = (read-apache-line)
+      collect (cons key value)))
 
 (defun write-header-line (key value)
   (write-string key *apache-socket*)
@@ -109,6 +122,4 @@
   (write-string value *apache-socket*)
   (write-char #\NewLine *apache-socket*))
 
-(defun header-value (command key)
-  (cdr (assoc key command :test #'string=)))
 
diff --git a/compat.lisp b/compat.lisp
new file mode 100644
index 0000000..1b6c62f
--- /dev/null
+++ b/compat.lisp
@@ -0,0 +1,295 @@
+;;; -*- Syntax: Ansi-Common-Lisp; Base: 10; Mode: lisp; Package: clit -*-
+;;; $Id: compat.lisp,v 1.1 2003/07/08 06:43:29 kevin Exp $
+
+(in-package #:modlisp)
+
+;; Processes
+
+(defun make-process (name func)
+  #+cmu (mp:make-process func :name name)
+  #+allegro (mp:process-run-function name func)
+  #+lispworks (mp:process-run-function name nil func)
+  #+sb-thread (sb-thread:make-thread func)
+  #+clisp (funcall func)
+  )
+
+(defun destroy-process (process)
+  #+cmu (mp:destroy-process process)
+  #+allegro (mp:process-kill process)
+  #+sbcl-thread (sb-thread:destroy-thread process)
+  #+lispworks (mp:process-kill process)
+  )
+
+(defun make-lock (name)
+  #+allegro (mp:make-process-lock :name name)
+  #+cmu (mp:make-lock name)
+  #+lispworks (mp:make-lock :name name)
+  #+sbcl-thread (sb-thread:make-mutex :name name)
+  )
+
+(defmacro with-lock-held ((lock) &body body)
+  #+allegro
+  `(mp:with-process-lock (,lock) ,@body)
+  #+cmu
+  `(mp:with-lock-held (,lock) ,@body)
+  #+lispworks
+  `(mp:with-lock (,lock) ,@body)
+  #+sbcl-thread
+  `(sb-thread:with-recursive-lock (,lock) ,@body)
+  )
+
+
+;; Sockets
+
+#+lispworks
+(progn
+  (defclass socket ()
+    ((passive-socket :type fixnum
+		     :initarg :passive-socket
+		     :reader socket-os-fd)))
+  
+  (defclass passive-socket (socket)
+    ((element-type :type (member signed-byte unsigned-byte base-char)
+		   :initarg :element-type
+		   :reader element-type)
+     (port :type fixnum
+	   :initarg :port
+	   :reader local-port)))
+
+  (defmethod print-object ((passive-socket passive-socket) stream)
+    (print-unreadable-object (passive-socket stream :type t :identity nil)
+      (format stream "@~d on port ~d" (socket-os-fd passive-socket) (local-port passive-socket))))
+
+  (defclass binary-socket-stream (comm:socket-stream) ())
+(defclass input-binary-socket-stream (binary-socket-stream)())
+(defclass output-binary-socket-stream (binary-socket-stream)())
+(defclass bidirectional-binary-socket-stream (input-binary-socket-stream output-binary-socket-stream)())
+
+#+unix
+(defun %socket-error-identifier (code)
+  (case code
+    (32 :x-broken-pipe)
+    (98 :address-in-use)
+    (99 :address-not-available)
+    (100 :network-down)
+    (102 :network-reset)
+    (103 :connection-aborted)
+    (104 :connection-reset)
+    (105 :no-buffer-space)
+    (108 :shutdown)
+    (110 :connection-timed-out)
+    (111 :connection-refused)
+    (112 :host-down)
+    (113 :host-unreachable)
+    (otherwise :unknown)))
+
+#+win32
+(defun %socket-error-identifier (code)
+  (case code
+    (10048 :address-in-use)
+    (10049 :address-not-available)
+    (10050 :network-down)
+    (10052 :network-reset)
+    (10053 :connection-aborted)
+    (10054 :connection-reset)
+    (10055 :no-buffer-space)
+    (10058 :shutdown)
+    (10060 :connection-timed-out)
+    (10061 :connection-refused)
+    (10064 :host-down)
+    (10065 :host-unreachable)
+    (otherwise :unknown)))
+
+(defun socket-error (stream error-code action format-string &rest format-args)
+  (let ((code (if (numberp error-code) error-code #+unix(lw:errno-value))))
+    (error 'socket-error :stream stream :code code
+           :identifier (if (keywordp error-code)
+                           error-code
+                         (%socket-error-identifier error-code))
+           :action action
+           :format-control "~A occured while doing socket IO (~?)"
+           :format-arguments (list 'socket-error format-string format-args))))
+
+
+(defmethod comm::socket-error ((stream binary-socket-stream) error-code format-string &rest format-args)
+  (apply #'socket-error stream error-code :IO format-string format-args))
+
+(defmethod stream-input-available ((fd fixnum))
+  (comm::socket-listen fd))
+
+(defmethod stream-input-available ((stream stream::os-file-handle-stream))
+  (stream-input-available (stream::os-file-handle-stream-file-handle stream)))
+
+(defmethod stream-input-available ((stream comm:socket-stream))
+  (or (comm::socket-listen (comm:socket-stream-socket stream))
+      (listen stream)))
+
+(defmethod stream-input-available ((stream passive-socket))
+  (comm::socket-listen (socket-os-fd stream)))
+
+(defun %new-passive-socket (local-port)
+  (multiple-value-bind (socket error-location error-code)
+      (comm::create-tcp-socket-for-service local-port)
+    (cond (socket socket)
+	  (t (error 'socket-error :action error-location :code error-code :identifier :unknown)))))
+
+) ;; lispworks
+
+#+sbcl
+(defun listen-to-inet-port (&key (port 0) (kind :stream) (reuse nil))
+  "Create, bind and listen to an inet socket on *:PORT.
+setsockopt SO_REUSEADDR if :reuse is not nil"
+  (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+			       :type :stream
+			       :protocol :tcp)))
+    (if reuse
+        (setf (sb-bsd-sockets:sockopt-reuse-address socket) t))
+    (sb-bsd-sockets:socket-bind 
+     socket (sb-bsd-sockets:make-inet-address "0.0.0.0") port)
+    (sb-bsd-sockets:socket-listen socket 15)
+    socket))
+
+(defun create-inet-listener (port &key (format :text) (reuse-address t))
+  #+cmu (ext:create-inet-listener port)
+  #+allegro
+  (socket:make-socket :connect :passive :local-port port :format :binary
+		      :address-family 
+		      (if (stringp port)
+			  :file
+			(if (or (null port) (integerp port))
+			    :internet
+			  (error "illegal value for port: ~s" port)))
+		      :reuse-address reuse-address)
+  #+sbcl
+  (listen-to-inet-port :port port :reuse reuse-address)
+  #+clisp (ext:socket-server port)
+  #+lispworks
+  (let ((comm::*use_so_reuseaddr* reuse-address))
+    (make-instance 'passive-socket
+		   :port port
+		   :passive-socket (%new-passive-socket port)
+		   :element-type format))
+  )
+
+(defun make-fd-stream (socket &key input output element-type)
+  #+cmu
+  (sys:make-fd-stream socket :input input :output output
+		      :element-type element-type)
+  #+sbcl
+  (sb-bsd-sockets:socket-make-stream socket :input input :output output
+				     :element-type element-type)
+  #-(or cmu sbcl) (declare (ignore input output element-type))
+  #-(or cmu sbcl) socket
+  )
+
+
+(defun accept-tcp-connection (listener)
+  #+cmu
+  (progn
+    (mp:process-wait-until-fd-usable listener :input)
+    (sys:make-fd-stream
+     (nth-value 0 (ext:accept-tcp-connection listener))
+     :input t :output t))
+  #+sbcl
+  (when (sb-sys:wait-until-fd-usable
+	 (sb-bsd-sockets:socket-file-descriptor listener) :input)
+    (sb-bsd-sockets:socket-make-stream 
+     (sb-bsd-sockets:socket-accept listener)
+     :element-type 'base-char
+     :input t :output t))
+  #+allegro
+  (socket:accept-connection listener)
+  #+clisp
+  (ext:socket-accept listener)
+  #+lispworks
+  (when (stream-input-available listener)
+    (make-instance 'bidirectional-binary-socket-stream
+		   :socket (comm::get-fd-from-socket
+			    (socket-os-fd passive-socket))
+		   :direction :io
+		   :element-type (element-type listener)))
+    
+  )
+
+
+(defmacro errorset (form display)
+  `(handler-case
+    ,form
+    (error (e)
+     (declare (ignorable e))
+     (when ,display
+       (format t "~&Error: ~A~%" e)))))
+
+(defun close-passive-socket (socket)
+  #+allegro (close socket)
+  #+cmu (unix:unix-close socket)
+  #+sbcl (sb-unix:unix-close
+	  (sb-bsd-sockets:socket-file-descriptor socket))
+  #+clisp (close socket)
+  #+lispworks (comm::close-socket (socket-os-fd socket))
+  )
+
+
+(defun close-active-socket (socket)
+  (close socket))
+
+#+sbcl
+(defun ipaddr-to-dotted (ipaddr &key values)
+  "Convert from 32-bit integer to dotted string."
+  (declare (type (unsigned-byte 32) ipaddr))
+  (let ((a (logand #xff (ash ipaddr -24)))
+	(b (logand #xff (ash ipaddr -16)))
+	(c (logand #xff (ash ipaddr -8)))
+	(d (logand #xff ipaddr)))
+    (if values
+	(values a b c d)
+      (format nil "~d.~d.~d.~d" a b c d))))
+
+#+sbcl
+(defun dotted-to-ipaddr (dotted &key (errorp t))
+  "Convert from dotted string to 32-bit integer."
+  (declare (string dotted))
+  (if errorp
+      (let ((ll (string-tokens (substitute #\Space #\. dotted))))
+	(+ (ash (first ll) 24) (ash (second ll) 16)
+	   (ash (third ll) 8) (fourth ll)))
+    (ignore-error
+	(let ((ll (string-tokens (substitute #\Space #\. dotted))))
+	  (+ (ash (first ll) 24) (ash (second ll) 16)
+	     (ash (third ll) 8) (fourth ll))))))
+
+#+sbcl
+(defun ipaddr-to-hostname (ipaddr &key ignore-cache)
+  (when ignore-cache
+    (warn ":IGNORE-CACHE keyword in IPADDR-TO-HOSTNAME not supported."))
+  (sb-bsd-sockets:host-ent-name
+   (sb-bsd-sockets:get-host-by-address
+    (sb-bsd-sockets:make-inet-address ipaddr))))
+
+#+sbcl
+(defun lookup-hostname (host &key ignore-cache)
+  (when ignore-cache
+    (warn ":IGNORE-CACHE keyword in LOOKUP-HOSTNAME not supported."))
+  (if (stringp host)
+      (sb-bsd-sockets:host-ent-address
+       (sb-bsd-sockets:get-host-by-name host))
+      (dotted-to-ipaddr (ipaddr-to-dotted host))))
+
+
+(defun make-active-socket (server port)
+  #+allegro (socket:make-socket :remote-host server
+				:remote-port port)
+  #+lispworks (comm:open-tcp-stream server port)
+  #+sbcl (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+				      :type :stream
+				      :protocol :tcp)))
+	   (sb-bsd-sockets:socket-connect
+	    socket (lookup-hostname server) port)
+	   (sb-bsd-sockets:socket-make-stream socket
+					      :input t
+					      :output t
+					      :element-type 'base-char))
+  #+cmu 
+  (sys:make-fd-stream (ext:connect-to-inet-socket host port)
+		      :input t :output t :element-type 'base-char)
+  )
diff --git a/demo.lisp b/demo.lisp
index 87c0aac..c9e7e0f 100644
--- a/demo.lisp
+++ b/demo.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: demo.lisp,v 1.1 2003/07/05 00:59:49 kevin Exp $
+;;;; $Id: demo.lisp,v 1.2 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:modlisp)
@@ -65,3 +65,38 @@
 
 
     
+;;; A small test bench used to test and time the client/server protocol 
+;;; From Marc Battyani
+
+(defun fetch-mod-lisp-url (server url &key (num-fetch 1) (port 20123)
+			   close-socket)
+  (loop with server-socket and reply
+	repeat num-fetch
+	do (unless server-socket
+	     (setf server-socket (make-active-socket server port)))
+   	   (write-string "url" server-socket)
+           (write-char #\NewLine server-socket)
+	   (write-string url server-socket)
+	   (write-char #\NewLine server-socket)
+	   (write-string "end" server-socket)
+	   (write-char #\NewLine server-socket)
+	   (force-output server-socket)
+	   (setf reply (read-reply server-socket))
+	   (when close-socket
+	     (close server-socket)
+	     (setf server-socket nil))
+	   finally
+	   (unless close-socket (close server-socket))
+	   (return reply)))
+
+(defun read-reply (socket)
+  (let* ((header (loop for key = (read-line socket nil nil)
+		       while (and key (string-not-equal key "end"))
+		       for value = (read-line socket nil nil)
+		       collect (cons key value)))
+	 (content-length (cdr (assoc "Content-Length" header :test #'string=)))
+	 (content (when content-length (make-string (parse-integer content-length :junk-allowed t)))))
+    (when content
+      (read-sequence content socket)
+      (push (cons "reply-content" content) header))
+    header))
diff --git a/impl-lispworks.lisp b/impl-lispworks.lisp
index 15a9569..90c62ad 100644
--- a/impl-lispworks.lisp
+++ b/impl-lispworks.lisp
@@ -5,7 +5,8 @@
 (defvar *processor*)
 (let ((*processor* nil))
   
-  (defun make-socket-server (name function port &key wait (format :text))
+  (defun make-socket-server (name function port listener
+			     &key wait (format :text) function-args)
     (setq *processor* function)
     (values
      (comm:start-up-server
diff --git a/modlisp.asd b/modlisp.asd
index 461084f..790298f 100644
--- a/modlisp.asd
+++ b/modlisp.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: modlisp.asd,v 1.6 2003/07/05 23:04:32 kevin Exp $
+;;;; $Id: modlisp.asd,v 1.7 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:cl-user)
@@ -30,11 +30,12 @@
     ((:file "package")
      (:file "compat" :depends-on ("package"))
      (:file "variables" :depends-on ("package"))
-     (:file #+(or allegro clisp cmu sbcl) "server"
-	    #+lispworks "impl-lispworks"
+     (:file #+(or allegro clisp cmu sbcl lispworks) "server"
+;;	    #+lispworks "impl-lispworks"
 	    :depends-on ("compat" "variables"))
      (:file "base"
-	    :depends-on (#+(or allegro clisp cmu sbcl) "server"
-			 #+lispworks "impl-lispworks"))
+	    :depends-on (#+(or allegro clisp cmu sbcl lispworks) "server"
+;;			   #+lispworks "impl-lispworks"
+			   ))
      (:file "utils" :depends-on ("base"))
      (:file "demo" :depends-on ("utils"))))
diff --git a/package.lisp b/package.lisp
index b09c706..d495556 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: package.lisp,v 1.2 2003/07/05 00:51:04 kevin Exp $
+;;;; $Id: package.lisp,v 1.3 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:cl-user)
@@ -23,6 +23,7 @@
    ;; base.lisp
    #:modlisp-start
    #:modlisp-stop
+   #:modlisp-stop-all
    #:header-value
    #:write-header-line
    #:get-number-worker-requests
diff --git a/server.lisp b/server.lisp
index 26fc2d5..1d27de4 100644
--- a/server.lisp
+++ b/server.lisp
@@ -3,56 +3,54 @@
 (in-package #:modlisp)
 
 
-(defun make-socket-server (name function port listener 
-			   &key wait (format :text) function-args)
-  (let* ((passive-socket (create-inet-listener port :format format))
-	 (proc (make-process name
-			     #'(lambda ()
-				 (start-socket-server
-				  passive-socket function listener
-				  :wait wait 
-				  :function-args function-args)))))
-    (values proc passive-socket)))
+(defun make-socket-server (listener)
+  (setf (socket listener) (create-inet-listener
+			   (port listener)
+			   :format (listener-format listener)))
+  (setf (process listener) (make-process
+			    (name listener)
+			    #'(lambda () (start-socket-server listener))))
+  listener)
 
 
 (defmethod initialize-instance :after
-	   ((self worker) &key listener socket func name function-args
-	    &allow-other-keys)
-  (unless socket
-    (error "socket not provided to modlisp-worker"))
+    ((self worker) &key listener connection name &allow-other-keys)
+  (unless connection
+    (error "connection not provided to modlisp-worker"))
   (setf (slot-value self 'listener) listener)
-  (setf (slot-value self 'func) func)
-  (setf (slot-value self 'function-args) function-args)
+  (setf (slot-value self 'name) name)
+  (setf (slot-value self 'connection) connection)
   (setf (slot-value self 'thread-fun)
-    #'(lambda ()
-	(unwind-protect
-	    (handler-case
-		(apply #'apache-command-issuer socket func function-args)
-	      (error (e)
-		(cmsg "Error ~A [~A]" e name)
-		;;(error e)
-		))
+	#'(lambda ()
+	    (unwind-protect
+		 (handler-case
+		     (apply (listener-function listener)
+			    connection
+			    (function-args listener))
+		   (error (e)
+		     (cmsg "Error ~A [~A]" e name)
+		     (error e)
+		     ))
 	  (progn
-	    (errorset (close-active-socket socket) nil)
+	    (errorset (close-active-socket connection) nil)
 	    (cmsg-c :threads "~A ended" name)
 	    (setf (workers listener)
-	      (remove self (workers listener))))))))
+		  (remove self (workers listener))))))))
 
-(defun start-socket-server (passive-socket function listener 
-			    &key wait function-args)
+(defun start-socket-server (listener)
   (unwind-protect
       (loop 
-       (let ((connection (accept-tcp-connection passive-socket)))
-	  (if wait
-	      (unwind-protect
-		  (funcall connection function)
-		(errorset (close connection) nil))
-	    (let ((worker (make-instance 'worker :listener listener
-					 :func function
-					 :function-args function-args
-					 :name (next-worker-name)
-					 :socket connection)))
+       (let ((connection (accept-tcp-connection (socket listener))))
+	 (if (wait listener)
+	     (unwind-protect
+		  (apply (listener-function listener)
+			 connection
+			 (function-args listener))
+	       (errorset (close connection) nil))
+	     (let ((worker (make-instance 'worker :listener listener
+					  :connection connection
+					  :name (next-worker-name))))
 	      (setf (process worker)
 		(make-process (name worker) (thread-fun worker)))
 	      (push worker (workers listener))))))
-    (errorset (close-passive-socket passive-socket) nil)))
+    (errorset (close-passive-socket (socket listener)) nil)))
diff --git a/utils.lisp b/utils.lisp
index 064e362..c216022 100644
--- a/utils.lisp
+++ b/utils.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: utils.lisp,v 1.2 2003/07/05 00:51:04 kevin Exp $
+;;;; $Id: utils.lisp,v 1.3 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:modlisp)
@@ -41,15 +41,17 @@
 	     (setq ,result (progn ,@body)))))
        (cond
 	(,precomp
-	 (write-header-line "Content-Length" (write-to-string (length ,outstr)))
+	 (write-header-line "Content-Length" 
+			    (write-to-string (length ,outstr)))
 	 (write-header-line "Keep-Socket" "1")
 	 (write-string "end" *apache-socket*)
 	 (write-char #\NewLine *apache-socket*)
 	 (write-string ,outstr *apache-socket*)
+	 (force-output *apache-socket*)
 	 (set-close-apache-socket nil))
 	(t
-	 (finish-output *apache-socket*)
-	 (set-close-apache-socket t)))
+	 (set-close-apache-socket t)
+	 (finish-output *apache-socket*)))
        ,result)))
 
 (defun redirect-to-location (url)
diff --git a/variables.lisp b/variables.lisp
index d9f4f1e..f107c38 100644
--- a/variables.lisp
+++ b/variables.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Dec 2002
 ;;;;
-;;;; $Id: variables.lisp,v 1.4 2003/07/05 22:54:00 kevin Exp $
+;;;; $Id: variables.lisp,v 1.5 2003/07/08 06:40:00 kevin Exp $
 ;;;; *************************************************************************
 
 (in-package #:modlisp)
@@ -29,21 +29,26 @@
 (defvar *close-apache-socket* t)
 
 (defclass listener ()
-  ((process :initarg process :accessor process)
-   (socket :initarg socket :accessor socket)
+  ((port :initarg :port :accessor port) 
+   (function :initarg :function :accessor listener-function
+	     :initform nil)
+   (function-args :initarg :function-args :accessor function-args
+		  :initform nil)
+   (process :initarg :process :accessor process)
+   (socket :initarg :socket :accessor socket)
    (workers :initform nil :accessor workers
-	    :documentation "list of worker threads")))
+	    :documentation "list of worker threads")
+   (name :initform "" :accessor name :initarg :name)
+   (wait :initform nil :accessor wait :initarg :wait)
+   (format :initform :text :accessor listener-format :initarg :format)))
 
 (defvar *active-listeners* nil
     "List of active listeners")
 
 (defclass worker ()
   ((listener :initarg :listener :accessor listener :initform nil)
+   (connection :initarg :connection :accessor connection :initform nil)
    (name :initarg :name :accessor name :initform nil)
-   (func :initarg :func :accessor func :initform nil)
-   (function-args :initarg :function-args :accessor function-args
-		  :initform nil)
-   (socket :initarg :socket :accessor socket :initform nil)
    (thread-fun :initarg :thread-fun :accessor thread-fun :initform nil)
    (process :initarg :process :accessor process :initform nil)))
 
-- 
2.34.1