From 4fc792629e819af354896beda9af555e40a10938 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 4 Sep 2010 14:42:05 -0700 Subject: [PATCH] io.sockets: clean up resolve-host --- basis/io/servers/connection/connection.factor | 2 +- basis/io/sockets/sockets-tests.factor | 12 +++- basis/io/sockets/sockets.factor | 67 ++++++++++++------- basis/io/sockets/unix/unix.factor | 4 +- basis/io/sockets/windows/windows.factor | 4 +- 5 files changed, 57 insertions(+), 32 deletions(-) diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 4dfdc13bc9..494ce02d8a 100644 --- 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 96ffbc5e18..87d4f1c0a9 100644 --- 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 resolve-host length 1 >= ] unit-test +[ t t ] [ + "localhost" 80 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 "datagram1" set ] unit-test diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index e20f336d6f..07a60c2d67 100644 --- 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 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>> ] dip inet-ntop ; + +TUPLE: inet4 < ipv4 { port integer read-only } ; C: inet4 +M: ipv4 with-port [ host>> ] dip ; + M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec ) - [ [ addr>> ] dip inet-ntop ] - [ drop port>> ntohs ] 2bi ; + [ 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 M: ipv6 inet-ntop ( data addrspec -- str ) drop 16 memory>byte-array 2 [ be> >hex ] map ":" join ; @@ -162,17 +172,22 @@ M: ipv6 empty-sockaddr drop sockaddr-in6 ; M: ipv6 make-sockaddr ( inet -- sockaddr ) sockaddr-in6 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 ; + +TUPLE: inet6 < ipv6 { port integer read-only } ; C: inet6 +M: ipv6 with-port [ host>> ] dip ; + M: inet6 parse-sockaddr - [ [ addr>> ] dip inet-ntop ] - [ drop port>> ntohs ] 2bi ; + [ 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 PF_UNSPEC >>family IPPROTO_TCP >>protocol ; -: fill-in-ports ( addrspecs port -- addrspecs ) - '[ _ >>port ] map ; - PRIVATE> : ( remote encoding -- stream local ) @@ -322,19 +331,25 @@ M: inet present C: inet +M: string resolve-host + f prepare-addrinfo f + [ getaddrinfo addrinfo-error ] keep *void* addrinfo memory>struct + [ parse-addrinfo-list ] keep freeaddrinfo ; + M: hostname resolve-host - host>> [ - f prepare-addrinfo f - [ 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: f resolve-host drop { } ; +M: inet4 resolve-host 1array ; -M: object resolve-host 1array ; +M: inet6 resolve-host 1array ; + +M: local resolve-host 1array ; + +M: f resolve-host + drop { T{ ipv6 f "::" } T{ ipv4 f "0.0.0.0" } } ; : host-name ( -- string ) 256 dup dup length gethostname diff --git a/basis/io/sockets/unix/unix.factor b/basis/io/sockets/unix/unix.factor index cc0740500a..9613ce4f40 100644 --- 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 37ae1e637b..d14833e61e 100755 --- 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 ) M: windows addrspec-of-family ( af -- addrspec ) { - { AF_INET [ T{ inet4 } ] } - { AF_INET6 [ T{ inet6 } ] } + { AF_INET [ T{ ipv4 } ] } + { AF_INET6 [ T{ ipv6 } ] } [ drop f ] } case ;