steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2016-03-05 09:51:37 -08:00
parent 0d2ac91bad
commit ee134373f0
4 changed files with 92 additions and 77 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
basis/io/sockets/sockets.factor
View File

@ -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 ;

9
basis/ip-parser/ip-parser-docs.factor
View File

@ -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 } "."
} ;

26
basis/ip-parser/ip-parser-tests.factor
View File

@ -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

78
basis/ip-parser/ip-parser.factor
View File

@ -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&& ;
: split-components ( str -- array )
"." split [ cleanup-octal 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 ;
<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-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 ;