io.sockets: Special-case 0.0.0.0 and f for outgoing sockets so we can use

them on windows. Add some tests that shouldn't fail. Fixes #85.
db4
Doug Coleman 2016-03-08 02:24:09 -08:00
parent 027a9fb1a2
commit a12a56f777
7 changed files with 63 additions and 30 deletions

View File

@ -251,13 +251,13 @@ HELP: broadcast-once
}
{ $description "Broadcasts a packet one time to the address and closes the sending broadcast port." } ;
HELP: with-random-local-broadcast
HELP: with-any-port-local-broadcast
{ $values
{ "quot" quotation }
}
{ $description "Creates a broadcast datagram socket and calls the quotation with this datagram on top of the stack, cleaning up afterwards." } ;
HELP: with-random-local-datagram
HELP: with-any-port-local-datagram
{ $values
{ "quot" quotation }
}

View File

@ -174,3 +174,13 @@ os unix? [
{ f } [ f protocol-port ] unit-test
[ "you-cant-resolve-me!" resolve-host ] [ addrinfo-error? ] must-fail-with
[ ] [ B{ 1 2 3 } f 9000 <inet4> send-once ] unit-test
[ ] [ B{ 1 2 3 } f 9000 <inet4> broadcast-once ] unit-test
[ ] [ B{ 1 2 3 } "0.0.0.0" 9000 <inet4> send-once ] unit-test
[ ] [ B{ 1 2 3 } "0.0.0.0" 9000 <inet4> broadcast-once ] unit-test
[ ] [ B{ 1 2 3 } f 9000 <inet6> send-once ] unit-test
[ ] [ B{ 1 2 3 } f 9000 <inet6> broadcast-once ] unit-test
[ ] [ B{ 1 2 3 } "::" 9000 <inet6> send-once ] unit-test
[ ] [ B{ 1 2 3 } "::" 9000 <inet6> broadcast-once ] unit-test

View File

@ -29,6 +29,8 @@ GENERIC: sockaddr-size ( addrspec -- n )
GENERIC: make-sockaddr ( addrspec -- sockaddr )
GENERIC: make-sockaddr-outgoing ( addrspec -- sockaddr )
GENERIC: empty-sockaddr ( addrspec -- sockaddr )
GENERIC: address-size ( addrspec -- n )
@ -37,6 +39,9 @@ GENERIC: inet-ntop ( data addrspec -- str )
GENERIC: inet-pton ( str addrspec -- data )
: make-sockaddr/size-outgoing ( addrspec -- sockaddr size )
[ make-sockaddr-outgoing ] [ sockaddr-size ] bi ;
: make-sockaddr/size ( addrspec -- sockaddr size )
[ make-sockaddr ] [ sockaddr-size ] bi ;
@ -96,14 +101,22 @@ M: ipv4 sockaddr-size drop sockaddr-in heap-size ;
M: ipv4 empty-sockaddr drop sockaddr-in <struct> ;
M: ipv4 make-sockaddr ( inet -- sockaddr )
: make-sockaddr-part ( inet -- sockaddr )
sockaddr-in <struct>
AF_INET >>family
swap
[ port>> htons >>port ]
port>> htons >>port ; inline
M: ipv4 make-sockaddr ( inet -- sockaddr )
[ make-sockaddr-part ]
[ host>> "0.0.0.0" or ]
[ inet-pton uint deref >>addr ] tri ;
M: ipv4 make-sockaddr-outgoing ( inet -- sockaddr )
[ make-sockaddr-part ]
[ host>> dup { f "0.0.0.0" } member? [ drop "127.0.0.1" ] when ]
[ inet-pton uint deref >>addr ] tri ;
M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
[ addr>> uint <ref> ] dip inet-ntop <ipv4> ;
@ -160,15 +173,24 @@ M: ipv6 sockaddr-size drop sockaddr-in6 heap-size ;
M: ipv6 empty-sockaddr drop sockaddr-in6 <struct> ;
M: ipv6 make-sockaddr ( inet -- sockaddr )
: make-sockaddr-in6-part ( inet -- sockaddr )
sockaddr-in6 <struct>
AF_INET6 >>family
swap
[ port>> htons >>port ]
port>> htons >>port ; inline
M: ipv6 make-sockaddr ( inet -- sockaddr )
[ make-sockaddr-in6-part ]
[ [ host>> "::" or ] keep inet-pton >>addr ]
[ scope-id>> >>scopeid ]
tri ;
M: ipv6 make-sockaddr-outgoing ( inet -- sockaddr )
[ make-sockaddr-in6-part ]
[ [ host>> dup { f "::" } member? [ drop "::1" ] when ] keep inet-pton >>addr ]
[ scope-id>> >>scopeid ]
tri ;
M: ipv6 parse-sockaddr
[ [ addr>> ] dip inet-ntop ] [ drop scopeid>> ] 2bi
ipv6 boa ;
@ -435,29 +457,30 @@ M: invalid-local-address summary
: protocol-port ( protocol -- port )
[ f getservbyname [ port>> htons ] [ f ] if* ] [ f ] if* ;
: <any-port-local-inet4> ( -- inet4 ) f 0 <inet4> ;
: <any-port-local-inet6> ( -- inet6 ) f 0 <inet6> ;
GENERIC: <random-local-inet> ( inet -- inet4 )
M: inet4 <random-local-inet> drop f 0 <inet4> ;
M: inet <random-local-inet> drop resolve-localhost random ;
M: inet6 <random-local-inet> drop f 0 <inet6> ;
GENERIC: <any-port-local-inet> ( inet -- inet4 )
M: inet4 <any-port-local-inet> drop <any-port-local-inet4> ;
M: inet6 <any-port-local-inet> drop f 0 <inet6> ;
: <random-local-datagram> ( inet -- datagram )
<random-local-inet> <datagram> ;
: <any-port-local-datagram> ( inet -- datagram )
<any-port-local-inet> <datagram> ;
: <random-local-broadcast> ( inet -- datagram )
<random-local-inet> <broadcast> ;
: <any-port-local-broadcast> ( inet -- datagram )
<any-port-local-inet> <broadcast> ;
: with-random-local-datagram ( quot -- )
[ dup <random-local-datagram> ] dip with-disposal ; inline
: with-any-port-local-datagram ( quot -- )
[ dup <any-port-local-datagram> ] dip with-disposal ; inline
: with-random-local-broadcast ( quot -- )
[ dup <random-local-broadcast> ] dip with-disposal ; inline
: with-any-port-local-broadcast ( quot -- )
[ dup <any-port-local-broadcast> ] dip with-disposal ; inline
: send-once ( bytes addrspec -- )
[ send ] with-random-local-datagram ;
[ send ] with-any-port-local-datagram ;
: broadcast-once ( bytes addrspec -- )
[ send ] with-random-local-broadcast ;
[ send ] with-any-port-local-broadcast ;
{
{ [ os unix? ] [ "io.sockets.unix" require ] }

View File

@ -152,7 +152,7 @@ TUPLE: ConnectEx-args port
winsock-error ; inline
M: object establish-connection ( client-out remote -- )
make-sockaddr/size <ConnectEx-args>
make-sockaddr/size-outgoing <ConnectEx-args>
swap >>port
dup port>> handle>> handle>> >>s
dup s>> get-ConnectEx-ptr >>ptr
@ -292,7 +292,7 @@ TUPLE: WSASendTo-args port
WSASendTo-args new
swap >>port
dup port>> handle>> handle>> >>s
swap make-sockaddr/size
swap make-sockaddr/size-outgoing
[ malloc-byte-array &free ] dip
[ >>lpTo ] [ >>iToLen ] bi*
swap make-send-buffer >>lpBuffers

View File

@ -16,7 +16,7 @@ TUPLE: tcp-echo < threaded-server #times #bytes ;
binary \ tcp-echo new-threaded-server
swap >>#bytes
swap >>#times
<random-local-inet4> >>insecure ;
<any-port-local-inet4> >>insecure ;
ERROR: incorrect-#bytes ;

View File

@ -328,7 +328,7 @@ M: TXT rdata>byte-array
[
10 seconds over set-timeout
[ send ] [ receive drop ] bi
] with-random-local-datagram ;
] with-any-port-local-datagram ;
: <dns-inet4> ( -- inet4 )
dns-servers get random 53 <inet4> ;

View File

@ -106,7 +106,7 @@ PRIVATE>
123 <inet> resolve-host
[ inet4? ] filter random [
[ REQUEST ] 2dip [ send ] [ receive drop ] bi (ntp)
] with-random-local-datagram ;
] with-any-port-local-datagram ;
: default-ntp ( -- ntp )
"pool.ntp.org" <ntp> ;