Merge branch 'master' of ssh://git.b9.com/home/gitpub/kmrcl

Conflicts:

	debian/changelog

diff --git a/ChangeLog b/ChangeLog
index 5426a9be7847488a7389c0b146a8eb6905a922fc..0929de9853662fb903ce9eaa4fa14bd185da76c9 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+1 Apr 2011  Kevin Rosenberg <kevin@rosenberg.net>
+       * Version 1.104
+       * listener.lisp: Add support for active sockets in listener
+
 17 Apr 2010  Kevin Rosenberg <kevin@rosenberg.net>
        * Version 1.102
        * btree.lisp: New file providing binary tree search for

diff --git a/debian/changelog b/debian/changelog
index e26b49e4820e575c93bef193c2e152bd5bf54220..6077a6e1f8f7088b16576a5bea8ab9dfa63717af 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,6 @@
 cl-kmrcl (1.104-1) unstable; urgency=low
 
-  * lists.lisp: Add delete-alist and remove-alist
+  * New upstream
 
  -- Kevin M. Rosenberg <kmr@debian.org>  Mon, 20 Jun 2011 15:55:57 -0600
 

diff --git a/debian/upload.sh b/debian/upload.sh
index 368d958c9315694cd3c753cb87d706e679a20398..d4baf4c64fb4826f3d2c00268a5870886b158820 100755 (executable)
--- a/debian/upload.sh
+++ b/debian/upload.sh
@@ -1,6 +1,6 @@
 #!/bin/bash -e
 
-dup kmrcl -Ufiles.b9.com -D/home/ftp/kmrcl  -C"(umask 022; cd /opt/apache/htdocs/kmrcl; make install)" -su $*
+dup kmrcl -Ufiles.b9.com -D/home/ftp/kmrcl  -C"(umask 022; cd /srv/www/html/kmrcl; make install)" -su $*
 
 
 

diff --git a/listener.lisp b/listener.lisp
index 042d57fdd6b194fe1636120f2e58d0f03c48ce99..80bd362151ccc29cbfd47a510f9ea57fa54a1775 100644 (file)
--- a/listener.lisp
+++ b/listener.lisp
@@ -55,6 +55,7 @@
 
 (defclass worker (fixed-worker)
   ((connection :initarg :connection :accessor connection :initform nil)
+   (socket :initarg :socket :accessor socket :initform nil)
    (thread-fun :initarg :thread-fun :accessor thread-fun :initform nil)))
 
 
@@ -110,10 +111,11 @@
 (defun listener-shutdown (listener)
   (dolist (worker (workers listener))
     (when (and (typep worker 'worker)
-               (connection worker))
+               (socket worker))
       (errorset (close-active-socket
-                 (connection worker)) nil)
-      (setf (connection worker) nil))
+                 (socket worker)) nil)
+      (setf (connection worker) nil)
+      (setf (socket worker) nil))
     (when (process worker)
       (errorset (destroy-process (process worker)) nil)
       (setf (process worker) nil)))
@@ -158,16 +160,19 @@
 
 
 (defmethod initialize-instance :after
-    ((self worker) &key listener connection name &allow-other-keys)
+    ((self worker) &key listener connection socket name &allow-other-keys)
   (flet ((do-work ()
            (apply (listener-function listener)
                   connection
                   (function-args listener))))
     (unless connection
       (error "connection not provided to modlisp-worker"))
+    (unless socket
+      (error "socket not provided to modlisp-worker"))
     (setf (slot-value self 'listener) listener)
     (setf (slot-value self 'name) name)
     (setf (slot-value self 'connection) connection)
+    (setf (slot-value self 'socket) socket)
     (setf (slot-value self 'thread-fun)
           #'(lambda ()
               (unwind-protect
@@ -185,7 +190,7 @@
                            (do-work)))
                 (progn
                   (errorset (finish-output connection) nil)
-                  (errorset (close-active-socket connection) nil)
+                  (errorset (close-active-socket socket) t)
                   (cmsg-c :threads "~A ended" name)
                   (setf (workers listener)
                         (remove self (workers listener)))))))))
@@ -196,14 +201,15 @@
                (not (funcall (remote-host-checker listener)
                              (remote-host socket))))
       (cmsg-c :thread "Deny connection from ~A" (remote-host conn))
-      (errorset (close-active-socket conn) nil)
-      (setq conn nil))
-    conn))
+      (errorset (close-active-socket socket) nil)
+      (setq conn nil socket nil))
+    (values conn socket)))
 
 (defun start-socket-server (listener)
   (unwind-protect
       (loop
-       (let ((connection (accept-and-check-tcp-connection listener)))
+       (multiple-value-bind (connection socket)
+           (accept-and-check-tcp-connection listener)
          (when connection
            (if (wait listener)
                (unwind-protect
@@ -215,6 +221,7 @@
                    (errorset (close-active-socket connection) nil)))
                (let ((worker (make-instance 'worker :listener listener
                                             :connection connection
+                                            :socket socket
                                             :name (next-worker-name
                                                    (base-name listener)))))
                  (setf (process worker)