X-Git-Url: http://git.kpe.io/?p=cl-modlisp.git;a=blobdiff_plain;f=server.lisp;h=1d27de4d40a3c1ebeb7d44dbba9af35ea26c5ac6;hp=26fc2d59d5989a54111d884f733dbb35e1b24779;hb=be22beac4a99bf6f426c34fbd29b5820e7c57e40;hpb=fb31277c5dace4cc9cf731c42e5034ace9dc31f2

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)))