[Cl-irc-cvs] CVS update: cl-irc/protocol.lisp

[Brian Mastenbrook]

Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp.net:/home/bmastenbrook/cl-irc

Modified Files:
	protocol.lisp 
Log Message:
change re sbcl start-background-message-handler

Date: Fri Aug  6 06:00:52 2004
Author: bmastenbrook

Index: cl-irc/protocol.lisp
diff -u cl-irc/protocol.lisp:1.9 cl-irc/protocol.lisp:1.10
--- cl-irc/protocol.lisp:1.9	Tue Jun 22 11:47:08 2004
+++ cl-irc/protocol.lisp	Fri Aug  6 06:00:52 2004
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.9 2004/06/22 18:47:08 ehuelsmann Exp $
+;;;; $Id: protocol.lisp,v 1.10 2004/08/06 13:00:52 bmastenbrook Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -33,6 +33,10 @@
     :initarg :server-stream
     :accessor server-stream
     :documentation "Stream used to talk to the IRC server.")
+   (server-socket
+    :initarg :server-socket
+    :accessor server-socket
+    :initform nil)
    (client-stream
     :initarg :client-stream
     :accessor client-stream
@@ -76,12 +80,14 @@
 (defun make-connection (&key (user nil)
                              (server-name "")
                              (server-stream nil)
+			(server-socket nil)
                              (client-stream t)
                              (hooks nil))
   (let ((connection (make-instance 'connection
                                    :user user
                                    :server-name server-name
                                    :server-stream server-stream
+				   :server-socket server-socket
                                    :client-stream client-stream)))
     (dolist (hook hooks)
       (add-hook connection (car hook) (cadr hook)))
@@ -118,6 +124,12 @@
     (and (streamp stream)
          (open-stream-p stream))))
 
+(define-condition invalidate-me (condition)
+  ((socket :initarg :socket
+           :reader invalidate-me-socket)
+   (condition :initarg :condition
+              :reader invalidate-me-condition)))
+
 (defmethod read-message ((connection connection))
   (let ((read-more-p t))
     (handler-case
@@ -128,7 +140,10 @@
                 (format *debug-stream* "~A" (describe message)))
               (irc-message-event message)
               message))) ; needed because of the "loop while" in read-message-loop
-      (stream-error () (setf read-more-p nil)))))
+      (stream-error (c) (setf read-more-p nil)
+                    (signal 'invalidate-me :socket
+                            (server-socket connection)
+                            :condition c)))))
 
 (defvar *process-count* 0)
 
@@ -152,7 +167,13 @@
 			      (server-stream connection))
 			     :input (lambda (fd)
 				      (declare (ignore fd))
-				      (read-message connection))))))
+                                      (handler-case
+                                          (read-message connection)
+                                        (invalidate-me (c)
+                                          (sb-sys:invalidate-descriptor
+                                           (invalidate-me-socket c))
+                                          (format t "Socket closed: ~A~%"
+                                                  (invalidate-me-condition c)))))))))
 
 (defun stop-background-message-handler (process)
   "Stops a background message handler process returned by the start function."