io.sockets: factor out ipv4 and ipv6 classes for John Benediktsson's upcoming ICMP...

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index a1260e80bea712ca1c0015dd540759bf15b0db9c..e20f336d6ff37a02cb152f74285a3f03b1a93916 100644 (file)
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman,
+! Copyright (C) 2007, 2010 Slava Pestov, Doug Coleman,
 ! Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: generic kernel io.backend namespaces continuations sequences
@@ -39,17 +39,14 @@ GENERIC: inet-pton ( str addrspec -- data )
 
 GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
 
+M: f parse-sockaddr nip ;
+
 HOOK: sockaddr-of-family os ( alien af -- sockaddr )
 
 HOOK: addrspec-of-family os ( af -- addrspec )
 
 PRIVATE>
 
-TUPLE: abstract-inet host port ;
-
-M: abstract-inet present
-    [ host>> ":" ] [ port>> number>string ] bi 3append ;
-
 TUPLE: local path ;
 
 : <local> ( path -- addrspec )
@@ -57,62 +54,65 @@ TUPLE: local path ;
 
 M: local present path>> "Unix domain socket: " prepend ;
 
-TUPLE: inet4 < abstract-inet ;
+SLOT: port
 
-C: <inet4> inet4
+TUPLE: ipv4 host ;
 
-M: inet4 inet-ntop ( data addrspec -- str )
+M: ipv4 inet-ntop ( data addrspec -- str )
     drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
 
-ERROR: malformed-inet4 sequence ;
-ERROR: bad-inet4-component string ;
+<PRIVATE
 
-: parse-inet4 ( string -- seq )
-    "." split dup length 4 = [
-        malformed-inet4
-    ] unless
-    [
-        string>number
-        [ "Dotted component not a number" throw ] unless*
-    ] B{ } map-as ;
+ERROR: malformed-ipv4 sequence ;
 
-ERROR: invalid-inet4 string reason ;
+ERROR: bad-ipv4-component string ;
 
-M: invalid-inet4 summary drop "Invalid IPv4 address" ;
+: parse-ipv4 ( string -- seq )
+    "." split dup length 4 = [ malformed-ipv4 ] unless
+    [ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as ;
 
-M: inet4 inet-pton ( str addrspec -- data )
-    drop
-    [ parse-inet4 ] [ invalid-inet4 ] recover ;
+ERROR: invalid-ipv4 string reason ;
 
-M: inet4 address-size drop 4 ;
+M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
 
-M: inet4 protocol-family drop PF_INET ;
+PRIVATE>
+
+M: ipv4 inet-pton ( str addrspec -- data )
+    drop [ parse-ipv4 ] [ invalid-ipv4 ] recover ;
+
+M: ipv4 address-size drop 4 ;
+
+M: ipv4 protocol-family drop PF_INET ;
 
-M: inet4 sockaddr-size drop sockaddr-in heap-size ;
+M: ipv4 sockaddr-size drop sockaddr-in heap-size ;
 
-M: inet4 empty-sockaddr drop sockaddr-in <struct> ;
+M: ipv4 empty-sockaddr drop sockaddr-in <struct> ;
 
-M: inet4 make-sockaddr ( inet -- sockaddr )
+M: ipv4 make-sockaddr ( inet -- sockaddr )
     sockaddr-in <struct>
         AF_INET >>family
-        swap [ port>> htons >>port ]
-            [ host>> "0.0.0.0" or ]
-            [ inet-pton *uint >>addr ] tri ;
+        swap
+        [ port>> htons >>port ]
+        [ host>> "0.0.0.0" or ]
+        [ inet-pton *uint >>addr ] tri ;
+
+TUPLE: inet4 < ipv4 port ;
+
+C: <inet4> inet4
 
 M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
     [ [ addr>> <uint> ] dip inet-ntop ]
     [ drop port>> ntohs ] 2bi <inet4> ;
 
-TUPLE: inet6 < abstract-inet ;
+M: inet4 present
+    [ host>> ] [ port>> number>string ] bi ":" glue ;
 
-C: <inet6> inet6
+TUPLE: ipv6 host ;
 
-M: inet6 inet-ntop ( data addrspec -- str )
+M: ipv6 inet-ntop ( data addrspec -- str )
     drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
 
-ERROR: invalid-inet6 string reason ;
-
-M: invalid-inet6 summary drop "Invalid IPv6 address" ;
+ERROR: invalid-ipv6 string reason ;
 
 <PRIVATE
 
@@ -120,55 +120,62 @@ ERROR: bad-ipv6-component obj ;
 
 ERROR: bad-ipv4-embedded-prefix obj ;
 
+ERROR: more-than-8-components ;
+
 : parse-ipv6-component ( seq -- seq' )
     [ dup hex> [ nip ] [ bad-ipv6-component ] if* ] { } map-as ;
 
-: parse-inet6 ( string -- seq )
+: parse-ipv6 ( string -- seq )
     [ f ] [
         ":" split CHAR: . over last member? [
             unclip-last
-            [ parse-ipv6-component ] [ parse-inet4 ] bi* append
+            [ parse-ipv6-component ] [ parse-ipv4 ] bi* append
         ] [
             parse-ipv6-component
         ] if
     ] if-empty ;
 
-: pad-inet6 ( string1 string2 -- seq )
+: pad-ipv6 ( string1 string2 -- seq )
     2dup [ length ] bi@ + 8 swap -
-    dup 0 < [ "More than 8 components" throw ] when
+    dup 0 < [ more-than-8-components ] when
     <byte-array> glue ;
 
-: inet6-bytes ( seq -- bytes )
+: ipv6-bytes ( seq -- bytes )
     [ 2 >be ] { } map-as B{ } concat-as ;
 
 PRIVATE>
 
-M: inet6 inet-pton ( str addrspec -- data )
+M: ipv6 inet-pton ( str addrspec -- data )
     drop
-    [
-        "::" split1 [ parse-inet6 ] bi@ pad-inet6 inet6-bytes
-    ] [ invalid-inet6 ] recover ;
+    [ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ]
+    [ invalid-ipv6 ]
+    recover ;
 
-M: inet6 address-size drop 16 ;
+M: ipv6 address-size drop 16 ;
 
-M: inet6 protocol-family drop PF_INET6 ;
+M: ipv6 protocol-family drop PF_INET6 ;
 
-M: inet6 sockaddr-size drop sockaddr-in6 heap-size ;
+M: ipv6 sockaddr-size drop sockaddr-in6 heap-size ;
 
-M: inet6 empty-sockaddr drop sockaddr-in6 <struct> ;
+M: ipv6 empty-sockaddr drop sockaddr-in6 <struct> ;
 
-M: inet6 make-sockaddr ( inet -- sockaddr )
+M: ipv6 make-sockaddr ( inet -- sockaddr )
     sockaddr-in6 <struct>
         AF_INET6 >>family
         swap [ port>> htons >>port ]
             [ host>> "::" or ]
             [ inet-pton >>addr ] tri ;
 
+TUPLE: inet6 < ipv6 port ;
+
+C: <inet6> inet6
+
 M: inet6 parse-sockaddr
     [ [ addr>> ] dip inet-ntop ]
     [ drop port>> ntohs ] 2bi <inet6> ;
 
-M: f parse-sockaddr nip ;
+M: inet6 present
+    [ host>> ] [ port>> number>string ] bi ":" glue ;
 
 <PRIVATE
 
@@ -306,17 +313,24 @@ SYMBOL: remote-address
 
 GENERIC: resolve-host ( addrspec -- seq )
 
-TUPLE: inet < abstract-inet ;
+TUPLE: hostname host ;
+
+TUPLE: inet < hostname port ;
+
+M: inet present
+    [ host>> ] [ port>> number>string ] bi ":" glue ;
 
 C: <inet> inet
 
-M: inet resolve-host
-    [ port>> ] [ host>> ] bi [
+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*
-    swap fill-in-ports ;
+    ] [ resolve-passive-host ] if* ;
+
+M: inet resolve-host
+    [ call-next-method ] [ port>> ] bi fill-in-ports ;
 
 M: f resolve-host drop { } ;
 

diff --git a/basis/urls/secure/secure.factor b/basis/urls/secure/secure.factor
index d2fa55f7f3d4026c63193dea18dca1bfa987b700..1c9b92564128b203b15c15d9fcbdb598c36b030f 100644 (file)
--- a/basis/urls/secure/secure.factor
+++ b/basis/urls/secure/secure.factor
@@ -1,6 +1,8 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: urls urls.private io.sockets io.sockets.secure ;
 IN: urls.secure
 
+UNION: abstract-inet inet inet4 inet6 ;
+
 M: abstract-inet >secure-addr <secure> ;