From a12a56f7778ccfb7e13275a6238b1e37da949c75 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Tue, 8 Mar 2016 02:24:09 -0800 Subject: [PATCH] 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. --- basis/io/sockets/sockets-docs.factor | 4 +- basis/io/sockets/sockets-tests.factor | 10 ++++ basis/io/sockets/sockets.factor | 69 ++++++++++++++-------- basis/io/sockets/windows/windows.factor | 4 +- extra/benchmark/tcp-echo0/tcp-echo0.factor | 2 +- extra/dns/dns.factor | 2 +- extra/ntp/ntp.factor | 2 +- 7 files changed, 63 insertions(+), 30 deletions(-) diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index 19759d0a90..5a7e75729e 100644 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -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 } } diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor index c586bdda43..5e300f03fb 100644 --- a/basis/io/sockets/sockets-tests.factor +++ b/basis/io/sockets/sockets-tests.factor @@ -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 send-once ] unit-test +[ ] [ B{ 1 2 3 } f 9000 broadcast-once ] unit-test +[ ] [ B{ 1 2 3 } "0.0.0.0" 9000 send-once ] unit-test +[ ] [ B{ 1 2 3 } "0.0.0.0" 9000 broadcast-once ] unit-test + +[ ] [ B{ 1 2 3 } f 9000 send-once ] unit-test +[ ] [ B{ 1 2 3 } f 9000 broadcast-once ] unit-test +[ ] [ B{ 1 2 3 } "::" 9000 send-once ] unit-test +[ ] [ B{ 1 2 3 } "::" 9000 broadcast-once ] unit-test diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 865239a934..70f1a9e019 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -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,13 +101,21 @@ M: ipv4 sockaddr-size drop sockaddr-in heap-size ; M: ipv4 empty-sockaddr drop sockaddr-in ; -M: ipv4 make-sockaddr ( inet -- sockaddr ) +: make-sockaddr-part ( inet -- sockaddr ) sockaddr-in AF_INET >>family swap - [ port>> htons >>port ] - [ host>> "0.0.0.0" or ] - [ inet-pton uint deref >>addr ] tri ; + 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 ] dip inet-ntop ; @@ -160,14 +173,23 @@ M: ipv6 sockaddr-size drop sockaddr-in6 heap-size ; M: ipv6 empty-sockaddr drop sockaddr-in6 ; -M: ipv6 make-sockaddr ( inet -- sockaddr ) +: make-sockaddr-in6-part ( inet -- sockaddr ) sockaddr-in6 AF_INET6 >>family swap - [ port>> htons >>port ] - [ [ host>> "::" or ] keep inet-pton >>addr ] - [ scope-id>> >>scopeid ] - tri ; + 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 @@ -435,29 +457,30 @@ M: invalid-local-address summary : protocol-port ( protocol -- port ) [ f getservbyname [ port>> htons ] [ f ] if* ] [ f ] if* ; +: ( -- inet4 ) f 0 ; +: ( -- inet6 ) f 0 ; -GENERIC: ( inet -- inet4 ) -M: inet4 drop f 0 ; -M: inet drop resolve-localhost random ; -M: inet6 drop f 0 ; +GENERIC: ( inet -- inet4 ) +M: inet4 drop ; +M: inet6 drop f 0 ; -: ( inet -- datagram ) - ; +: ( inet -- datagram ) + ; -: ( inet -- datagram ) - ; +: ( inet -- datagram ) + ; -: with-random-local-datagram ( quot -- ) - [ dup ] dip with-disposal ; inline +: with-any-port-local-datagram ( quot -- ) + [ dup ] dip with-disposal ; inline -: with-random-local-broadcast ( quot -- ) - [ dup ] dip with-disposal ; inline +: with-any-port-local-broadcast ( quot -- ) + [ dup ] 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 ] } diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor index e45eef2393..a6856330f6 100755 --- a/basis/io/sockets/windows/windows.factor +++ b/basis/io/sockets/windows/windows.factor @@ -152,7 +152,7 @@ TUPLE: ConnectEx-args port winsock-error ; inline M: object establish-connection ( client-out remote -- ) - make-sockaddr/size + make-sockaddr/size-outgoing 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 diff --git a/extra/benchmark/tcp-echo0/tcp-echo0.factor b/extra/benchmark/tcp-echo0/tcp-echo0.factor index c2bf0c03ff..b5a19beb0b 100644 --- a/extra/benchmark/tcp-echo0/tcp-echo0.factor +++ b/extra/benchmark/tcp-echo0/tcp-echo0.factor @@ -16,7 +16,7 @@ TUPLE: tcp-echo < threaded-server #times #bytes ; binary \ tcp-echo new-threaded-server swap >>#bytes swap >>#times - >>insecure ; + >>insecure ; ERROR: incorrect-#bytes ; diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index 011949a37b..08f70c3700 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -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 ; : ( -- inet4 ) dns-servers get random 53 ; diff --git a/extra/ntp/ntp.factor b/extra/ntp/ntp.factor index ec42762a70..e650a18a42 100644 --- a/extra/ntp/ntp.factor +++ b/extra/ntp/ntp.factor @@ -106,7 +106,7 @@ PRIVATE> 123 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" ;