ip-parser: adding a "ping-compatible" IP address parser.

extra/ip-parser/authors.txt

@@ -0,0 +1 @@
+John Benediktsson

extra/ip-parser/ip-parser-docs.factor

@@ -0,0 +1,15 @@
+USING: help.markup help.syntax strings ;
+IN: ip-parser
+
+HELP: parse-ipv4
+{ $values { "str" string } { "ip" string } }
+{ $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" } }
+        { { $snippet "A.D" } { $snippet "A.0.0.D" } }
+        { { $snippet "A.B.D" } { $snippet "A.B.0.D" } }
+        { { $snippet "A.B.C.D" } { $snippet "A.B.C.D" } }
+    }
+    $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."
+} ;

extra/ip-parser/ip-parser-tests.factor

@@ -0,0 +1,23 @@
+
+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
+
+{ t } [
+    {
+        "1249763844" ! flat decimal
+        "0112.0175.0342.0004" ! dotted octal
+        "011237361004" ! flat octal
+        "0x4A.0x7D.0xE2.0x04" ! dotted hex
+        "0x4A7DE204" ! flat hex
+        "74.0175.0xe2.4"
+    } [ parse-ipv4 "74.125.226.4" = ] all?
+] unit-test

extra/ip-parser/ip-parser.factor

@@ -0,0 +1,50 @@
+! Copyright (C) 2012 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: combinators combinators.short-circuit kernel locals math
+math.parser sequences splitting ;
+
+IN: ip-parser
+
+<PRIVATE
+
+: cleanup-octal ( str -- str )
+    dup { [ "0" head? ] [ "0x" head? not ] } 1&&
+    [ 1 tail "0o" prepend ] when ;
+
+: split-components ( str -- array )
+    "." split [ cleanup-octal string>number ] map ;
+
+: bubble ( array -- array' )
+    reverse 0 swap [ + 256 /mod ] map reverse nip ;
+
+: join-components ( array -- str )
+    bubble [ number>string ] map "." join ;
+
+: components ( str -- n )
+    [ CHAR: . = ] count ;
+
+: parse-1 ( str -- ip )
+    split-components { 0 0 0 } prepend ;
+
+: parse-2 ( str -- ip )
+    split-components first2 [| A D | { A 0 0 D } ] call ;
+
+: parse-3 ( str -- ip )
+    split-components first3 [| A B D | { A B 0 D } ] call ;
+
+: parse-4 ( str -- ip )
+    split-components ;
+
+PRIVATE>
+
+ERROR: invalid-ipv4 str ;
+
+: parse-ipv4 ( str -- ip )
+    dup components {
+        { 0 [ parse-1 ] }
+        { 1 [ parse-2 ] }
+        { 2 [ parse-3 ] }
+        { 3 [ parse-4 ] }
+        [ invalid-ipv4 ]
+    } case join-components ;