io.sockets: add scope-id to ipv6 addrspecs, fixing a problem with connecting to local...

diff --git a/basis/io/sockets/icmp/icmp.factor b/basis/io/sockets/icmp/icmp.factor
index 80693c0963db7dda2da8ba744fc8d29251874913..095a03ab7b7a10cd63d5ec239c88e30b1452fb92 100644 (file)
--- a/basis/io/sockets/icmp/icmp.factor
+++ b/basis/io/sockets/icmp/icmp.factor
@@ -41,7 +41,7 @@ M: icmp4 resolve-host 1array ;
 
 TUPLE: icmp6 < ipv6 ;
 
-C: <icmp6> icmp6
+: <icmp6> ( host -- icmp6 ) 0 icmp6 boa ;
 
 M: ipv6 with-icmp host>> <icmp6> ;
 

diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor
index d6015127532ebb91b7fd7c14daa8bffbd4982643..0c79323a246929c10dfa058c1cb464fb2b219ffe 100644 (file)
--- a/basis/io/sockets/sockets-tests.factor
+++ b/basis/io/sockets/sockets-tests.factor
@@ -1,11 +1,12 @@
 USING: io.sockets io.sockets.private sequences math tools.test
 namespaces accessors kernel destructors calendar io.timeouts
 io.encodings.utf8 io concurrency.promises threads
-io.streams.string ;
+io.streams.string present ;
 IN: io.sockets.tests
 
+[ T{ local f "/tmp/foo" } ] [ "/tmp/foo" <local> ] unit-test
 [ T{ inet4 f f 0 } ] [ f 0 <inet4> ] unit-test
-[ T{ inet6 f f 0 } ] [ f 0 <inet6> ] unit-test
+[ T{ inet6 f f 0 1 } ] [ f 1 <inet6> ] unit-test
 
 [ T{ inet f "google.com" f } ] [ "google.com" f <inet> ] unit-test
 
@@ -13,10 +14,23 @@ IN: io.sockets.tests
 [ T{ inet f "google.com" 80 } ] [ "google.com" 0 <inet> 80 with-port ] unit-test
 [ T{ inet4 f "8.8.8.8" 0 } ] [ "8.8.8.8" 0 <inet4> ] unit-test
 [ T{ inet4 f "8.8.8.8" 53 } ] [ "8.8.8.8" 0 <inet4> 53 with-port ] unit-test
-[ T{ inet6 f "5:5:5:5:6:6:6:6" 12 } ] [ "5:5:5:5:6:6:6:6" 0 <inet6> 12 with-port ] unit-test
+[ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } ] [ "5:5:5:5:6:6:6:6" 0 <inet6> 12 with-port ] unit-test
+[ T{ inet6 f "fe80::1" 1 80 } ] [ T{ ipv6 f "fe80::1" 1 } 80 with-port ] unit-test
+
+: test-sockaddr ( addrspec -- )
+    [ dup make-sockaddr ] keep parse-sockaddr assert= ;
+
+[ ] [ T{ inet4 f "8.8.8.8" 53 } test-sockaddr ] unit-test
+[ ] [ T{ inet6 f "5:5:5:5:6:6:6:6" 0 12 } test-sockaddr ] unit-test
+[ ] [ T{ inet6 f "fe80:0:0:0:0:0:0:1" 1 80 } test-sockaddr ] unit-test
 
 [ T{ inet f "google.com" 80 } ] [ "google.com" 80 with-port ] unit-test
 
+! Test present on addrspecs
+[ "4.4.4.4:12" ] [ "4.4.4.4" 12 <inet4> present ] unit-test
+[ "::1:12" ] [ "::1" 12 <inet6> present ] unit-test
+[ "fe80::1%1:12" ] [ "fe80::1" 1 12 inet6 boa present ] unit-test
+
 [ B{ 1 2 3 4 } ]
 [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
 

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index fcdc00d1279e4bc2682c17b3a930bd0edb3b7f77..b567721e3f0e9f2bd1c8c88d260e7cacbef2b6ee 100644 (file)
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -125,9 +125,11 @@ M: inet4 present
 
 M: inet4 protocol drop 0 ;
 
-TUPLE: ipv6 { host ?string read-only } ;
+TUPLE: ipv6
+{ host ?string read-only }
+{ scope-id integer read-only } ;
 
-C: <ipv6> ipv6
+: <ipv6> ( host -- ipv6 ) 0 ipv6 boa ;
 
 M: ipv6 inet-ntop ( data addrspec -- str )
     drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
@@ -184,23 +186,31 @@ M: ipv6 make-sockaddr ( inet -- sockaddr )
         AF_INET6 >>family
         swap
         [ port>> htons >>port ]
-        [ host>> "::" or ]
-        [ inet-pton >>addr ] tri ;
+        [ [ host>> "::" or ] keep inet-pton >>addr ]
+        [ scope-id>> >>scopeid ]
+        tri ;
 
 M: ipv6 parse-sockaddr
-    [ addr>> ] dip inet-ntop <ipv6> ;
+    [ [ addr>> ] dip inet-ntop ] [ drop scopeid>> ] 2bi
+    ipv6 boa ;
+
+M: ipv6 present
+    [ host>> ] [ scope-id>> ] bi
+    [ number>string "%" glue ] unless-zero ;
 
 TUPLE: inet6 < ipv6 { port integer read-only } ;
 
-C: <inet6> inet6
+: <inet6> ( host port -- inet6 ) [ 0 ] dip inet6 boa ;
 
-M: ipv6 with-port [ host>> ] dip <inet6> ;
+M: ipv6 with-port
+    [ [ host>> ] [ scope-id>> ] bi ] dip
+    inet6 boa ;
 
 M: inet6 parse-sockaddr
     [ call-next-method ] [ drop port>> ntohs ] 2bi with-port ;
 
 M: inet6 present
-    [ host>> ] [ port>> number>string ] bi ":" glue ;
+    [ call-next-method ] [ port>> number>string ] bi ":" glue ;
 
 M: inet6 protocol drop 0 ;