Handle IPv6 addresses of the form ::127.0.0.1

basis/io/sockets/sockets-tests.factor

@@ -49,6 +49,9 @@ io.streams.string ;
 [ "1:2:0:0:0:0:3:4" ]
 [ B{ 0 1 0 2 0 0 0 0 0 0 0 0 0 3 0 4 } T{ inet6 } inet-ntop ] unit-test
 
+[ B{ 0 0 0 0 0 0 0 0 0 127 0 0 0 0 0 1 } ]
+[ "::127.0.0.1" T{ inet6 } inet-pton ] unit-test
+
 [ "2001:6f8:37a:5:0:0:0:1" ]
 [ "2001:6f8:37a:5::1" T{ inet6 } [ inet-pton ] [ inet-ntop ] bi ] unit-test
 

basis/io/sockets/sockets.factor

@@ -64,21 +64,25 @@ C: <inet4> inet4
 M: inet4 inet-ntop ( data addrspec -- str )
     drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
 
+ERROR: malformed-inet4 sequence ;
+ERROR: bad-inet4-component string ;
+
+: parse-inet4 ( string -- seq )
+    "." split dup length 4 = [
+        malformed-inet4
+    ] unless
+    [
+        string>number
+        [ "Dotted component not a number" throw ] unless*
+    ] B{ } map-as ;
+
 ERROR: invalid-inet4 string reason ;
 
 M: invalid-inet4 summary drop "Invalid IPv4 address" ;
 
 M: inet4 inet-pton ( str addrspec -- data )
     drop
-    [
-        "." split dup length 4 = [
-            "Must have four components" throw
-        ] unless
-        [
-            string>number
-            [ "Dotted component not a number" throw ] unless*
-        ] B{ } map-as
-    ] [ invalid-inet4 ] recover ;
+    [ parse-inet4 ] [ invalid-inet4 ] recover ;
 
 M: inet4 address-size drop 4 ;
 
@@ -112,11 +116,24 @@ M: invalid-inet6 summary drop "Invalid IPv6 address" ;
 
 <PRIVATE
 
+ERROR: bad-ipv6-component obj ;
+
+ERROR: bad-ipv4-embedded-prefix obj ;
+
+: ensure-zero-prefix ( seq -- seq )
+    dup [ hex> ] map
+    [ { f 0 } swap member? ] all? [ bad-ipv4-embedded-prefix ] unless ;
+
 : parse-inet6 ( string -- seq )
     [ f ] [
-        ":" split [
-            hex> [ "Component not a number" throw ] unless*
-        ] { } map-as
+        ":" split CHAR: . over last member? [
+            unclip-last
+            [ ensure-zero-prefix drop ] [ parse-inet4 ] bi*
+        ] [
+            [
+                dup hex> [ nip ] [ bad-ipv6-component ] if*
+            ] { } map-as
+        ] if
     ] if-empty ;
 
 : pad-inet6 ( string1 string2 -- seq )