June 2011 - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r666 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 30 Jun '11

30 Jun '11

Author: ctian Date: Thu Jun 30 09:38:18 2011 New Revision: 666 Log: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications. Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/lispworks.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Sun Jun 26 08:55:52 2011 (r665) +++ usocket/branches/0.5.x/CHANGES Thu Jun 30 09:38:18 2011 (r666) @@ -1,7 +1,8 @@ 0.5.3: -* [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) -* [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) +* 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). 0.5.2: Modified: usocket/branches/0.5.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.5.x/backend/lispworks.lisp Sun Jun 26 08:55:52 2011 (r665) +++ usocket/branches/0.5.x/backend/lispworks.lisp Thu Jun 30 09:38:18 2011 (r666) @@ -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

1 0

[usocket-cvs] r665 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 26 Jun '11

26 Jun '11

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"

1 0

[usocket-cvs] r664 - usocket/branches/0.5.x/backend
by ctian＠common-lisp.net 26 Jun '11

26 Jun '11

Author: ctian Date: Sat Jun 25 18:15:16 2011 New Revision: 664 Log: [mcl] separated input-available-p from wait-for-input-internel; add polling delay to prevent 100% CPU payload as suggest by Terje Modified: usocket/branches/0.5.x/backend/mcl.lisp Modified: usocket/branches/0.5.x/backend/mcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 00:02:05 2011 (r663) +++ usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 18:15:16 2011 (r664) @@ -230,8 +230,7 @@ (declare (special ccl::*passive-interface-address*)) new)) - -(defun wait-for-input-internal (wait-list &key timeout &aux result) +(defun input-available-p (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,32 @@ (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)))))))) + +(defparameter *passive-polling-delay* 1/60) + +(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)))) + (with-mapped-conditions () + (ccl:process-wait-with-timeout + "socket input" + (when timeout (truncate (* timeout 60))) + #'ready-sockets + (wait-list-waiters wait-list))) + (nreverse result)))

1 0

[usocket-cvs] r663 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 25 Jun '11

25 Jun '11

Author: ctian Date: Sat Jun 25 00:02:05 2011 New Revision: 663 Log: [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) 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 Wed May 11 06:15:51 2011 (r662) +++ usocket/branches/0.5.x/CHANGES Sat Jun 25 00:02:05 2011 (r663) @@ -1,3 +1,7 @@ +0.5.3: + +* [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) + 0.5.2: * General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms. Modified: usocket/branches/0.5.x/backend/mcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/mcl.lisp Wed May 11 06:15:51 2011 (r662) +++ usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 00:02:05 2011 (r663) @@ -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)))

1 0