Merge branch 'client-bind' of git://github.com/x6j8x/factor

basis/io/sockets/sockets.factor

@@ -173,6 +173,8 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr )
         [ <input-port> |dispose ] [ <output-port> |dispose ] bi
     ] with-destructors ;
 
+SYMBOL: bind-local-address
+
 GENERIC: establish-connection ( client-out remote -- )
 
 GENERIC: ((client)) ( remote -- handle )
@@ -321,6 +323,18 @@ M: invalid-inet-server summary
 M: inet (server)
     invalid-inet-server ;
 
+ERROR: invalid-local-address addrspec ;
+
+M: invalid-local-address summary
+    drop "Cannot use with-local-address with <inet>; use <inet4> or <inet6> instead" ;
+
+: with-local-address ( addr quot -- )
+    [
+        [ ] [ inet4? ] [ inet6? ] tri or
+        [ bind-local-address ]
+        [ invalid-local-address ] if
+    ] dip with-variable ; inline
+
 {
     { [ os unix? ] [ "io.sockets.unix" require ] }
     { [ os winnt? ] [ "io.sockets.windows.nt" require ] }

basis/io/sockets/unix/unix.factor

@@ -69,8 +69,12 @@ M: object establish-connection ( client-out remote -- )
         [ (io-error) ]
     } cond ;
 
+: ?bind-client ( socket -- )
+    bind-local-address get [ [ fd>> ] dip make-sockaddr/size bind io-error ] [ drop ] if* ; inline
+
 M: object ((client)) ( addrspec -- fd )
-    protocol-family SOCK_STREAM socket-fd dup init-client-socket ;
+    protocol-family SOCK_STREAM socket-fd
+    [ init-client-socket ] [ ?bind-client ] [ ] tri ;
 
 ! Server sockets - TCP and Unix domain
 : init-server-socket ( fd -- )

basis/io/sockets/windows/windows.factor

@@ -55,7 +55,11 @@ M: object (get-remote-address) ( socket addrspec -- sockaddr )
 
 M: object ((client)) ( addrspec -- handle )
     [ SOCK_STREAM open-socket ] keep
-    [ unspecific-sockaddr/size bind-socket ] [ drop ] 2bi ;
+    [
+        bind-local-address get
+        [ nip make-sockaddr/size ]
+        [ unspecific-sockaddr/size ] if* bind-socket
+    ] [ drop ] 2bi ;
 
 : server-socket ( addrspec type -- fd )
     [ open-socket ] [ drop ] 2bi