diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 0061f8c5cf..a9f8912136 100644 --- 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 } ; 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> : ( 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 ) 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 f9eae1b7c8..207856f5d5 100644 --- 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 a1a0841401..48161fdb26 100644 --- 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 5dc03fae72..45a3928247 100644 --- 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 ; number ] map ; +: ipv4-component ( str -- n ) + dup dup octal? [ oct> ] [ string>number ] if + [ ] [ bad-ipv4-component ] ?if ; + +: 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 ; -: (parse-ipv4) ( str -- array ) - dup split-components dup length { +: join-ipv4 ( array -- str ) + [ number>string ] { } map-as "." join ; + +PRIVATE> + +: 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 + +: normalize-ipv4 ( str -- newstr ) + parse-ipv4 join-ipv4 ; + +: ipv4-ntoa ( integer -- ip ) + { -24 -16 -8 0 } [ 8 shift-mod ] with map join-ipv4 ; + +: ipv4-aton ( ip -- integer ) + 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 ; + + [ 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 + glue ; PRIVATE> -: parse-ipv4 ( str -- ip ) - (parse-ipv4) join-components ; - -: ipv4-ntoa ( integer -- ip ) - { -24 -16 -8 0 } [ 8 shift-mod ] with map join-components ; - -: ipv4-aton ( ip -- integer ) - (parse-ipv4) { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ; +: parse-ipv6 ( string -- seq ) + "::" split1 [ [ f ] [ split-ipv6 ] if-empty ] bi@ pad-ipv6 ;