diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index a542575446..e45224fcc2 100755 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -173,6 +173,8 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr ) [ |dispose ] [ |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 ; use or 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 ] } diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index fa46a71ca0..3564b32890 100755 --- a/basis/io/sockets/unix/unix.factor +++ b/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 -- ) diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index ccf86ca308..fa5e3833bc 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/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