r9949: delete-directory-and-files update

[kmrcl.git] / listener.lisp

diff --git a/listener.lisp b/listener.lisp
index 19c7b0c308542bbaf2b8b527abeae7cf19f8b240..0b31cefd745d2eb174890d541bbb4505d9a3da4a 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -7,7 +7,13 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Jun 2003
 ;;;;
-;;;; $Id: listener.lisp,v 1.5 2003/07/11 06:58:32 kevin Exp $
+;;;; $Id$
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (in-package #:kmrcl)
@@ -69,41 +75,16 @@
   (case state
     (:start
      (when (member listener *active-listeners*)
-       (warn "~&listener already started")
-       (return-from init/listener listener))
-     (handler-case
-        (progn
-          (setf (name listener) (next-server-name (base-name listener)))
-          (make-socket-server listener))
-       (error (e)
-        (format t "~&Error while trying to start listener~&  ~A" e)
-        (decf *listener-count*)
-        nil)
-       (:no-error (res)
-        (declare (ignore res))
-        (push listener *active-listeners*)
-        listener)))
+       (cmsg "~&listener ~A already initialized" listener)
+       (return-from init/listener))
+     (when (listener-startup listener)
+       (push listener *active-listeners*)
+       listener))
     (:stop
      (unless (member listener *active-listeners*)
-       (warn "~&listener is not in active list")
+       (cmsg "~&listener ~A is not in active list" listener)
        (return-from init/listener listener))
-     (dolist (worker (workers listener))
-       (when (and (typep worker 'worker)
-                 (connection worker))
-        (errorset (close-active-socket
-                   (connection worker)) nil)
-        (setf (connection worker) nil))
-       (when (process worker)
-        (errorset (destroy-process (process worker)) nil)
-        (setf (process worker) nil)))
-     (setf (workers listener) nil)
-     (with-slots (process socket) listener
-       (when socket
-        (errorset (close-passive-socket socket) nil)
-        (setf socket nil))
-       (when process
-        (errorset (destroy-process process) nil)
-        (setf process nil)))
+     (listener-shutdown listener)
      (setq *active-listeners* (remove listener *active-listeners*)))
     (:restart
      (init/listener listener :stop)
@@ -114,13 +95,46 @@
     (ignore-errors
        (init/listener listener :stop))))
 
+(defun listener-startup (listener)
+  (handler-case
+      (progn
+       (setf (name listener) (next-server-name (base-name listener)))
+       (make-socket-server listener))
+    (error (e)
+      (format t "~&Error while trying to start listener on port ~A~&  ~A" 
+             (port listener) e)
+      (decf *listener-count*)
+      nil)
+    (:no-error (res)
+      (declare (ignore res))
+      listener)))
+
+(defun listener-shutdown (listener)
+  (dolist (worker (workers listener))
+    (when (and (typep worker 'worker)
+              (connection worker))
+      (errorset (close-active-socket
+                (connection worker)) nil)
+      (setf (connection worker) nil))
+    (when (process worker)
+      (errorset (destroy-process (process worker)) nil)
+      (setf (process worker) nil)))
+  (setf (workers listener) nil)
+  (with-slots (process socket) listener
+    (when socket
+      (errorset (close-passive-socket socket) nil)
+      (setf socket nil))
+    (when process
+      (errorset (destroy-process process) nil)
+      (setf process nil))))
+
 ;; Low-level functions
 
 (defun next-server-name (base-name)
-  (format nil "~A-socket-server-~D" base-name (incf *listener-count*))) 
+  (format nil "~D-~A-socket-server" (incf *listener-count*) base-name)) 
 
 (defun next-worker-name (base-name)
-  (format nil "~A-worker-~D" base-name (incf *worker-count*)))
+  (format nil "~D-~A-worker"  (incf *worker-count*) base-name))
 
 (defun make-socket-server (listener)
   #+lispworks