From ctian at common-lisp.net  Wed May 11 07:09:34 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 03:09:34 -0400
Subject: [usocket-cvs] r657 - usocket/branches/0.5.x/backend
Message-ID: <E1QK3Y6-0003iZ-4J@common-lisp.net>

Author: ctian
Date: Wed May 11 03:09:33 2011
New Revision: 657

Log:
[SBCL] Fixes for issue elliott-slaughter.2

Modified:
   usocket/branches/0.5.x/backend/sbcl.lisp

Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp	(original)
+++ usocket/branches/0.5.x/backend/sbcl.lisp	Wed May 11 03:09:33 2011
@@ -585,7 +585,9 @@
     (sb-alien:with-alien ((int-ptr sb-alien:unsigned-long))
       (maybe-wsa-error (wsa-ioctlsocket (os-socket-handle socket) fionread (sb-alien:addr int-ptr))
                        socket)
-      int-ptr))
+      (prog1 int-ptr
+        (when (plusp int-ptr)
+          (setf (state socket) :read)))))
 
   (defun wait-for-input-internal (wait-list &key timeout)
     (when (waiting-required (wait-list-waiters wait-list))
@@ -609,20 +611,22 @@
 
   (defun update-ready-and-state-slots (sockets)
     (dolist (socket sockets)
-      (if (or (and (stream-usocket-p socket)
-                   (listen (socket-stream socket)))
-              (%ready-p socket))
-          (setf (state socket) :READ)
+      (if (%ready-p socket)
+          (progn
+            (setf (state socket) :READ))
         (sb-alien:with-alien ((network-events (sb-alien:struct wsa-network-events)))
           (let ((rv (wsa-enum-network-events (os-socket-handle socket) 0
                                              (sb-alien:addr network-events))))
             (if (zerop rv)
-                (map-network-events #'(lambda (err-code)
-                                        (if (zerop err-code)
-                                            (setf (%ready-p socket) t
-                                                  (state socket) :READ)
-                                          (raise-usock-err err-code socket)))
-                                    network-events)
+                (map-network-events
+                 #'(lambda (err-code)
+                     (if (zerop err-code)
+                         (progn
+                           (setf (state socket) :READ)
+                           (when (stream-server-usocket-p socket)
+                             (setf (%ready-p socket) t)))
+                       (raise-usock-err err-code socket)))
+                 network-events)
               (maybe-wsa-error rv socket)))))))
 
   (defun os-wait-list-%wait (wait-list)
@@ -745,7 +749,7 @@
   (defun update-ready-and-state-slots (sockets)
     (dolist (socket sockets)
       (if (or (and (stream-usocket-p socket)
-                   (listen (socket-stream socket)))
+                   (listen (socket-stream socket))) ; TODO: LISTEN cannot be used
               (%ready-p socket))
           (setf (state socket) :READ)
         (let ((events (etypecase socket



From ctian at common-lisp.net  Wed May 11 07:24:38 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 03:24:38 -0400
Subject: [usocket-cvs] r658 - in usocket/branches/0.5.x: . backend
Message-ID: <E1QK3mg-0004Do-Am@common-lisp.net>

Author: ctian
Date: Wed May 11 03:24:37 2011
New Revision: 658

Log:
[ECL] Port fixes of issue elliott-slaughter.2 from SBCL to ECL (untested); Update ChangeLog

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

Modified: usocket/branches/0.5.x/CHANGES
==============================================================================
--- usocket/branches/0.5.x/CHANGES	(original)
+++ usocket/branches/0.5.x/CHANGES	Wed May 11 03:24:37 2011
@@ -4,7 +4,7 @@
 * Bugfix: [CLISP] WAIT-FOR-INPUT now functions right (with/without READY-ONLY), this made Hunchentoot working on CLISP. (Thanks to Anton Vodonosov <avodonosov at yandex.ru>)
 * Bugfix: [ABCL] Fix SOCKET-ACCEPT to follow the documented API so that when called without an :ELEMENT-TYPE argument. (Thanks to Mark Evenson, the ABCL developer)
 * Bugfix: [LispWorks] Fixed SOCKET-ACCEPT (Windows only) on WAIT-FOR-INPUTed sockets.
-* Bugfix: [SBCL] Fixed missing STATE clean for WAIT-FOR-INPUT on SBCL/Windows (report by Elliott Slaughter)
+* Bugfix: [SBCL, ECL] Fixed wrongly STATE set/unset for WAIT-FOR-INPUT on Windows (report by Elliott Slaughter)
 * Enhancement: Additional NAME keyword argument for SOCKET-SERVER for setting the server thread name.
 * Enhancement: [ABCL] GET-ADDRESS now works with underlying IP6 addresses.
 * Enhancement: [CLISP] missing GET-LOCAL-* methods for STREAM-SERVER-USOCKET was now added.

Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp	(original)
+++ usocket/branches/0.5.x/backend/sbcl.lisp	Wed May 11 03:24:37 2011
@@ -738,7 +738,8 @@
      '%remove-waiter))
 
   ;; TODO: how to handle error (result) in this call?
-  (defun bytes-available-for-read (socket)
+  (declaim (inline %bytes-available-for-read))
+  (defun %bytes-available-for-read (socket)
     (ffi:c-inline ((socket-handle socket)) (:fixnum) :fixnum
      "u_long nbytes;
       int result;
@@ -746,11 +747,15 @@
       result = ioctlsocket((SOCKET)#0, FIONREAD, &nbytes);
       @(return) = nbytes;"))
 
+  (defun bytes-available-for-read (socket)
+    (let ((nbytes (%bytes-available-for-read socket)))
+      (when (plusp nbytes)
+	(setf (state socket) :read))
+      nbytes))
+
   (defun update-ready-and-state-slots (sockets)
     (dolist (socket sockets)
-      (if (or (and (stream-usocket-p socket)
-                   (listen (socket-stream socket))) ; TODO: LISTEN cannot be used
-              (%ready-p socket))
+      (if (%ready-p socket)
           (setf (state socket) :READ)
         (let ((events (etypecase socket
                         (stream-server-usocket (logior fd-connect fd-accept fd-close))
@@ -765,8 +770,10 @@
                   @(return) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
                 } else
                   @(return) = Cnil;")
-              (setf (%ready-p socket) t
-                    (state socket) :READ)
+              (progn
+		(setf (state socket) :READ)
+		(when (stream-server-usocket-p socket)
+		  (setf (%ready-p socket) t)))
             (sb-bsd-sockets::socket-error 'update-ready-and-state-slots))))))
 
   (defun wait-for-input-internal (wait-list &key timeout)



From ctian at common-lisp.net  Wed May 11 11:47:42 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 07:47:42 -0400
Subject: [usocket-cvs] r659 - usocket/branches/0.5.x/backend
Message-ID: <E1QK7tG-0006jk-O2@common-lisp.net>

Author: ctian
Date: Wed May 11 07:47:42 2011
New Revision: 659

Log:
[ECL] More fixes for issue elliott-slaughter.2; slightly optimize on SBCL's W-F-I when timeout happens.

Modified:
   usocket/branches/0.5.x/backend/sbcl.lisp

Modified: usocket/branches/0.5.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.5.x/backend/sbcl.lisp	(original)
+++ usocket/branches/0.5.x/backend/sbcl.lisp	Wed May 11 07:47:42 2011
@@ -594,8 +594,9 @@
       (let ((rv (wsa-wait-for-multiple-events 1 (wait-list-%wait wait-list)
                                               nil (truncate (* 1000 timeout)) nil)))
         (ecase rv
-          ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+          ((#.+wsa-wait-event-0+)
            (update-ready-and-state-slots (wait-list-waiters wait-list)))
+          ((#.+wsa-wait-timeout+)) ; do nothing here
           ((#.+wsa-wait-failed+)
            (raise-usock-err
             (sb-win32::get-last-error-message (sb-win32::get-last-error))
@@ -762,19 +763,25 @@
                         (stream-usocket (logior fd-read))
                         (datagram-usocket (logior fd-read)))))
           ;; TODO: check the iErrorCode array
-          (if (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum) :bool
-               "WSANETWORKEVENTS network_events;
-                int i, result;
-                result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
-                if (!result) {
-                  @(return) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
-                } else
-                  @(return) = Cnil;")
-              (progn
-		(setf (state socket) :READ)
-		(when (stream-server-usocket-p socket)
-		  (setf (%ready-p socket) t)))
-            (sb-bsd-sockets::socket-error 'update-ready-and-state-slots))))))
+          (multiple-value-bind (valid-p ready-p)
+              (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum)
+                                                            (values :bool :bool)
+                "WSANETWORKEVENTS network_events;
+                 int i, result;
+                 result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
+                 if (!result) {
+                   @(return 0) = Ct;
+                   @(return 1) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
+                 } else {
+                   @(return 0) = Cnil;
+                   @(return 1) = Cnil;
+                 }")
+            (if valid-p
+                (when ready-p
+                  (setf (state socket) :READ)
+                  (when (stream-server-usocket-p socket)
+                    (setf (%ready-p socket) t)))
+              (sb-bsd-sockets::socket-error 'update-ready-and-state-slots)))))))
 
   (defun wait-for-input-internal (wait-list &key timeout)
     (when (waiting-required (wait-list-waiters wait-list))
@@ -786,8 +793,9 @@
                   result = WSAWaitForMultipleEvents(1, events, NULL, #1, NULL);
                   @(return) = result;")))
         (ecase rv
-          ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+          ((#.+wsa-wait-event-0+)
            (update-ready-and-state-slots (wait-list-waiters wait-list)))
+          ((#.+wsa-wait-timeout+)) ; do nothing here
           ((#.+wsa-wait-failed+)
            (sb-bsd-sockets::socket-error 'wait-for-input-internal))))))
 



From ctian at common-lisp.net  Wed May 11 13:08:20 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 09:08:20 -0400
Subject: [usocket-cvs] r660 - in usocket/trunk: . backend test
Message-ID: <E1QK99I-0006ZB-B1@common-lisp.net>

Author: ctian
Date: Wed May 11 09:08:19 2011
New Revision: 660

Log:
Merge all changes from branch 0.5.x (r640-r659) before tagging 0.5.2

Added:
   usocket/trunk/test/wait-for-input.lisp
      - copied unchanged from r659, /usocket/branches/0.5.x/test/wait-for-input.lisp
Modified:
   usocket/trunk/CHANGES
   usocket/trunk/backend/abcl.lisp
   usocket/trunk/backend/clisp.lisp
   usocket/trunk/backend/lispworks.lisp
   usocket/trunk/backend/sbcl.lisp
   usocket/trunk/package.lisp
   usocket/trunk/server.lisp
   usocket/trunk/test/package.lisp
   usocket/trunk/test/test-datagram.lisp
   usocket/trunk/test/test-usocket.lisp
   usocket/trunk/usocket-test.asd
   usocket/trunk/usocket.lisp

Modified: usocket/trunk/CHANGES
==============================================================================
--- usocket/trunk/CHANGES	(original)
+++ usocket/trunk/CHANGES	Wed May 11 09:08:19 2011
@@ -1,10 +1,13 @@
-0.5.0:
+0.5.2:
 
-* New supported platform: Macintosh Common Lisp (5.0 and up, plus RMCL)
-* Support for UDP (datagram-usocket) was added (for all supported platform except MCL)
-* Add WAIT-FOR-INPUT support for SBCL and ECL on win32.
-* Simple TCP and UDP server API: SOCKET-SERVER
-* Lots of bug fixed since 0.4.1
+* General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms.
+* Bugfix: [CLISP] WAIT-FOR-INPUT now functions right (with/without READY-ONLY), this made Hunchentoot working on CLISP. (Thanks to Anton Vodonosov <avodonosov at yandex.ru>)
+* Bugfix: [ABCL] Fix SOCKET-ACCEPT to follow the documented API so that when called without an :ELEMENT-TYPE argument. (Thanks to Mark Evenson, the ABCL developer)
+* Bugfix: [LispWorks] Fixed SOCKET-ACCEPT (Windows only) on WAIT-FOR-INPUTed sockets.
+* Bugfix: [SBCL, ECL] Fixed wrongly STATE set/unset for WAIT-FOR-INPUT on Windows (report by Elliott Slaughter)
+* Enhancement: Additional NAME keyword argument for SOCKET-SERVER for setting the server thread name.
+* Enhancement: [ABCL] GET-ADDRESS now works with underlying IP6 addresses.
+* Enhancement: [CLISP] missing GET-LOCAL-* methods for STREAM-SERVER-USOCKET was now added.
 
 0.5.1:
 
@@ -21,6 +24,15 @@
 * Bugfix: [CMUCL] Fixed SOCKET-SEND on unconnected usockets under Unicode version of CMUCL.
 * Bugfix: [CLISP] Fixed and confirmed UDP (Datagram) support (RAWSOCK version).
 
+0.5.0:
+
+* New supported platform: Macintosh Common Lisp (5.0 and up, plus RMCL)
+* Support for UDP (datagram-usocket) was added (for all supported platform except MCL)
+* Add WAIT-FOR-INPUT support for SBCL and ECL on win32.
+* Simple TCP and UDP server API: SOCKET-SERVER
+* Completely rewritten full-feature ABCL backends using latest Java interfaces
+* Lots of bug fixed since 0.4.1
+
 [TODO]
 
 * New feature: CLISP support some advanced TCP features which CLISP's SOCKET interface not provide

Modified: usocket/trunk/backend/abcl.lisp
==============================================================================
--- usocket/trunk/backend/abcl.lisp	(original)
+++ usocket/trunk/backend/abcl.lisp	Wed May 11 09:08:19 2011
@@ -67,7 +67,7 @@
 (defvar $@connect/Socket/1 (jmethod $*Socket "connect" $*SocketAddress))
 (defvar $@connect/Socket/2 (jmethod $*Socket "connect" $*SocketAddress $*int))
 (defvar $@connect/SocketChannel/1 (jmethod $*SocketChannel "connect" $*SocketAddress))
-(defvar $@getAddress/0 (jmethod $*Inet4Address "getAddress"))
+(defvar $@getAddress/0 (jmethod $*InetAddress "getAddress"))
 (defvar $@getAllByName/1 (jmethod $*InetAddress "getAllByName" $*String))
 (defvar $@getByName/1 (jmethod $*InetAddress "getByName" $*String))
 (defvar $@getChannel/DatagramSocket/0 (jmethod $*DatagramSocket "getChannel"))
@@ -170,9 +170,13 @@
       (labels ((jbyte (n)
 		 (let ((byte (jarray-ref array n)))
 		   (if (minusp byte) (+ 256 byte) byte))))
-	(if (= 4 length)
-	    (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3))
-	    nil))))) ; not a IPv4 address?!
+	(cond  
+          ((= 4 length)
+           (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3)))
+          ((= 16 length)
+           (vector (jbyte 0) (jbyte 1) (jbyte 2) (jbyte 3) 
+                   (jbyte 4) (jbyte 5) (jbyte 6) (jbyte 7)))
+          (t nil)))))) ; neither a IPv4 nor IPv6 address?!
 
 (defun get-hosts-by-name (name)
   (with-mapped-conditions ()
@@ -249,9 +253,13 @@
 
 ;;; SOCKET-ACCEPT
 
-(defmethod socket-accept ((usocket stream-server-usocket) &key (element-type 'character))
+(defmethod socket-accept ((usocket stream-server-usocket) 
+                          &key (element-type 'character element-type-p))
   (with-mapped-conditions (usocket)
     (let* ((client-socket (jcall $@accept/0 (socket usocket)))
+           (element-type (if element-type-p 
+                             element-type
+                             (element-type usocket)))
 	   (stream (ext:get-socket-stream client-socket :element-type element-type)))
       (make-stream-socket :stream stream :socket client-socket))))
 

Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp	(original)
+++ usocket/trunk/backend/clisp.lisp	Wed May 11 09:08:19 2011
@@ -191,6 +191,10 @@
       (socket:socket-stream-local (socket usocket) t)
     (values (dotted-quad-to-vector-quad address) port)))
 
+(defmethod get-local-name ((usocket stream-server-usocket))
+  (values (get-local-address usocket)
+          (get-local-port usocket)))
+
 (defmethod get-peer-name ((usocket stream-usocket))
   (multiple-value-bind
       (address port)
@@ -200,12 +204,19 @@
 (defmethod get-local-address ((usocket usocket))
   (nth-value 0 (get-local-name usocket)))
 
+(defmethod get-local-address ((usocket stream-server-usocket))
+  (dotted-quad-to-vector-quad
+   (socket:socket-server-host (socket usocket))))
+
 (defmethod get-peer-address ((usocket usocket))
   (nth-value 0 (get-peer-name usocket)))
 
 (defmethod get-local-port ((usocket usocket))
   (nth-value 1 (get-local-name usocket)))
 
+(defmethod get-local-port ((usocket stream-server-usocket))
+  (socket:socket-server-port (socket usocket)))
+
 (defmethod get-peer-port ((usocket usocket))
   (nth-value 1 (get-peer-name usocket)))
 
@@ -232,9 +243,9 @@
                             (socket:socket-status request-list)))
              (sockets (wait-list-waiters wait-list)))
         (do* ((x (pop sockets) (pop sockets))
-              (y (pop status-list) (pop status-list)))
+              (y (cdr (pop status-list)) (cdr (pop status-list))))
              ((null x))
-          (when (eq y :INPUT)
+          (when (member y '(T :INPUT))
             (setf (state x) :READ)))
         wait-list))))
 

Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	(original)
+++ usocket/trunk/backend/lispworks.lisp	Wed May 11 09:08:19 2011
@@ -318,18 +318,28 @@
                   #+lispworks4.1 (comm::create-tcp-socket-for-service port))))
     (make-stream-server-socket sock :element-type element-type)))
 
+;; Note: COMM::GET-FD-FROM-SOCKET contains addition socket wait operations, which
+;; should NOT be applied on socket FDs who have already been called on W-F-I,
+;; so we have to check the %READY-P slot to decide if this waiting is necessary,
+;; or SOCKET-ACCEPT will just hang. -- Chun Tian (binghe), May 1, 2011
+
 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
-  (let* ((sock (with-mapped-conditions (usocket)
-                 (comm::get-fd-from-socket (socket usocket))))
+  (let* ((socket (with-mapped-conditions (usocket)
+                   #+win32
+                   (if (%ready-p usocket)
+                       (comm::accept-connection-to-socket (socket usocket))
+                     (comm::get-fd-from-socket (socket usocket)))
+                   #-win32
+                   (comm::get-fd-from-socket (socket usocket))))
          (stream (make-instance 'comm:socket-stream
-                                :socket sock
+                                :socket socket
                                 :direction :io
                                 :element-type (or element-type
                                                   (element-type usocket)))))
     #+win32
-    (when sock
+    (when socket
       (setf (%ready-p usocket) nil))
-    (make-stream-socket :socket sock :stream stream)))
+    (make-stream-socket :socket socket :stream stream)))
 
 ;; Sockets and their streams are different objects
 ;; close the stream in order to make sure buffers

Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp	(original)
+++ usocket/trunk/backend/sbcl.lisp	Wed May 11 09:08:19 2011
@@ -215,7 +215,7 @@
 ;;; and WITH-LOCAL-INTERRUPTS were for. :) But yeah, it's miles saner than
 ;;; the SB-EXT:WITH-TIMEOUT. -- Nikodemus Siivola <nikodemus at random-state.net>
 
-#+sbcl
+#+(and sbcl (not win32))
 (defmacro %with-timeout ((seconds timeout-form) &body body)
   "Runs BODY as an implicit PROGN with timeout of SECONDS. If
 timeout occurs before BODY has finished, BODY is unwound and
@@ -287,13 +287,13 @@
               (when (or local-host local-port)
                 (sb-bsd-sockets:socket-bind socket local-host local-port))
               (with-mapped-conditions (usocket)
-		#+sbcl
+		#+(and sbcl (not win32))
 		(labels ((connect ()
 			   (sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)))
 		  (if timeout
 		      (%with-timeout (timeout (error 'sb-ext:timeout)) (connect))
 		      (connect)))
-		#+ecl
+		#+(or ecl (and sbcl win32))
 		(sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)
                 ;; Now that we're connected make the stream.
                 (setf (socket-stream usocket)
@@ -347,22 +347,23 @@
 ;;; "I had to redefine SOCKET-ACCEPT method of STREAM-SERVER-USOCKET to
 ;;; handle this situation. Here is the redefinition:" -- Anton Kovalenko <anton at sw4me.com>
 
-(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
-  (with-mapped-conditions (socket)
-    (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
-      (if sock
+(defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
+  (with-mapped-conditions (usocket)
+    (let ((socket (sb-bsd-sockets:socket-accept (socket usocket))))
+      (when socket
+        (prog1
 	  (make-stream-socket
-	   :socket sock
+	   :socket socket
 	   :stream (sb-bsd-sockets:socket-make-stream
-		    sock
+		    socket
 		    :input t :output t :buffering :full
 		    :element-type (or element-type
-				      (element-type socket))))
+				      (element-type usocket))))
 
-	  ;; next time wait for event again if we had EAGAIN/EINTR
-	  ;; or else we'd enter a tight loop of failed accepts
-	  #+win32
-	  (setf (%ready-p socket) nil)))))
+          ;; next time wait for event again if we had EAGAIN/EINTR
+          ;; or else we'd enter a tight loop of failed accepts
+          #+win32
+          (setf (%ready-p usocket) nil))))))
 
 ;; Sockets and their associated streams are modelled as
 ;; different objects. Be sure to close the stream (which
@@ -584,15 +585,18 @@
     (sb-alien:with-alien ((int-ptr sb-alien:unsigned-long))
       (maybe-wsa-error (wsa-ioctlsocket (os-socket-handle socket) fionread (sb-alien:addr int-ptr))
                        socket)
-      int-ptr))
+      (prog1 int-ptr
+        (when (plusp int-ptr)
+          (setf (state socket) :read)))))
 
   (defun wait-for-input-internal (wait-list &key timeout)
     (when (waiting-required (wait-list-waiters wait-list))
       (let ((rv (wsa-wait-for-multiple-events 1 (wait-list-%wait wait-list)
                                               nil (truncate (* 1000 timeout)) nil)))
         (ecase rv
-          ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+          ((#.+wsa-wait-event-0+)
            (update-ready-and-state-slots (wait-list-waiters wait-list)))
+          ((#.+wsa-wait-timeout+)) ; do nothing here
           ((#.+wsa-wait-failed+)
            (raise-usock-err
             (sb-win32::get-last-error-message (sb-win32::get-last-error))
@@ -608,20 +612,22 @@
 
   (defun update-ready-and-state-slots (sockets)
     (dolist (socket sockets)
-      (if (or (and (stream-usocket-p socket)
-                   (listen (socket-stream socket)))
-              (%ready-p socket))
-          (setf (state socket) :READ)
+      (if (%ready-p socket)
+          (progn
+            (setf (state socket) :READ))
         (sb-alien:with-alien ((network-events (sb-alien:struct wsa-network-events)))
           (let ((rv (wsa-enum-network-events (os-socket-handle socket) 0
                                              (sb-alien:addr network-events))))
             (if (zerop rv)
-                (map-network-events #'(lambda (err-code)
-                                        (if (zerop err-code)
-                                            (setf (%ready-p socket) t
-                                                  (state socket) :READ)
-                                          (raise-usock-err err-code socket)))
-                                    network-events)
+                (map-network-events
+                 #'(lambda (err-code)
+                     (if (zerop err-code)
+                         (progn
+                           (setf (state socket) :READ)
+                           (when (stream-server-usocket-p socket)
+                             (setf (%ready-p socket) t)))
+                       (raise-usock-err err-code socket)))
+                 network-events)
               (maybe-wsa-error rv socket)))))))
 
   (defun os-wait-list-%wait (wait-list)
@@ -733,7 +739,8 @@
      '%remove-waiter))
 
   ;; TODO: how to handle error (result) in this call?
-  (defun bytes-available-for-read (socket)
+  (declaim (inline %bytes-available-for-read))
+  (defun %bytes-available-for-read (socket)
     (ffi:c-inline ((socket-handle socket)) (:fixnum) :fixnum
      "u_long nbytes;
       int result;
@@ -741,28 +748,40 @@
       result = ioctlsocket((SOCKET)#0, FIONREAD, &nbytes);
       @(return) = nbytes;"))
 
+  (defun bytes-available-for-read (socket)
+    (let ((nbytes (%bytes-available-for-read socket)))
+      (when (plusp nbytes)
+	(setf (state socket) :read))
+      nbytes))
+
   (defun update-ready-and-state-slots (sockets)
     (dolist (socket sockets)
-      (if (or (and (stream-usocket-p socket)
-                   (listen (socket-stream socket)))
-              (%ready-p socket))
+      (if (%ready-p socket)
           (setf (state socket) :READ)
         (let ((events (etypecase socket
                         (stream-server-usocket (logior fd-connect fd-accept fd-close))
                         (stream-usocket (logior fd-read))
                         (datagram-usocket (logior fd-read)))))
           ;; TODO: check the iErrorCode array
-          (if (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum) :bool
-               "WSANETWORKEVENTS network_events;
-                int i, result;
-                result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
-                if (!result) {
-                  @(return) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
-                } else
-                  @(return) = Cnil;")
-              (setf (%ready-p socket) t
-                    (state socket) :READ)
-            (sb-bsd-sockets::socket-error 'update-ready-and-state-slots))))))
+          (multiple-value-bind (valid-p ready-p)
+              (ffi:c-inline ((socket-handle socket) events) (:fixnum :fixnum)
+                                                            (values :bool :bool)
+                "WSANETWORKEVENTS network_events;
+                 int i, result;
+                 result = WSAEnumNetworkEvents((SOCKET)#0, 0, &network_events);
+                 if (!result) {
+                   @(return 0) = Ct;
+                   @(return 1) = (#1 & network_events.lNetworkEvents)? Ct : Cnil;
+                 } else {
+                   @(return 0) = Cnil;
+                   @(return 1) = Cnil;
+                 }")
+            (if valid-p
+                (when ready-p
+                  (setf (state socket) :READ)
+                  (when (stream-server-usocket-p socket)
+                    (setf (%ready-p socket) t)))
+              (sb-bsd-sockets::socket-error 'update-ready-and-state-slots)))))))
 
   (defun wait-for-input-internal (wait-list &key timeout)
     (when (waiting-required (wait-list-waiters wait-list))
@@ -774,8 +793,9 @@
                   result = WSAWaitForMultipleEvents(1, events, NULL, #1, NULL);
                   @(return) = result;")))
         (ecase rv
-          ((#.+wsa-wait-event-0+ #.+wsa-wait-timeout+)
+          ((#.+wsa-wait-event-0+)
            (update-ready-and-state-slots (wait-list-waiters wait-list)))
+          ((#.+wsa-wait-timeout+)) ; do nothing here
           ((#.+wsa-wait-failed+)
            (sb-bsd-sockets::socket-error 'wait-for-input-internal))))))
 

Modified: usocket/trunk/package.lisp
==============================================================================
--- usocket/trunk/package.lisp	(original)
+++ usocket/trunk/package.lisp	Wed May 11 09:08:19 2011
@@ -49,6 +49,14 @@
              #:socket-stream
              #:datagram-usocket
 
+	     ;; predicates (for version 0.6 or 1.0 ?)
+	     #|
+	     #:usocket-p
+	     #:stream-usocket-p
+	     #:stream-server-usocket-p
+	     #:datagram-usocket-p
+	     |#
+
              #:host-byte-order ; IP(v4) utility functions
              #:hbo-to-dotted-quad
              #:hbo-to-vector-quad
@@ -83,6 +91,7 @@
 (in-package :usocket)
 
 ;;; Logical Pathname Translations, learn from CL-HTTP source code
+
 (eval-when (:load-toplevel :execute)
   (let* ((defaults #+asdf (asdf:component-pathname (asdf:find-system :usocket))
                    #-asdf *load-truename*)
@@ -93,4 +102,5 @@
                               :defaults defaults
 			      :version :newest)))
     (setf (logical-pathname-translations "usocket")
-          `(("**;*.*" ,home)))))
+          `(("**;*.*.NEWEST" ,home)
+            ("**;*.*" ,home)))))

Modified: usocket/trunk/server.lisp
==============================================================================
--- usocket/trunk/server.lisp	(original)
+++ usocket/trunk/server.lisp	Wed May 11 09:08:19 2011
@@ -8,7 +8,8 @@
                            ;; for udp
                            (timeout 1) (max-buffer-size +max-datagram-packet-size+)
                            ;; for tcp
-                           element-type reuse-address multi-threading)
+                           element-type reuse-address multi-threading
+                           name)
   (let* ((real-host (or host *wildcard-host*))
          (socket (ecase protocol
                    (:stream
@@ -31,7 +32,7 @@
                                   :timeout timeout
                                   :max-buffer-size max-buffer-size)))))
       (if in-new-thread
-	  (values (spawn-thread "USOCKET Server" #'real-call) socket)
+	  (values (spawn-thread (or name "USOCKET Server") #'real-call) socket)
 	  (real-call)))))
 
 (defvar *remote-host*)
@@ -81,7 +82,8 @@
                            (unwind-protect
                                (apply function (socket-stream client-socket) arguments)
                              (close (socket-stream client-socket))
-                             (socket-close client-socket)))))
+                             (socket-close client-socket)
+                             nil))))
     (unwind-protect
         (loop do
           (let* ((client-socket (apply #'socket-accept

Modified: usocket/trunk/test/package.lisp
==============================================================================
--- usocket/trunk/test/package.lisp	(original)
+++ usocket/trunk/test/package.lisp	Wed May 11 09:08:19 2011
@@ -6,6 +6,8 @@
 (in-package :cl-user)
 
 (defpackage :usocket-test
-  (:use :cl :regression-test)
-  (:nicknames :usoct)
-  (:export :do-tests :run-usocket-tests))
+  (:use :common-lisp
+	:usocket
+	:regression-test)
+  (:export #:do-tests
+	   #:run-usocket-tests))

Modified: usocket/trunk/test/test-datagram.lisp
==============================================================================
--- usocket/trunk/test/test-datagram.lisp	(original)
+++ usocket/trunk/test/test-datagram.lisp	Wed May 11 09:08:19 2011
@@ -6,7 +6,7 @@
 (defvar *echo-server*)
 (defvar *echo-server-port*)
 
-(eval-when (:load-toplevel :execute)
+(defun start-server ()
   (multiple-value-bind (thread socket)
       (usocket:socket-server "127.0.0.1" 0 #'identity nil
 			     :in-new-thread t
@@ -28,6 +28,9 @@
 
 ;;; UDP Send Test #1: connected socket
 (deftest udp-send.1
+  (progn
+    (unless (and *echo-server* *echo-server-port*)
+      (start-server))
     (let ((s (usocket:socket-connect "127.0.0.1" *echo-server-port* :protocol :datagram)))
       (clean-buffers)
       (replace *send-buffer* #(1 2 3 4 5))
@@ -36,11 +39,14 @@
       (multiple-value-bind (buffer size host port)
 	  (usocket:socket-receive s *receive-buffer* *max-buffer-size*)
 	(declare (ignore buffer size host port))
-	(reduce #'+ *receive-buffer* :start 0 :end 5)))
+	(reduce #'+ *receive-buffer* :start 0 :end 5))))
   15)
 
 ;;; UDP Send Test #2: unconnected socket
 (deftest udp-send.2
+  (progn
+    (unless (and *echo-server* *echo-server-port*)
+      (start-server))
     (let ((s (usocket:socket-connect nil nil :protocol :datagram)))
       (clean-buffers)
       (replace *send-buffer* #(1 2 3 4 5))
@@ -49,5 +55,5 @@
       (multiple-value-bind (buffer size host port)
 	  (usocket:socket-receive s *receive-buffer* *max-buffer-size*)
 	(declare (ignore buffer size host port))
-	(reduce #'+ *receive-buffer* :start 0 :end 5)))
+	(reduce #'+ *receive-buffer* :start 0 :end 5))))
   15)

Modified: usocket/trunk/test/test-usocket.lisp
==============================================================================
--- usocket/trunk/test/test-usocket.lisp	(original)
+++ usocket/trunk/test/test-usocket.lisp	Wed May 11 09:08:19 2011
@@ -157,41 +157,5 @@
         (usocket:socket-close sock))))
   t)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defparameter *wait-for-input-timeout* 2))
-
-(deftest wait-for-input.1
-  (with-caught-conditions (nil nil)
-    (let ((sock (usocket:socket-connect *common-lisp-net* 80))
-          (time (get-universal-time)))
-      (unwind-protect
-          (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
-            (- (get-universal-time) time))
-        (usocket:socket-close sock))))
-  #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.2
-  (with-caught-conditions (nil nil)
-    (let ((sock (usocket:socket-connect *common-lisp-net* 80))
-          (time (get-universal-time)))
-      (unwind-protect
-          (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t)
-            (- (get-universal-time) time))
-        (usocket:socket-close sock))))
-  #.*wait-for-input-timeout*)
-
-(deftest wait-for-input.3
-  (with-caught-conditions (nil nil)
-    (let ((sock (usocket:socket-connect *common-lisp-net* 80)))
-      (unwind-protect
-          (progn
-            (format (usocket:socket-stream sock)
-                    "GET / HTTP/1.0~2%")
-            (force-output (usocket:socket-stream sock))
-            (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
-            (subseq (read-line (usocket:socket-stream sock)) 0 15))
-        (usocket:socket-close sock))))
-  "HTTP/1.1 200 OK")
-
 (defun run-usocket-tests ()
   (do-tests))

Modified: usocket/trunk/usocket-test.asd
==============================================================================
--- usocket/trunk/usocket-test.asd	(original)
+++ usocket/trunk/usocket-test.asd	Wed May 11 09:08:19 2011
@@ -26,7 +26,8 @@
 		  :components ((:file "package")
 			       (:file "test-usocket")
 			       (:file "test-condition")
-			       (:file "test-datagram")))))
+			       (:file "test-datagram")
+			       (:file "wait-for-input")))))
 
 (defmethod perform ((op test-op) (c (eql (find-system :usocket-test))))
   (funcall (intern "DO-TESTS" "USOCKET-TEST")))

Modified: usocket/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	(original)
+++ usocket/trunk/usocket.lisp	Wed May 11 09:08:19 2011
@@ -323,9 +323,10 @@
           (values (if ready-only socks socket-or-sockets) to)))))
   (let* ((start (get-internal-real-time))
          (sockets-ready 0))
-    #-(and win32 (or sbcl ecl))
     (dolist (x (wait-list-waiters socket-or-sockets))
       (when (setf (state x)
+                  #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN
+                  #-(and win32 (or sbcl ecl))
                   (if (and (stream-usocket-p x)
                            (listen (socket-stream x)))
                       :READ NIL))



From ctian at common-lisp.net  Wed May 11 13:10:35 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 09:10:35 -0400
Subject: [usocket-cvs] r661 - usocket/tags/0.5.2
Message-ID: <E1QK9BT-0006cG-2p@common-lisp.net>

Author: ctian
Date: Wed May 11 09:10:34 2011
New Revision: 661

Log:
Created tag 0.5.2.

Added:
   usocket/tags/0.5.2/
      - copied from r660, /usocket/branches/0.5.x/



From ctian at common-lisp.net  Wed May 11 13:15:54 2011
From: ctian at common-lisp.net (Chun Tian (binghe))
Date: Wed, 11 May 2011 09:15:54 -0400
Subject: [usocket-cvs] r662 - public_html/releases
Message-ID: <E1QK9Gc-00071p-8z@common-lisp.net>

Author: ctian
Date: Wed May 11 09:15:51 2011
New Revision: 662

Log:
usocket 0.5.2 (with release script)

Added:
   public_html/releases/release.sh   (contents, props changed)
   public_html/releases/usocket-0.5.2.tar.gz   (contents, props changed)
   public_html/releases/usocket-0.5.2.tar.gz.asc
Modified:
   public_html/releases/usocket-latest.tar.gz
   public_html/releases/usocket-latest.tar.gz.asc

Added: public_html/releases/release.sh
==============================================================================
--- (empty file)
+++ public_html/releases/release.sh	Wed May 11 09:15:51 2011
@@ -0,0 +1,14 @@
+#!/bin/sh
+set -x
+
+svn export svn://common-lisp.net/project/usocket/svn/usocket/tags/$1 usocket-$1
+tar cvzf usocket-$1.tar.gz usocket-$1
+rm -rf usocket-$1
+rm usocket-latest.tar.gz
+ln -s usocket-$1.tar.gz usocket-latest.tar.gz
+gpg -b -a usocket-$1.tar.gz
+rm usocket-latest.tar.gz.asc
+ln -s usocket-$1.tar.gz.asc usocket-latest.tar.gz.asc
+svn add usocket-$1.tar.gz
+svn add usocket-$1.tar.gz.asc
+svn st

Added: public_html/releases/usocket-0.5.2.tar.gz
==============================================================================
Binary file. No diff available.

Added: public_html/releases/usocket-0.5.2.tar.gz.asc
==============================================================================
--- (empty file)
+++ public_html/releases/usocket-0.5.2.tar.gz.asc	Wed May 11 09:15:51 2011
@@ -0,0 +1,7 @@
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.11 (Darwin)
+
+iEYEABECAAYFAk3Ki9cACgkQny6v4+l8uLDQHQCg7ALu/jxSFO9aJH+t7Qbi4t7y
+8JcAoOK9+e8to+ysSueYCE+FIb8JMW84
+=Brqa
+-----END PGP SIGNATURE-----

Modified: public_html/releases/usocket-latest.tar.gz
==============================================================================
--- public_html/releases/usocket-latest.tar.gz	(original)
+++ public_html/releases/usocket-latest.tar.gz	Wed May 11 09:15:51 2011
@@ -1 +1 @@
-link usocket-0.5.1.tar.gz
\ No newline at end of file
+link usocket-0.5.2.tar.gz
\ No newline at end of file

Modified: public_html/releases/usocket-latest.tar.gz.asc
==============================================================================
--- public_html/releases/usocket-latest.tar.gz.asc	(original)
+++ public_html/releases/usocket-latest.tar.gz.asc	Wed May 11 09:15:51 2011
@@ -1 +1 @@
-link usocket-0.5.1.tar.gz.asc
\ No newline at end of file
+link usocket-0.5.2.tar.gz.asc
\ No newline at end of file