[usocket-cvs] r405 - usocket/trunk/backend
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Wed Jul 30 19:26:56 UTC 2008
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
More information about the usocket-cvs
mailing list