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