r5250: *** empty log message ***

[cl-modlisp.git] / server.lisp

diff --git a/server.lisp b/server.lisp
index 26fc2d59d5989a54111d884f733dbb35e1b24779..1d27de4d40a3c1ebeb7d44dbba9af35ea26c5ac6 100644 (file)
--- 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)))