[usocket-cvs] r665 - in usocket/branches/0.5.x: . backend

[ctian at common-lisp.net]

Author: ctian
Date: Sun Jun 26 08:55:52 2011
New Revision: 665

Log:
[MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)

Modified:
   usocket/branches/0.5.x/CHANGES
   usocket/branches/0.5.x/backend/mcl.lisp

Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES	Sat Jun 25 18:15:16 2011	(r664)
+++ usocket/branches/0.5.x/CHANGES	Sun Jun 26 08:55:52 2011	(r665)
@@ -1,6 +1,7 @@
 0.5.3:
 
-* [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
+* [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
+* [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)
 
 0.5.2:
 

Modified: usocket/branches/0.5.x/backend/mcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/mcl.lisp	Sat Jun 25 18:15:16 2011	(r664)
+++ usocket/branches/0.5.x/backend/mcl.lisp	Sun Jun 26 08:55:52 2011	(r665)
@@ -230,7 +230,7 @@
     (declare (special ccl::*passive-interface-address*))
     new))
 
-(defun input-available-p (stream)
+(defmethod input-available-p ((stream ccl::opentransport-stream))
   (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body)
 	       "Evaluates the body if and only if the lock is successfully grabbed"
 	       ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock
@@ -257,19 +257,21 @@
 	      (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
        	        (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))))
 
-(defparameter *passive-polling-delay* 1/60)
+(defmethod connection-established-p ((stream ccl::opentransport-stream))
+  (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil))
+    (let ((state (ccl::opentransport-stream-connection-state stream)))
+      (not (eq :unbnd state)))))
 
 (defun wait-for-input-internal (wait-list &key timeout &aux result)
   (labels ((ready-sockets (sockets)
-	     (or (dolist (sock sockets result)
-		   (when (cond ((stream-usocket-p sock)
-				(input-available-p (socket-stream sock)))
-			       ((stream-server-usocket-p sock)
-				(input-available-p (car (socket-streams (socket sock))))))
-		     (push sock result)))
-		 (unless (and timeout (zerop timeout))
-		   (sleep *passive-polling-delay*)
-		   NIL))))
+	     (dolist (sock sockets result)
+	       (when (cond ((stream-usocket-p sock)
+			    (input-available-p (socket-stream sock)))
+			   ((stream-server-usocket-p sock)
+			    (let ((ot-stream (first (socket-streams (socket sock)))))
+			      (or (input-available-p ot-stream)
+				  (connection-established-p ot-stream)))))
+		 (push sock result)))))
     (with-mapped-conditions ()
       (ccl:process-wait-with-timeout
        "socket input"