Merge branch 'client-bind' of git://github.com/x6j8x/factor
commit
57d9968006
|
@ -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 ] }
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue