io.sockets: clean up resolve-host

diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor
index 4dfdc13bc93933ece11ff9b52ce2f8b9d13cd34b..494ce02d8abb48bf91a863fac4f25d97729e4061 100644 (file)
--- a/basis/io/servers/connection/connection.factor
+++ b/basis/io/servers/connection/connection.factor
@@ -55,7 +55,7 @@ GENERIC: handle-client* ( threaded-server -- )
 
 : listen-on ( threaded-server -- addrspecs )
     [ secure>> >secure ] [ insecure>> >insecure ] bi
-    [ resolve-host ] bi@ append ;
+    [ dup [ resolve-host ] when ] bi@ append ;
 
 : accepted-connection ( remote local -- )
     [

diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor
index 96ffbc5e180f840ec68b7cb0d6a5a59c51cdbae6..87d4f1c0a9b0383a84f0145973e2d963a20fa38a 100644 (file)
--- a/basis/io/sockets/sockets-tests.factor
+++ b/basis/io/sockets/sockets-tests.factor
@@ -58,7 +58,17 @@ io.streams.string ;
 [ "2001:6f8:37a:5:0:0:0:1" ]
 [ "2001:6f8:37a:5::1" T{ inet6 } [ inet-pton ] [ inet-ntop ] bi ] unit-test
 
-[ t ] [ "localhost" 80 <inet> resolve-host length 1 >= ] unit-test
+[ t t ] [
+    "localhost" 80 <inet> resolve-host
+    [ length 1 >= ]
+    [ [ [ inet4? ] [ inet6? ] bi or ] all? ] bi
+] unit-test
+
+[ t t ] [
+    "localhost" resolve-host
+    [ length 1 >= ]
+    [ [ [ ipv4? ] [ ipv6? ] bi or ] all? ] bi
+] unit-test
 
 ! Smoke-test UDP
 [ ] [ "127.0.0.1" 0 <inet4> <datagram> "datagram1" set ] unit-test

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index e20f336d6ff37a02cb152f74285a3f03b1a93916..07a60c2d6734b04127c72db8c0948e81e5ccfb0f 100644 (file)
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -6,7 +6,7 @@ arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
 alien.strings io.binary accessors destructors classes byte-arrays
 parser alien.c-types math.parser splitting grouping math assocs
 summary system vocabs.loader combinators present fry vocabs.parser
-classes.struct alien.data ;
+classes.struct alien.data strings ;
 IN: io.sockets
 
 << {
@@ -31,6 +31,8 @@ GENERIC: inet-ntop ( data addrspec -- str )
 
 GENERIC: inet-pton ( str addrspec -- data )
 
+GENERIC# with-port 1 ( addrspec port -- addrspec )
+
 : make-sockaddr/size ( addrspec -- sockaddr size )
     [ make-sockaddr ] [ sockaddr-size ] bi ;
 
@@ -56,7 +58,9 @@ M: local present path>> "Unix domain socket: " prepend ;
 
 SLOT: port
 
-TUPLE: ipv4 host ;
+TUPLE: ipv4 { host string read-only } ;
+
+C: <ipv4> ipv4
 
 M: ipv4 inet-ntop ( data addrspec -- str )
     drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
@@ -96,18 +100,24 @@ M: ipv4 make-sockaddr ( inet -- sockaddr )
         [ host>> "0.0.0.0" or ]
         [ inet-pton *uint >>addr ] tri ;
 
-TUPLE: inet4 < ipv4 port ;
+M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
+    [ addr>> <uint> ] dip inet-ntop <ipv4> ;
+
+TUPLE: inet4 < ipv4 { port integer read-only } ;
 
 C: <inet4> inet4
 
+M: ipv4 with-port [ host>> ] dip <inet4> ;
+
 M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
-    [ [ addr>> <uint> ] dip inet-ntop ]
-    [ drop port>> ntohs ] 2bi <inet4> ;
+    [ call-next-method ] [ drop port>> ntohs ] 2bi with-port ;
 
 M: inet4 present
     [ host>> ] [ port>> number>string ] bi ":" glue ;
 
-TUPLE: ipv6 host ;
+TUPLE: ipv6 { host string read-only } ;
+
+C: <ipv6> ipv6
 
 M: ipv6 inet-ntop ( data addrspec -- str )
     drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
@@ -162,17 +172,22 @@ M: ipv6 empty-sockaddr drop sockaddr-in6 <struct> ;
 M: ipv6 make-sockaddr ( inet -- sockaddr )
     sockaddr-in6 <struct>
         AF_INET6 >>family
-        swap [ port>> htons >>port ]
-            [ host>> "::" or ]
-            [ inet-pton >>addr ] tri ;
+        swap
+        [ port>> htons >>port ]
+        [ host>> "::" or ]
+        [ inet-pton >>addr ] tri ;
 
-TUPLE: inet6 < ipv6 port ;
+M: ipv6 parse-sockaddr
+    [ addr>> ] dip inet-ntop <ipv6> ;
+
+TUPLE: inet6 < ipv6 { port integer read-only } ;
 
 C: <inet6> inet6
 
+M: ipv6 with-port [ host>> ] dip <inet6> ;
+
 M: inet6 parse-sockaddr
-    [ [ addr>> ] dip inet-ntop ]
-    [ drop port>> ntohs ] 2bi <inet6> ;
+    [ call-next-method ] [ drop port>> ntohs ] 2bi with-port ;
 
 M: inet6 present
     [ host>> ] [ port>> number>string ] bi ":" glue ;
@@ -254,17 +269,11 @@ HOOK: (send) io-backend ( packet addrspec datagram -- )
 
 HOOK: addrinfo-error io-backend ( n -- )
 
-: resolve-passive-host ( -- addrspecs )
-    { T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
-
 : prepare-addrinfo ( -- addrinfo )
     addrinfo <struct>
         PF_UNSPEC >>family
         IPPROTO_TCP >>protocol ;
 
-: fill-in-ports ( addrspecs port -- addrspecs )
-    '[ _ >>port ] map ;
-
 PRIVATE>
 
 : <client> ( remote encoding -- stream local )
@@ -322,19 +331,25 @@ M: inet present
 
 C: <inet> inet
 
+M: string resolve-host
+    f prepare-addrinfo f <void*>
+    [ getaddrinfo addrinfo-error ] keep *void* addrinfo memory>struct
+    [ parse-addrinfo-list ] keep freeaddrinfo ;
+
 M: hostname resolve-host
-    host>> [
-        f prepare-addrinfo f <void*>
-        [ getaddrinfo addrinfo-error ] keep *void* addrinfo memory>struct
-        [ parse-addrinfo-list ] keep freeaddrinfo
-    ] [ resolve-passive-host ] if* ;
+    host>> resolve-host ;
 
 M: inet resolve-host
-    [ call-next-method ] [ port>> ] bi fill-in-ports ;
+    [ call-next-method ] [ port>> ] bi '[ _ with-port ] map ;
+
+M: inet4 resolve-host 1array ;
+
+M: inet6 resolve-host 1array ;
 
-M: f resolve-host drop { } ;
+M: local resolve-host 1array ;
 
-M: object resolve-host 1array ;
+M: f resolve-host
+    drop { T{ ipv6 f "::" } T{ ipv4 f "0.0.0.0" } } ;
 
 : host-name ( -- string )
     256 <byte-array> dup dup length gethostname

diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor
index cc0740500a766f490a395188a9b78f2d27d78bf8..9613ce4f4028dba5377146c14a5a9e5fee553f24 100644 (file)
--- a/basis/io/sockets/unix/unix.factor
+++ b/basis/io/sockets/unix/unix.factor
@@ -32,8 +32,8 @@ M: unix sockaddr-of-family ( alien af -- addrspec )
 
 M: unix addrspec-of-family ( af -- addrspec )
     {
-        { AF_INET [ T{ inet4 } ] }
-        { AF_INET6 [ T{ inet6 } ] }
+        { AF_INET [ T{ ipv4 } ] }
+        { AF_INET6 [ T{ ipv6 } ] }
         { AF_UNIX [ T{ local } ] }
         [ drop f ]
     } case ;

diff --git a/basis/io/sockets/windows/windows.factor b/basis/io/sockets/windows/windows.factor
index 37ae1e637bffef42f663b184c402f1cee2806677..d14833e61e4dd1e3a2357a4707b9626b9a36973e 100755 (executable)
--- a/basis/io/sockets/windows/windows.factor
+++ b/basis/io/sockets/windows/windows.factor
@@ -18,8 +18,8 @@ M: windows sockaddr-of-family ( alien af -- addrspec )
 \r
 M: windows addrspec-of-family ( af -- addrspec )\r
     {\r
-        { AF_INET [ T{ inet4 } ] }\r
-        { AF_INET6 [ T{ inet6 } ] }\r
+        { AF_INET [ T{ ipv4 } ] }\r
+        { AF_INET6 [ T{ ipv6 } ] }\r
         [ drop f ]\r
     } case ;\r
 \r