ip-parser: some cleanup, move ipv6 parsing here.

diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index 0061f8c5cf1726f55dc324df9d303230e9b405e2..a9f891213693f541f5915facfb247b9d06579d91 100644 (file)
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -8,7 +8,7 @@ grouping init io.backend io.binary io.encodings.ascii
 io.encodings.binary io.pathnames io.ports io.streams.duplex
 kernel locals math math.parser memoize namespaces present
 sequences sequences.private splitting strings summary system
-vocabs vocabs.parser ip-parser ;
+vocabs vocabs.parser ip-parser ip-parser.private ;
 IN: io.sockets
 
 << {
@@ -68,32 +68,25 @@ TUPLE: ipv4 { host maybe{ string } read-only } ;
 
 <PRIVATE
 
-ERROR: invalid-ipv4 string reason ;
+ERROR: invalid-ipv4 host reason ;
 
 M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
 
-ERROR: malformed-ipv4 sequence ;
+: ?parse-ipv4 ( string -- seq/f )
+    [ f ] [ parse-ipv4 ] if-empty ;
 
-ERROR: bad-ipv4-component string ;
-
-: ipv4>bytes ( string -- seq )
-    [ f ] [
-        "." split dup length 4 = [ malformed-ipv4 ] unless
-        [ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as
-    ] if-empty ;
-
-: check-ipv4 ( string -- )
-    [ parse-ipv4 drop ] [ invalid-ipv4 ] recover ;
+: check-ipv4 ( host -- )
+    [ ?parse-ipv4 drop ] [ invalid-ipv4 ] recover ;
 
 PRIVATE>
 
 : <ipv4> ( host -- ipv4 ) dup check-ipv4 ipv4 boa ;
 
 M: ipv4 inet-ntop ( data addrspec -- str )
-    drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
+    drop 4 memory>byte-array join-ipv4 ;
 
 M: ipv4 inet-pton ( str addrspec -- data )
-    drop [ parse-ipv4 ipv4>bytes ] [ invalid-ipv4 ] recover ;
+    drop [ ?parse-ipv4 ] [ invalid-ipv4 ] recover ;
 
 M: ipv4 address-size drop 4 ;
 
@@ -141,27 +134,8 @@ ERROR: invalid-ipv6 host reason ;
 
 M: invalid-ipv6 summary drop "Invalid IPv6 address" ;
 
-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-ipv6 ( string -- seq )
-    [ f ] [
-        ":" split CHAR: . over last member? [
-            unclip-last
-            [ parse-ipv6-component ] [ ipv4>bytes ] bi* append
-        ] [
-            parse-ipv6-component
-        ] if
-    ] if-empty ;
-
-: check-ipv6 ( string -- )
-    [ "::" split1 [ parse-ipv6 ] bi@ 2drop ] [ invalid-ipv6 ] recover ;
+: check-ipv6 ( host -- )
+    [ parse-ipv6 drop ] [ invalid-ipv6 ] recover ;
 
 PRIVATE>
 
@@ -172,21 +146,13 @@ M: ipv6 inet-ntop ( data addrspec -- str )
 
 <PRIVATE
 
-: pad-ipv6 ( string1 string2 -- seq )
-    2dup [ length ] bi@ + 8 swap -
-    dup 0 < [ more-than-8-components ] when
-    <byte-array> glue ;
-
 : ipv6-bytes ( seq -- bytes )
     [ 2 >be ] { } map-as B{ } concat-as ;
 
 PRIVATE>
 
 M: ipv6 inet-pton ( str addrspec -- data )
-    drop
-    [ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ]
-    [ invalid-ipv6 ]
-    recover ;
+    drop [ parse-ipv6 ipv6-bytes ] [ invalid-ipv6 ] recover ;
 
 M: ipv6 address-size drop 16 ;
 

diff --git a/basis/ip-parser/ip-parser-docs.factor b/basis/ip-parser/ip-parser-docs.factor
index f9eae1b7c85caad6f676569b15e7097d9ea536b7..207856f5d596a516fc0b20a477a55c7699261264 100644 (file)
--- a/basis/ip-parser/ip-parser-docs.factor
+++ b/basis/ip-parser/ip-parser-docs.factor
@@ -1,8 +1,8 @@
-USING: help.markup help.syntax strings ;
+USING: byte-arrays help.markup help.syntax strings ;
 IN: ip-parser
 
 HELP: parse-ipv4
-{ $values { "str" string } { "ip" string } }
+{ $values { "str" string } { "byte-array" byte-array } }
 { $description "Parses an IP string that may not have all four address components specified, following these rules:" $nl
     { $table
         { { $snippet "A" } { $snippet "0.0.0.A" } }
@@ -13,3 +13,8 @@ HELP: parse-ipv4
     $nl
     "In addition, this supports components specified as decimal, octal, hexadecimal, and mixed representations, as well as components specified larger than 255 by carry propagation."
 } ;
+
+HELP: normalize-ipv4
+{ $values { "str" string } { "newstr" string } }
+{ $description "Normalizes an IP string that may not have all four address components specified, using the rules implemented by " { $link parse-ipv4 } "."
+} ;

diff --git a/basis/ip-parser/ip-parser-tests.factor b/basis/ip-parser/ip-parser-tests.factor
index a1a084140156cd2363bae0cbc1e8b441010361a8..48161fdb26d878e578b2492de6a5855066ef4562 100644 (file)
--- a/basis/ip-parser/ip-parser-tests.factor
+++ b/basis/ip-parser/ip-parser-tests.factor
@@ -3,13 +3,13 @@ USING: kernel sequences tools.test ;
 
 IN: ip-parser
 
-{ "0.0.0.1" } [ "1" parse-ipv4 ] unit-test
-{ "1.0.0.2" } [ "1.2" parse-ipv4 ] unit-test
-{ "1.2.0.3" } [ "1.2.3" parse-ipv4 ] unit-test
-{ "1.2.3.4" } [ "1.2.3.4" parse-ipv4 ] unit-test
-[ "1.2.3.4.5" parse-ipv4 ] must-fail
-{ "0.0.0.255" } [ "255" parse-ipv4 ] unit-test
-{ "0.0.1.0" } [ "256" parse-ipv4 ] unit-test
+{ "0.0.0.1" } [ "1" normalize-ipv4 ] unit-test
+{ "1.0.0.2" } [ "1.2" normalize-ipv4 ] unit-test
+{ "1.2.0.3" } [ "1.2.3" normalize-ipv4 ] unit-test
+{ "1.2.3.4" } [ "1.2.3.4" normalize-ipv4 ] unit-test
+[ "1.2.3.4.5" normalize-ipv4 ] must-fail
+{ "0.0.0.255" } [ "255" normalize-ipv4 ] unit-test
+{ "0.0.1.0" } [ "256" normalize-ipv4 ] unit-test
 
 { t } [
     {
@@ -19,8 +19,18 @@ IN: ip-parser
         "0x4A.0x7D.0xE2.0x04" ! dotted hex
         "0x4A7DE204" ! flat hex
         "74.0175.0xe2.4"
-    } [ parse-ipv4 "74.125.226.4" = ] all?
+    } [ normalize-ipv4 "74.125.226.4" = ] all?
 ] unit-test
 
 { "74.125.226.4" } [ 1249763844 ipv4-ntoa ] unit-test
 { 1249763844 } [ "74.125.226.4" ipv4-aton ] unit-test
+
+{ { 0 0 0 0 0 0 0 1 } } [ "::1" parse-ipv6 ] unit-test
+
+{ t } [
+    {
+        "2001:0db8:0000:0000:0000:ff00:0042:8329"
+        "2001:db8:0:0:0:ff00:42:8329"
+        "2001:db8::ff00:42:8329"
+    } [ parse-ipv6 { 8193 3512 0 0 0 65280 66 33577 } = ] all?
+] unit-test

diff --git a/basis/ip-parser/ip-parser.factor b/basis/ip-parser/ip-parser.factor
index 5dc03fae7281962f88abd8bc8685da4017ae778e..45a39282479d94ad7a4bfbd743357b8ec0671dae 100644 (file)
--- a/basis/ip-parser/ip-parser.factor
+++ b/basis/ip-parser/ip-parser.factor
@@ -1,43 +1,77 @@
 ! Copyright (C) 2012-2014 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
-USING: combinators combinators.short-circuit kernel math
-math.bitwise math.parser math.vectors sequences splitting ;
+USING: byte-arrays combinators combinators.short-circuit kernel
+math math.bitwise math.parser sequences splitting ;
 
 IN: ip-parser
 
-ERROR: invalid-ipv4 str ;
+ERROR: malformed-ipv4 string ;
+
+ERROR: bad-ipv4-component string ;
 
 <PRIVATE
 
-: cleanup-octal ( str -- str )
-    dup { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&&
-    [ rest "0o" prepend ] when ;
+: octal? ( str -- ? )
+    { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& ;
+
+: ipv4-component ( str -- n )
+    dup dup octal? [ oct> ] [ string>number ] if
+    [ ] [ bad-ipv4-component ] ?if ;
 
-: split-components ( str -- array )
-    "." split [ cleanup-octal string>number ] map ;
+: split-ipv4 ( str -- array )
+    "." split [ ipv4-component ] map ;
 
 : bubble ( array -- newarray )
     reverse 0 swap [ + 256 /mod ] map reverse nip ;
 
-: join-components ( array -- str )
-    [ number>string ] map "." join ;
+: ?bubble ( array -- array )
+    dup [ 255 > ] any? [ bubble ] when ;
+
+: join-ipv4 ( array -- str )
+    [ number>string ] { } map-as "." join ;
+
+PRIVATE>
 
-: (parse-ipv4) ( str -- array )
-    dup split-components dup length {
+: parse-ipv4 ( str -- byte-array )
+    dup split-ipv4 dup length {
         { 1 [ { 0 0 0 } prepend ] }
         { 2 [ 1 cut { 0 0 } glue ] }
         { 3 [ 2 cut { 0 } glue ] }
         { 4 [ ] }
-        [ drop invalid-ipv4 ]
-    } case bubble nip ; inline
+        [ 2drop malformed-ipv4 ]
+    } case ?bubble nip B{ } like ; inline
 
-PRIVATE>
-
-: parse-ipv4 ( str -- ip )
-    (parse-ipv4) join-components ;
+: normalize-ipv4 ( str -- newstr )
+    parse-ipv4 join-ipv4 ;
 
 : ipv4-ntoa ( integer -- ip )
-    { -24 -16 -8 0 } [ 8 shift-mod ] with map join-components ;
+    { -24 -16 -8 0 } [ 8 shift-mod ] with map join-ipv4 ;
 
 : ipv4-aton ( ip -- integer )
-    (parse-ipv4) { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ;
+    parse-ipv4 { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ;
+
+ERROR: bad-ipv6-component obj ;
+
+ERROR: bad-ipv4-embedded-prefix obj ;
+
+ERROR: more-than-8-components ;
+
+<PRIVATE
+
+: ipv6-component ( str -- n )
+    dup hex> [ nip ] [ bad-ipv6-component ] if* ;
+
+: split-ipv6 ( string -- seq )
+    ":" split CHAR: . over last member? [ unclip-last ] [ f ] if
+    [ [ ipv6-component ] map ]
+    [ [ parse-ipv4 append ] unless-empty ] bi* ;
+
+: pad-ipv6 ( string1 string2 -- seq )
+    2dup [ length ] bi@ + 8 swap -
+    dup 0 < [ more-than-8-components ] when
+    <byte-array> glue ;
+
+PRIVATE>
+
+: parse-ipv6 ( string -- seq )
+    "::" split1 [ [ f ] [ split-ipv6 ] if-empty ] bi@ pad-ipv6 ;