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

[usocket-cvs] r425 - in usocket/branches/experimental-udp: . backend
by ctian＠common-lisp.net 02 Oct '08

02 Oct '08

Author: ctian Date: Thu Oct 2 18:48:46 2008 New Revision: 425 Added: usocket/branches/experimental-udp/ - copied from r424, usocket/trunk/ Modified: usocket/branches/experimental-udp/backend/lispworks.lisp Log: New branch: experimental UDP support Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Thu Oct 2 18:48:46 2008 @@ -216,15 +216,20 @@ ;; Can we have a sane -pref. complete [UDP!?]- API next time, please? (dolist (x (wait-list-waiters wait-list)) (mp:notice-fd (os-socket-handle x))) - (mp:process-wait-with-timeout "Waiting for a socket to become active" - (truncate timeout) - #'(lambda (socks) - (let (rv) - (dolist (x socks rv) - (when (usocket-listen x) - (setf (state x) :READ - rv t))))) - (wait-list-waiters wait-list)) + (labels ((wait-function (socks) + (let (rv) + (dolist (x socks rv) + (when (usocket-listen x) + (setf (state x) :READ + rv t)))))) + (if timeout + (mp:process-wait-with-timeout "Waiting for a socket to become active" + (truncate timeout) + #'wait-function + (wait-list-waiters wait-list)) + (mp:process-wait "Waiting for a socket to become active" + #'wait-function + (wait-list-waiters wait-list)))) (dolist (x (wait-list-waiters wait-list)) (mp:unnotice-fd (os-socket-handle x))) wait-list)))

1 0

[usocket-cvs] r424 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 18 Sep '08

18 Sep '08

Author: ehuelsmann Date: Thu Sep 18 11:44:23 2008 New Revision: 424 Modified: usocket/trunk/backend/sbcl.lisp Log: Don't leak file descriptors. Found by: Lars Nostdal <larsnostdal at gmail dot com> Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Thu Sep 18 11:44:23 2008 @@ -213,27 +213,33 @@ (not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))) (unsupported 'nodelay 'socket-connect)) - (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket - :type :stream :protocol :tcp)) - (stream (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)) - ;;###FIXME: The above line probably needs an :external-format - (usocket (make-stream-socket :stream stream :socket socket)) - (ip (host-to-vector-quad host))) - (when (and nodelay-specified - (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (with-mapped-conditions (usocket) - (sb-bsd-sockets:socket-connect socket ip port)) - usocket)) + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket + :type :stream :protocol :tcp))) + (handler-case + (let* ((stream + (sb-bsd-sockets:socket-make-stream socket + :input t + :output t + :buffering :full + :element-type element-type)) + ;;###FIXME: The above line probably needs an :external-format + (usocket (make-stream-socket :stream stream :socket socket)) + (ip (host-to-vector-quad host))) + (when (and nodelay-specified + (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)) + (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port)) + usocket) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close socket) + (error c))))) (defun socket-listen (host port &key reuseaddress @@ -244,11 +250,16 @@ (ip (host-to-vector-quad host)) (sock (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (with-mapped-conditions () - (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) - (sb-bsd-sockets:socket-bind sock ip port) - (sb-bsd-sockets:socket-listen sock backlog) - (make-stream-server-socket sock :element-type element-type)))) + (handler-case + (with-mapped-conditions () + (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress) + (sb-bsd-sockets:socket-bind sock ip port) + (sb-bsd-sockets:socket-listen sock backlog) + (make-stream-server-socket sock :element-type element-type)) + (t (c) + ;; Make sure we don't leak filedescriptors + (sb-bsd-sockets:socket-close sock) + (error c))))) (defmethod socket-accept ((socket stream-server-usocket) &key element-type) (with-mapped-conditions (socket)

1 0

[usocket-cvs] r423 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 08 Aug '08

08 Aug '08

Author: ehuelsmann Date: Fri Aug 8 17:08:41 2008 New Revision: 423 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix the fixed fix. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 8 17:08:41 2008 @@ -334,8 +334,8 @@ (multiple-value-bind (count err) (sb-unix:unix-fast-select - (1+ (reduce #'max (wait-list-%wait sockets)) - :key #'sb-bsd-sockets:socket-file-descriptor) + (1+ (reduce #'max (wait-list-%wait sockets) + :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) (if (null count)

1 0

[usocket-cvs] r422 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 08 Aug '08

08 Aug '08

Author: ehuelsmann Date: Fri Aug 8 17:02:48 2008 New Revision: 422 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix the fixed fix. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 8 17:02:48 2008 @@ -343,9 +343,11 @@ (error (map-errno-error err))) (when (< 0 count) ;; process the result... - (dolist (x (wait-list-%wait sockets)) + (dolist (x (wait-list-waiters sockets)) (when (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor x) rfds) + (sb-bsd-sockets:socket-file-descriptor + (socket x)) + rfds) (setf (state x) :READ)))))))))) #+win32

1 0

[usocket-cvs] r421 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 08 Aug '08

08 Aug '08

Author: ehuelsmann Date: Fri Aug 8 16:22:59 2008 New Revision: 421 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix the fixed fix. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 8 16:22:59 2008 @@ -335,7 +335,7 @@ (count err) (sb-unix:unix-fast-select (1+ (reduce #'max (wait-list-%wait sockets)) - :key #'sb-bsd-sockets:socket-file-descriptor)) + :key #'sb-bsd-sockets:socket-file-descriptor) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) (if (null count) @@ -346,7 +346,7 @@ (dolist (x (wait-list-%wait sockets)) (when (sb-unix:fd-isset (sb-bsd-sockets:socket-file-descriptor x) rfds) - (setf (state x) :READ))))))))) + (setf (state x) :READ)))))))))) #+win32 (warn "wait-for-input not (yet!) supported...")

1 0

[usocket-cvs] r420 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 08 Aug '08

08 Aug '08

Author: ehuelsmann Date: Fri Aug 8 16:21:32 2008 New Revision: 420 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix the fix. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 8 16:21:32 2008 @@ -346,7 +346,7 @@ (dolist (x (wait-list-%wait sockets)) (when (sb-unix:fd-isset (sb-bsd-sockets:socket-file-descriptor x) rfds) - (setf (state x) :READ)))))))))) + (setf (state x) :READ))))))))) #+win32 (warn "wait-for-input not (yet!) supported...")

1 0

[usocket-cvs] r419 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 08 Aug '08

08 Aug '08

Author: ehuelsmann Date: Fri Aug 8 16:19:42 2008 New Revision: 419 Modified: usocket/trunk/backend/sbcl.lisp Log: Fix SBCL waiting backend. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 8 16:19:42 2008 @@ -334,7 +334,7 @@ (multiple-value-bind (count err) (sb-unix:unix-fast-select - (1+ (reduce #'max (mapcar #'socket (wait-list-waiters sockets)) + (1+ (reduce #'max (wait-list-%wait sockets)) :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) @@ -343,10 +343,9 @@ (error (map-errno-error err))) (when (< 0 count) ;; process the result... - (dolist (x (wait-list-waiters sockets)) - (when (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds)) + (dolist (x (wait-list-%wait sockets)) + (when (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor x) rfds) (setf (state x) :READ)))))))))) #+win32

1 0

[usocket-cvs] r418 - usocket/branches/0.4.x/backend
by ehuelsmann＠common-lisp.net 07 Aug '08

07 Aug '08

Author: ehuelsmann Date: Thu Aug 7 16:32:59 2008 New Revision: 418 Modified: usocket/branches/0.4.x/backend/openmcl.lisp Log: Merge c414 from trunk (fix for CCL/OpenMCL backend). Modified: usocket/branches/0.4.x/backend/openmcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/openmcl.lisp (original) +++ usocket/branches/0.4.x/backend/openmcl.lisp Thu Aug 7 16:32:59 2008 @@ -164,10 +164,9 @@ (defun wait-for-input-internal (wait-list &key timeout) (with-mapped-conditions () (let* ((ticks-timeout (truncate (* (or timeout 1) - ccl::*ticks-per-second*))) - (active-internal-sockets - (input-available-p (wait-list-waiters wait-list) - (when timeout ticks-timeout)))) + ccl::*ticks-per-second*)))) + (input-available-p (wait-list-waiters wait-list) + (when timeout ticks-timeout)) wait-list)))

1 0

[usocket-cvs] r417 - public_html
by ehuelsmann＠common-lisp.net 07 Aug '08

07 Aug '08

Author: ehuelsmann Date: Thu Aug 7 16:29:51 2008 New Revision: 417 Modified: public_html/api-docs.shtml Log: More xhtml compliance. Modified: public_html/api-docs.shtml ============================================================================== --- public_html/api-docs.shtml (original) +++ public_html/api-docs.shtml Thu Aug 7 16:29:51 2008 @@ -103,7 +103,7 @@ <dt class="sym">get-local-name socket => address, port get-local-name socket => address get-local-port socket => port</dt> -<dd>Returns the local address and/or port information of socket.</dd> +<dd>Returns the local address and/or port information of socket.</dd> <dt class="sym">get-peer-name socket => address, port get-peer-name socket => address

1 0

[usocket-cvs] r416 - public_html
by ehuelsmann＠common-lisp.net 07 Aug '08

07 Aug '08

Author: ehuelsmann Date: Thu Aug 7 16:28:36 2008 New Revision: 416 Modified: public_html/api-docs.shtml Log: Further explanation and xhtml compliance. Modified: public_html/api-docs.shtml ============================================================================== --- public_html/api-docs.shtml (original) +++ public_html/api-docs.shtml Thu Aug 7 16:28:36 2008 @@ -108,7 +108,8 @@ <dt class="sym">get-peer-name socket => address, port get-peer-name socket => address get-peer-port socket => port</dt> -<dd>Returns the remote address and/or port information of socket.</dd> +<dd>Returns the remote address and/or port information of socket. + The socket passed to this function must be a connected socket.</dd> </dl>

1 0