[Cl-irc-cvs] CVS cl-irc

ehuelsmann ehuelsmann at common-lisp.net
Mon Jan 23 23:23:49 UTC 2006


Update of /project/cl-irc/cvsroot/cl-irc
In directory common-lisp:/tmp/cvs-serv852

Modified Files:
	protocol.lisp 
Log Message:
Replace invalidate-me condition machinery meant to catch EPIPE
by code which prevents the EPIPE (and the associated error).

--- /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2005/09/25 14:55:02	1.25
+++ /project/cl-irc/cvsroot/cl-irc/protocol.lisp	2006/01/23 23:23:49	1.26
@@ -1,4 +1,4 @@
-;;;; $Id: protocol.lisp,v 1.25 2005/09/25 14:55:02 bmastenbrook Exp $
+;;;; $Id: protocol.lisp,v 1.26 2006/01/23 23:23:49 ehuelsmann Exp $
 ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/protocol.lisp,v $
 
 ;;;; See LICENSE for licensing information.
@@ -241,26 +241,13 @@
     (and (streamp stream)
          (open-stream-p stream))))
 
-(define-condition invalidate-me (condition)
-  ((stream :initarg :stream
-           :reader invalidate-me-stream)
-   (condition :initarg :condition
-              :reader invalidate-me-condition)))
-
 (defmethod read-message ((connection connection))
-  (let ((read-more-p t))
-    (handler-case
-        (progn
-          (when (and (connectedp connection) read-more-p)
-            (let ((message (read-irc-message connection)))
-              (when *debug-p*
-                (format *debug-stream* "~A" (describe message)))
-              (irc-message-event message)
-              message))) ; needed because of the "loop while" in read-message-loop
-        (stream-error (c) (setf read-more-p nil)
-                    (signal 'invalidate-me :stream
-                            (server-stream connection)
-                            :condition c)))))
+  (when (connectedp connection)
+    (let ((message (read-irc-message connection)))
+      (when *debug-p*
+        (format *debug-stream* "~A" (describe message)))
+      (irc-message-event message)
+      message))) ; needed because of the "loop while" in read-message-loop
 
 (defvar *process-count* 0)
 
@@ -284,14 +271,15 @@
 			      (server-stream connection))
 			     :input (lambda (fd)
 				      (declare (ignore fd))
-                                      (handler-case
+                                      (if (listen (server-stream connection))
                                           (read-message connection)
-                                        (invalidate-me (c)
-                                          (sb-sys:invalidate-descriptor
-                                           (sb-sys:fd-stream-fd
-                                            (invalidate-me-stream c)))
-                                          (format t "Socket closed: ~A~%"
-                                                  (invalidate-me-condition c)))))))))
+                                        ;; select() returns with no
+                                        ;; available data if the stream
+                                        ;; has been closed on the other
+                                        ;; end (EPIPE)
+                                        (sb-sys:invalidate-descriptor
+                                         (sb-sys:fd-stream-fd
+                                          (server-stream connection)))))))))
 
 (defun stop-background-message-handler (process)
   "Stops a background message handler process returned by the start function."




More information about the cl-irc-cvs mailing list