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
parent
027a9fb1a2
commit
a12a56f777
|
@ -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 }
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ] }
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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> ;
|
||||
|
|
|
@ -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> ;
|
||||
|
|
Loading…
Reference in New Issue