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

[usocket-cvs] r405 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 30 Jul '08

30 Jul '08

Author: ehuelsmann Date: Wed Jul 30 15:26:46 2008 New Revision: 405 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp Log: Implement local-host and local-port binding for SOCKET-CONNECT. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Wed Jul 30 15:26:46 2008 @@ -51,7 +51,8 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline - (nodelay t)) ;; nodelay == t is the ACL default + (nodelay t) ;; nodelay == t is the ACL default + local-host local-port) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) @@ -62,10 +63,14 @@ (mp:with-timeout (timeout nil) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port :format (to-format element-type) :nodelay nodelay)) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port + :local-host local-host + :local-port local-port :format (to-format element-type) :nodelay nodelay)))) (make-stream-socket :socket socket :stream socket))) Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Wed Jul 30 15:26:46 2008 @@ -187,8 +187,12 @@ (error (error 'unknown-error :socket socket :real-error condition)))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline (nodelay nil nodelay-specified)) + timeout deadline (nodelay nil nodelay-specified) + local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) + (when (or local-host local-port) + (unimplemented 'local-host 'socket-connect) + (unimplemented 'local-port 'socket-connect)) (let ((usock)) (with-mapped-conditions (usock) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Wed Jul 30 15:26:46 2008 @@ -56,11 +56,15 @@ (signal usock-err :socket socket))))))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline (nodelay t nodelay-specified)) + timeout deadline (nodelay t nodelay-specified) + local-host local-port) (declare (ignore nodelay)) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when (or local-host local-port) + (unsupported 'local-host 'socket-connect) + (unsupported 'local-port 'socket-connect)) (let ((socket) (hostname (host-to-hostname host))) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Wed Jul 30 15:26:46 2008 @@ -51,11 +51,15 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline (nodelay t nodelay-specified)) + timeout deadline (nodelay t nodelay-specified) + local-host local-port) (declare (ignore nodelay)) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when (or local-host local-port) + (unsupported 'local-host 'socket-connect) + (unsupported 'local-port 'socket-connect)) (let* ((socket)) (setf socket Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Wed Jul 30 15:26:46 2008 @@ -81,6 +81,10 @@ #+(and (not lispworks4) (not lispworks5.0)) (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) + #+lispworks4 + (when (or local-host local-port) + (unsupported 'local-host 'socket-connect "LispWorks 5.0+ (verified)") + (unsupported 'local-port 'socket-connect "LispWorks 5.0+ (verified)")) (let ((hostname (host-to-hostname host)) (stream)) @@ -88,6 +92,10 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type + #-lispworks4 #-lispworks4 + #-lispworks4 #-lispworks4 + :local-address (when local-host (host-to-hostname local-host)) + :local-port local-port #+(and (not lispworks4) (not lispworks5.0)) #+(and (not lispworks4) (not lispworks5.0)) :nodelay nodelay))) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Wed Jul 30 15:26:46 2008 @@ -74,11 +74,14 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) +(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay + local-host local-port) (with-mapped-conditions () (let ((mcl-sock (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port + :local-host (when local-host (host-to-hostname local-host)) + :local-port local-port :format (to-format element-type) :deadline deadline :nodelay nodelay Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Wed Jul 30 15:26:46 2008 @@ -200,7 +200,8 @@ (defun socket-connect (host port &key (element-type 'character) - timeout deadline (nodelay t nodelay-specified)) + timeout deadline (nodelay t nodelay-specified) + local-host local-port) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) @@ -216,6 +217,9 @@ (ip (host-to-vector-quad host))) (when nodelay-specified (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets: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)) Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Wed Jul 30 15:26:46 2008 @@ -29,11 +29,15 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline (nodelay t nodelay-specified)) + timeout deadline (nodelay t nodelay-specified) + local-host local-port) (declare (ignore nodelay)) (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) + (when (or local-host local-port) + (unsupported 'local-host 'socket-connect) + (unsupported 'local-port 'socket-connect)) (let* ((socket (with-mapped-conditions () (ext:connect-to-inet-socket (host-to-hbo host) port

1 0

[usocket-cvs] r404 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 29 Jul '08

29 Jul '08

Author: ehuelsmann Date: Tue Jul 29 17:18:10 2008 New Revision: 404 Modified: usocket/trunk/backend/armedbear.lisp Log: Remove invalid IGNORE declaration. Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Tue Jul 29 17:18:10 2008 @@ -188,7 +188,6 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay nil nodelay-specified)) - (declare (ignore nodelay timeout)) (when deadline (unsupported 'deadline 'socket-connect)) (let ((usock))

1 0

[usocket-cvs] r403 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 29 Jul '08

29 Jul '08

Author: ehuelsmann Date: Tue Jul 29 17:13:43 2008 New Revision: 403 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp Log: Make reporting of unimplemented and unsupported features dependent on their use. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Jul 29 17:13:43 2008 @@ -52,9 +52,8 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t)) ;; nodelay == t is the ACL default - (declare (ignorable timeout)) - (unsupported 'timeout 'socket-connect) - (unsupported 'deadline 'socket-connect) + (when timeout (unsupported 'timeout 'socket-connect)) + (when deadline (unsupported 'deadline 'socket-connect)) (let ((socket)) (setf socket Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Tue Jul 29 17:13:43 2008 @@ -189,8 +189,7 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay nil nodelay-specified)) (declare (ignore nodelay timeout)) - (unsupported 'timeout 'socket-connect) - (unimplemented 'deadline 'socket-connect) + (when deadline (unsupported 'deadline 'socket-connect)) (let ((usock)) (with-mapped-conditions (usock) @@ -207,6 +206,9 @@ (if nodelay (java:make-immediate-object t :boolean) (java:make-immediate-object nil :boolean)))) + (when timeout + (jdi:do-jmethod-call sock "setSoTimeout" + (truncate (* 1000 timeout)))) (setf usock (make-stream-socket :socket jchan Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Tue Jul 29 17:13:43 2008 @@ -56,11 +56,11 @@ (signal usock-err :socket socket))))))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline nodelay) - (declare (ignore nodelay timeout)) - (unsupported 'timeout 'socket-connect) - (unsupported 'deadline 'socket-connect) - (unsupported 'nodelay 'socket-connect) + timeout deadline (nodelay t nodelay-specified)) + (declare (ignore nodelay)) + (when timeout (unsupported 'timeout 'socket-connect)) + (when deadline (unsupported 'deadline 'socket-connect)) + (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (let ((socket) (hostname (host-to-hostname host))) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Tue Jul 29 17:13:43 2008 @@ -51,11 +51,11 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline nodelay) - (declare (ignore nodelay timeout)) - (unsupported 'timeout 'socket-connect) - (unsupported 'deadline 'socket-connect) - (unsupported 'nodelay 'socket-connect) + timeout deadline (nodelay t nodelay-specified)) + (declare (ignore nodelay)) + (when timeout (unsupported 'timeout 'socket-connect)) + (when deadline (unsupported 'deadline 'socket-connect)) + (when nodelay-specified (unsupported 'nodelay 'socket-connect)) (let* ((socket)) (setf socket Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jul 29 17:13:43 2008 @@ -74,17 +74,23 @@ (raise-usock-err errno socket condition))))) (defun socket-connect (host port &key (element-type 'base-char) - timeout deadline nodelay) - (declare (ignore nodelay)) - (unsupported 'timeout 'socket-connect) - (unsupported 'deadline 'socket-connect) - (unimplemented 'nodelay 'socket-connect) + timeout deadline (nodelay t nodelay-specified)) + (declare (ignorable nodelay)) + (when timeout (unimplemented 'timeout 'socket-connect)) + (when deadline (unsupported 'deadline 'socket-connect "LispWorks 5.1")) + + #+(and (not lispworks4) (not lispworks5.0)) + (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) + (let ((hostname (host-to-hostname host)) (stream)) (setf stream (with-mapped-conditions () (comm:open-tcp-stream hostname port - :element-type element-type))) + :element-type element-type + #+(and (not lispworks4) (not lispworks5.0)) + #+(and (not lispworks4) (not lispworks5.0)) + :nodelay nodelay))) (if stream (make-stream-socket :socket (comm:socket-stream-socket stream) :stream stream) @@ -96,9 +102,10 @@ (backlog 5) (element-type 'base-char)) #+lispworks4.1 - (unsupported 'host 'socket-listen) + (unsupported 'host 'socket-listen "LispWorks 4.0 or newer than 4.1") #+lispworks4.1 - (unsupported 'backlog 'socket-listen) + (unsupported 'backlog 'socket-listen "LispWorks 4.0 or newer than 4.1") + (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress)) (comm::*use_so_reuseaddr* reuseaddress) (hostname (host-to-hostname host)) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Tue Jul 29 17:13:43 2008 @@ -201,9 +201,8 @@ (defun socket-connect (host port &key (element-type 'character) timeout deadline (nodelay t nodelay-specified)) - (declare (ignore deadline timeout)) - (unsupported 'deadline 'socket-connect) - (unsupported 'timeout 'socket-connect) + (when deadline (unsupported 'deadline 'socket-connect)) + (when timeout (unsupported 'timeout 'socket-connect)) (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)) Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Tue Jul 29 17:13:43 2008 @@ -29,11 +29,11 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) - timeout deadline nodelay) - (declare (ignore nodelay timeout)) - (unsupported 'nodelay 'socket-connect) - (unsupported 'deadline 'socket-connect) - (unsupported 'timeout 'socket-connect) + timeout deadline (nodelay t nodelay-specified)) + (declare (ignore nodelay)) + (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when deadline (unsupported 'deadline 'socket-connect)) + (when timeout (unsupported 'timeout 'socket-connect)) (let* ((socket (with-mapped-conditions () (ext:connect-to-inet-socket (host-to-hbo host) port

1 0

[usocket-cvs] r402 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 29 Jul '08

29 Jul '08

Author: ehuelsmann Date: Tue Jul 29 02:08:34 2008 New Revision: 402 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/scl.lisp Log: Add DEADLINE everywhere. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Tue Jul 29 02:08:34 2008 @@ -49,10 +49,12 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout +(defun socket-connect (host port &key (element-type 'character) + timeout deadline (nodelay t)) ;; nodelay == t is the ACL default (declare (ignorable timeout)) (unsupported 'timeout 'socket-connect) + (unsupported 'deadline 'socket-connect) (let ((socket)) (setf socket Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Tue Jul 29 02:08:34 2008 @@ -55,10 +55,12 @@ (error usock-err :socket socket) (signal usock-err :socket socket))))))) -(defun socket-connect (host port &key (element-type 'character) timeout nodelay) +(defun socket-connect (host port &key (element-type 'character) + timeout deadline nodelay) (declare (ignore nodelay timeout)) - (unsupported 'nodelay 'socket-connect) (unsupported 'timeout 'socket-connect) + (unsupported 'deadline 'socket-connect) + (unsupported 'nodelay 'socket-connect) (let ((socket) (hostname (host-to-hostname host))) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Tue Jul 29 02:08:34 2008 @@ -50,10 +50,12 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout nodelay) +(defun socket-connect (host port &key (element-type 'character) + timeout deadline nodelay) (declare (ignore nodelay timeout)) - (unsupported 'nodelay 'socket-connect) (unsupported 'timeout 'socket-connect) + (unsupported 'deadline 'socket-connect) + (unsupported 'nodelay 'socket-connect) (let* ((socket)) (setf socket Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Tue Jul 29 02:08:34 2008 @@ -73,9 +73,11 @@ (declare (ignore host port err-msg)) (raise-usock-err errno socket condition))))) -(defun socket-connect (host port &key (element-type 'base-char) timeout nodelay) +(defun socket-connect (host port &key (element-type 'base-char) + timeout deadline nodelay) (declare (ignore nodelay)) (unsupported 'timeout 'socket-connect) + (unsupported 'deadline 'socket-connect) (unimplemented 'nodelay 'socket-connect) (let ((hostname (host-to-hostname host)) (stream)) Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Tue Jul 29 02:08:34 2008 @@ -28,9 +28,11 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout nodelay) +(defun socket-connect (host port &key (element-type 'character) + timeout deadline nodelay) (declare (ignore nodelay timeout)) (unsupported 'nodelay 'socket-connect) + (unsupported 'deadline 'socket-connect) (unsupported 'timeout 'socket-connect) (let* ((socket (with-mapped-conditions ()

1 0

[usocket-cvs] r401 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 28 Jul '08

28 Jul '08

Author: ehuelsmann Date: Mon Jul 28 18:16:52 2008 New Revision: 401 Modified: usocket/trunk/backend/armedbear.lisp Log: Implement some of the 'new hot stuff': nodelay (ABCL). Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 18:16:52 2008 @@ -186,26 +186,32 @@ (typecase condition (error (error 'unknown-error :socket socket :real-error condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout nodelay) +(defun socket-connect (host port &key (element-type 'character) + timeout deadline (nodelay nil nodelay-specified)) (declare (ignore nodelay timeout)) (unsupported 'timeout 'socket-connect) - (unimplemented 'nodelay 'socket-connect) + (unimplemented 'deadline 'socket-connect) (let ((usock)) (with-mapped-conditions (usock) (let* ((sock-addr (jdi:jcoerce (jdi:do-jnew-call "java.net.InetSocketAddress" - (host-to-hostname host) - (jdi:jcoerce port :int)) + (host-to-hostname host) + (jdi:jcoerce port :int)) "java.net.SocketAddress")) (jchan (jdi:do-jstatic-call "java.nio.channels.SocketChannel" - "open" sock-addr)) + "open" sock-addr)) (sock (jdi:do-jmethod-call jchan "socket"))) - (setf usock - (make-stream-socket - :socket jchan - :stream (ext:get-socket-stream (jdi:jop-deref sock) - :element-type element-type))))))) + (when nodelay-specified + (jdi:do-jmethod-call sock "setTcpNoDelay" + (if nodelay + (java:make-immediate-object t :boolean) + (java:make-immediate-object nil :boolean)))) + (setf usock + (make-stream-socket + :socket jchan + :stream (ext:get-socket-stream (jdi:jop-deref sock) + :element-type element-type))))))) (defun socket-listen (host port &key reuseaddress

1 0

[usocket-cvs] r400 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 28 Jul '08

28 Jul '08

Author: ehuelsmann Date: Mon Jul 28 18:10:18 2008 New Revision: 400 Modified: usocket/trunk/backend/sbcl.lisp Log: Implement some of the 'new hot stuff': nodelay. Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 18:10:18 2008 @@ -199,14 +199,12 @@ (signal usock-cond :socket socket)))))) -(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) - (declare (ignore nodelay)) - (declare (ignore deadline)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in SBCL")) +(defun socket-connect (host port &key (element-type 'character) + timeout deadline (nodelay t nodelay-specified)) + (declare (ignore deadline timeout)) (unsupported 'deadline 'socket-connect) (unsupported 'timeout 'socket-connect) - (unimplemented 'nodelay 'socket-connect) + (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket @@ -217,6 +215,8 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) + (when nodelay-specified + (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) (with-mapped-conditions (usocket) (sb-bsd-sockets:socket-connect socket ip port)) usocket))

1 0

[usocket-cvs] r399 - in usocket/trunk: . backend
by ehuelsmann＠common-lisp.net 28 Jul '08

28 Jul '08

Author: ehuelsmann Date: Mon Jul 28 17:57:23 2008 New Revision: 399 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp usocket/trunk/condition.lisp Log: Signal to the caller whenever a certain feature is unavailable. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Mon Jul 28 17:57:23 2008 @@ -49,10 +49,11 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in Allegro CL")) +(defun socket-connect (host port &key (element-type 'character) timeout + (nodelay t)) ;; nodelay == t is the ACL default + (declare (ignorable timeout)) + (unsupported 'timeout 'socket-connect) + (let ((socket)) (setf socket (with-mapped-conditions (socket) @@ -60,10 +61,12 @@ (mp:with-timeout (timeout nil) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :format (to-format element-type))) + :format (to-format element-type) + :nodelay nodelay)) (socket:make-socket :remote-host (host-to-hostname host) :remote-port port - :format (to-format element-type))))) + :format (to-format element-type) + :nodelay nodelay)))) (make-stream-socket :socket socket :stream socket))) Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 17:57:23 2008 @@ -187,9 +187,10 @@ (error (error 'unknown-error :socket socket :real-error condition)))) (defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in ABCL")) + (declare (ignore nodelay timeout)) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) + (let ((usock)) (with-mapped-conditions (usock) (let* ((sock-addr (jdi:jcoerce Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jul 28 17:57:23 2008 @@ -56,9 +56,10 @@ (signal usock-err :socket socket))))))) (defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in CLISP")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let ((socket) (hostname (host-to-hostname host))) (with-mapped-conditions (socket) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Mon Jul 28 17:57:23 2008 @@ -51,9 +51,10 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in CMUCL")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let* ((socket)) (setf socket (with-mapped-conditions (socket) Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Jul 28 17:57:23 2008 @@ -75,8 +75,8 @@ (defun socket-connect (host port &key (element-type 'base-char) timeout nodelay) (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in Lispworks")) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) (let ((hostname (host-to-hostname host)) (stream)) (setf stream @@ -93,6 +93,10 @@ (reuse-address nil reuse-address-supplied-p) (backlog 5) (element-type 'base-char)) + #+lispworks4.1 + (unsupported 'host 'socket-listen) + #+lispworks4.1 + (unsupported 'backlog 'socket-listen) (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress)) (comm::*use_so_reuseaddr* reuseaddress) (hostname (host-to-hostname host)) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 17:57:23 2008 @@ -204,6 +204,9 @@ (declare (ignore deadline)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SBCL")) + (unsupported 'deadline 'socket-connect) + (unsupported 'timeout 'socket-connect) + (unimplemented 'nodelay 'socket-connect) (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp)) (stream (sb-bsd-sockets:socket-make-stream socket Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Mon Jul 28 17:57:23 2008 @@ -29,9 +29,10 @@ :condition condition)))) (defun socket-connect (host port &key (element-type 'character) timeout nodelay) - (declare (ignore nodelay)) - (when timeout - (warn "SOCKET-CONNECT timeout not supported in SCL")) + (declare (ignore nodelay timeout)) + (unsupported 'nodelay 'socket-connect) + (unsupported 'timeout 'socket-connect) + (let* ((socket (with-mapped-conditions () (ext:connect-to-inet-socket (host-to-hbo host) port :kind :stream))) Modified: usocket/trunk/condition.lisp ============================================================================== --- usocket/trunk/condition.lisp (original) +++ usocket/trunk/condition.lisp Mon Jul 28 17:57:23 2008 @@ -190,3 +190,11 @@ (2 . ns-try-again-condition) (3 . ns-no-recovery-error))) + + +(defmacro unsupported (feature context &key minimum) + `(signal 'unsupported :feature ,feature + :context ,context :minimum ,minimum)) + +(defmacro unimplemented (feature context) + `(signal 'unimplemented :feature ,feature :context ,context)) \ No newline at end of file

1 0

[usocket-cvs] r398 - usocket/branches/hans
by ehuelsmann＠common-lisp.net 28 Jul '08

28 Jul '08

Author: ehuelsmann Date: Mon Jul 28 17:34:04 2008 New Revision: 398 Removed: usocket/branches/hans/ Log: Remove now-obsolete branch.

1 0

[usocket-cvs] r397 - usocket/trunk/backend
by ehuelsmann＠common-lisp.net 28 Jul '08

28 Jul '08

Author: ehuelsmann Date: Mon Jul 28 17:33:19 2008 New Revision: 397 Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/backend/armedbear.lisp usocket/trunk/backend/clisp.lisp usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp Log: Merge hans/ branch into trunk. Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp (original) +++ usocket/trunk/backend/allegro.lisp Mon Jul 28 17:33:19 2008 @@ -49,7 +49,10 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in Allegro CL")) (let ((socket)) (setf socket (with-mapped-conditions (socket) Modified: usocket/trunk/backend/armedbear.lisp ============================================================================== --- usocket/trunk/backend/armedbear.lisp (original) +++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 17:33:19 2008 @@ -186,7 +186,8 @@ (typecase condition (error (error 'unknown-error :socket socket :real-error condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in ABCL")) (let ((usock)) Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp (original) +++ usocket/trunk/backend/clisp.lisp Mon Jul 28 17:33:19 2008 @@ -55,7 +55,10 @@ (error usock-err :socket socket) (signal usock-err :socket socket))))))) -(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) + (when timeout + (warn "SOCKET-CONNECT timeout not supported in CLISP")) (let ((socket) (hostname (host-to-hostname host))) (with-mapped-conditions (socket) @@ -239,7 +242,7 @@ (when (wait-list usocket) (remove-waiter (wait-list usocket) usocket)) (rawsock:sock-close (socket usocket))) - + ) #-rawsock @@ -248,4 +251,4 @@ To enable UDP socket support, please be sure to use the -Kfull parameter at startup, or to enable RAWSOCK support during compilation.") - ) \ No newline at end of file + ) Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Mon Jul 28 17:33:19 2008 @@ -50,7 +50,8 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in CMUCL")) (let* ((socket)) Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Mon Jul 28 17:33:19 2008 @@ -73,7 +73,8 @@ (declare (ignore host port err-msg)) (raise-usock-err errno socket condition))))) -(defun socket-connect (host port &key (element-type 'base-char) timeout) +(defun socket-connect (host port &key (element-type 'base-char) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in Lispworks")) (let ((hostname (host-to-hostname host)) Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Mon Jul 28 17:33:19 2008 @@ -61,6 +61,8 @@ (openmcl-socket:socket-error (raise-error-from-id (openmcl-socket:socket-error-identifier condition) socket condition)) + (ccl:input-timeout + (error 'timeout-error :socket socket :real-error condition)) (ccl:communication-deadline-expired (error 'timeout-error :socket socket :real-error condition)) (ccl::socket-creation-error #| ugh! |# @@ -72,13 +74,14 @@ :text :binary)) -(defun socket-connect (host port &key (element-type 'character) timeout deadline) +(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) (with-mapped-conditions () (let ((mcl-sock (openmcl-socket:make-socket :remote-host (host-to-hostname host) :remote-port port :format (to-format element-type) :deadline deadline + :nodelay nodelay :connect-timeout (and timeout (* timeout internal-time-units-per-second))))) (openmcl-socket:socket-connect mcl-sock) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 17:33:19 2008 @@ -130,7 +130,7 @@ } @(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL, (#0 != Cnil) ? &tv : NULL); -"))) +" :one-liner nil))) (cond ((= 0 count) (values nil nil)) @@ -199,7 +199,8 @@ (signal usock-cond :socket socket)))))) -(defun socket-connect (host port &key (element-type 'character) timeout deadline) +(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay) + (declare (ignore nodelay)) (declare (ignore deadline)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SBCL")) Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Mon Jul 28 17:33:19 2008 @@ -28,7 +28,8 @@ :socket socket :condition condition)))) -(defun socket-connect (host port &key (element-type 'character) timeout) +(defun socket-connect (host port &key (element-type 'character) timeout nodelay) + (declare (ignore nodelay)) (when timeout (warn "SOCKET-CONNECT timeout not supported in SCL")) (let* ((socket (with-mapped-conditions ()

1 0

[usocket-cvs] r396 - in usocket: branches/0.4.x/backend trunk/backend
by ehuelsmann＠common-lisp.net 27 Jul '08

27 Jul '08

Author: ehuelsmann Date: Sun Jul 27 16:22:48 2008 New Revision: 396 Modified: usocket/branches/0.4.x/backend/cmucl.lisp usocket/trunk/backend/cmucl.lisp Log: More CMUCL fixes. Modified: usocket/branches/0.4.x/backend/cmucl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/cmucl.lisp (original) +++ usocket/branches/0.4.x/backend/cmucl.lisp Sun Jul 27 16:22:48 2008 @@ -174,7 +174,7 @@ (defun %remove-waiter (wait-list waiter) (setf (wait-list-%wait wait-list) - (remove (socket waiter) (wait-list-%wait waiter)))) + (remove (socket waiter) (wait-list-%wait wait-list)))) (defun wait-for-input-internal (wait-list &key timeout) (with-mapped-conditions () Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Sun Jul 27 16:22:48 2008 @@ -176,7 +176,7 @@ (defun %remove-waiter (wait-list waiter) (setf (wait-list-%wait wait-list) - (remove (socket waiter) (wait-list-%wait waiter)))) + (remove (socket waiter) (wait-list-%wait wait-list)))) (defun wait-for-input-internal (wait-list &key timeout) (with-mapped-conditions ()

1 0