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@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@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