Author: ctian
Date: Fri Aug 12 22:58:27 2011
New Revision: 668
Log:
Merge all changes from branch 0.5.x (r663-667) before tagging 0.5.3
Modified:
usocket/trunk/CHANGES
usocket/trunk/backend/lispworks.lisp
usocket/trunk/backend/mcl.lisp
usocket/trunk/backend/sbcl.lisp
Modified: usocket/trunk/CHANGES
==============================================================================
--- usocket/trunk/CHANGES Mon Aug 8 07:20:23 2011 (r667)
+++ usocket/trunk/CHANGES Fri Aug 12 22:58:27 2011 (r668)
@@ -1,3 +1,10 @@
+0.5.3:
+
+* Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0)
+* Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket)
+* Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project).
+* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola.
+
0.5.2:
* General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms.
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp Mon Aug 8 07:20:23 2011 (r667)
+++ usocket/trunk/backend/lispworks.lisp Fri Aug 12 22:58:27 2011 (r668)
@@ -28,8 +28,7 @@
#+win32
(eval-when (:load-toplevel :execute)
- (fli:register-module "ws2_32")
- (comm::ensure-sockets))
+ (fli:register-module "ws2_32"))
(fli:define-foreign-function (get-host-name-internal "gethostname" :source)
((return-string (:reference-return (:ef-mb-string :limit 257)))
@@ -188,6 +187,20 @@
"Open a unconnected UDP socket.
For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL),
for binding on random free unused port, set LOCAL-PORT to 0."
+
+ ;; Note: move (ensure-sockets) here to make sure delivered applications
+ ;; correctly have networking support initialized.
+ ;;
+ ;; Following words was from Martin Simmons, forwarded by Camille Troillard:
+
+ ;; Calling comm::ensure-sockets at load time looks like a bug in Lispworks-udp
+ ;; (it is too early and also unnecessary).
+
+ ;; The LispWorks comm package calls comm::ensure-sockets when it is needed, so I
+ ;; think open-udp-socket should probably do it too. Calling it more than once is
+ ;; safe and it will be very fast after the first time.
+ #+win32 (comm::ensure-sockets)
+
(let ((socket-fd (comm::socket comm::*socket_af_inet* *socket_sock_dgram* *socket_ip_proto_udp*)))
(if socket-fd
(progn
Modified: usocket/trunk/backend/mcl.lisp
==============================================================================
--- usocket/trunk/backend/mcl.lisp Mon Aug 8 07:20:23 2011 (r667)
+++ usocket/trunk/backend/mcl.lisp Fri Aug 12 22:58:27 2011 (r668)
@@ -98,7 +98,7 @@
(socket (with-mapped-conditions ()
(make-instance 'passive-socket
:local-port port
- :local-host host
+ :local-host (host-to-hbo host)
:reuse-address reuseaddress
:backlog backlog))))
(make-stream-server-socket socket :element-type element-type)))
@@ -230,8 +230,7 @@
(declare (special ccl::*passive-interface-address*))
new))
-
-(defun wait-for-input-internal (wait-list &key timeout &aux result)
+(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
@@ -249,23 +248,34 @@
(declare (type ccl::lock lock))
;; crucial - clears bogus lock.value as in grab-io-buffer-lock-out-of-line:
(ccl::%io-buffer-lock-really-grabbed-p lock)
- (ccl:store-conditional lock nil ccl:*current-process*))
- (input-available (stream)
- "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
- (let ((io-buffer (ccl::stream-io-buffer stream)))
- (or (not (eql 0 (ccl::io-buffer-incount io-buffer)))
- (ccl::io-buffer-untyi-char io-buffer)
- (locally (declare (optimize (speed 3) (safety 0)))
- (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
- (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))
- (ready-sockets (sockets)
- (dolist (sock sockets result)
- (when (input-available (socket-stream sock))
- (push sock result)))))
- (with-mapped-conditions ()
- (ccl:process-wait-with-timeout
- "socket input"
- (when timeout (truncate (* timeout 60)))
- #'ready-sockets
- (wait-list-waiters wait-list)))
- (nreverse result))))
+ (ccl:store-conditional lock nil ccl:*current-process*)))
+ "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock"
+ (let ((io-buffer (ccl::stream-io-buffer stream)))
+ (or (not (eql 0 (ccl::io-buffer-incount io-buffer)))
+ (ccl::io-buffer-untyi-char io-buffer)
+ (locally (declare (optimize (speed 3) (safety 0)))
+ (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer))
+ (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer))))))))
+
+(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)
+ (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"
+ (when timeout (truncate (* timeout 60)))
+ #'ready-sockets
+ (wait-list-waiters wait-list)))
+ (nreverse result)))
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp Mon Aug 8 07:20:23 2011 (r667)
+++ usocket/trunk/backend/sbcl.lisp Fri Aug 12 22:58:27 2011 (r668)
@@ -298,10 +298,24 @@
;; Now that we're connected make the stream.
(setf (socket-stream usocket)
(sb-bsd-sockets:socket-make-stream socket
- :input t
- :output t
- :buffering :full
- :element-type element-type))))
+ :input t :output t :buffering :full
+ :element-type element-type
+ ;; Robert Brown <robert.brown(a)gmail.com> said on Aug 4, 2011:
+ ;; ... This means that SBCL streams created by usocket have a true
+ ;; serve-events property. When writing large amounts of data to several
+ ;; streams, the kernel will eventually stop accepting data from SBCL.
+ ;; When this happens, SBCL either waits for I/O to be possible on
+ ;; the file descriptor it's writing to or queues the data to be flushed later.
+ ;; Because usocket streams specify serve-events as true, SBCL
+ ;; always queues. Instead, it should wait for I/O to be available and
+ ;; write the remaining data to the socket. That's what serve-events
+ ;; equal to NIL gets you.
+ ;;
+ ;; Nikodemus Siivola <nikodemus(a)random-state.net> said on Aug 8, 2011:
+ ;; It's set to T for purely historical reasons, and will soon change to
+ ;; NIL in SBCL. (The docstring has warned of T being a temporary default
+ ;; for as long as the :SERVE-EVENTS keyword argument has existed.)
+ :serve-events nil))))
(:datagram
(when (or local-host local-port)
(sb-bsd-sockets:socket-bind socket
