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

@@ -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 }
 }

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 <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

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 <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
-        [ host>> "0.0.0.0" or ]
+
-        [ inet-pton uint deref >>addr ] tri ;
+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,14 +173,23 @@ 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
-        [ [ host>> "::" or ] keep inet-pton >>addr ]
+
-        [ scope-id>> >>scopeid ]
+M: ipv6 make-sockaddr ( inet -- sockaddr )
-        tri ;
+    [ 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* ;
 
+: <any-port-local-inet4> ( -- inet4 ) f 0 <inet4> ;
+: <any-port-local-inet6> ( -- inet6 ) f 0 <inet6> ;
 
-GENERIC: <random-local-inet> ( inet -- inet4 )
+GENERIC: <any-port-local-inet> ( inet -- inet4 )
-M: inet4 <random-local-inet> drop f 0 <inet4> ;
+M: inet4 <any-port-local-inet> drop <any-port-local-inet4> ;
-M: inet <random-local-inet> drop resolve-localhost random ;
+M: inet6 <any-port-local-inet> drop f 0 <inet6> ;
-M: inet6 <random-local-inet> drop f 0 <inet6> ;
 
-: <random-local-datagram> ( inet -- datagram )
+: <any-port-local-datagram> ( inet -- datagram )
-    <random-local-inet> <datagram> ;
+    <any-port-local-inet> <datagram> ;
 
-: <random-local-broadcast> ( inet -- datagram )
+: <any-port-local-broadcast> ( inet -- datagram )
-    <random-local-inet> <broadcast> ;
+    <any-port-local-inet> <broadcast> ;
 
-: with-random-local-datagram ( quot -- )
+: with-any-port-local-datagram ( quot -- )
-    [ dup <random-local-datagram> ] dip with-disposal ; inline
+    [ dup <any-port-local-datagram> ] dip with-disposal ; inline
 
-: with-random-local-broadcast ( quot -- )
+: with-any-port-local-broadcast ( quot -- )
-    [ dup <random-local-broadcast> ] dip with-disposal ; inline
+    [ 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 ] }

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 <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

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
-        <random-local-inet4> >>insecure ;
+        <any-port-local-inet4> >>insecure ;
 
 ERROR: incorrect-#bytes ;
 

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 ;
 
 : <dns-inet4> ( -- inet4 )
     dns-servers get random 53 <inet4> ;

extra/ntp/ntp.factor

@@ -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> ;