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 io.encodings.binary io.pathnames io.ports io.streams.duplex
kernel locals math math.parser memoize namespaces present kernel locals math math.parser memoize namespaces present
sequences sequences.private splitting strings summary system sequences sequences.private splitting strings summary system
vocabs vocabs.parser ip-parser ; vocabs vocabs.parser ip-parser ip-parser.private ;
IN: io.sockets IN: io.sockets
<< { << {
@ -68,32 +68,25 @@ TUPLE: ipv4 { host maybe{ string } read-only } ;
<PRIVATE <PRIVATE
ERROR: invalid-ipv4 string reason ; ERROR: invalid-ipv4 host reason ;
M: invalid-ipv4 summary drop "Invalid IPv4 address" ; 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 ; : check-ipv4 ( host -- )
[ ?parse-ipv4 drop ] [ invalid-ipv4 ] recover ;
: 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 ;
PRIVATE> PRIVATE>
: <ipv4> ( host -- ipv4 ) dup check-ipv4 ipv4 boa ; : <ipv4> ( host -- ipv4 ) dup check-ipv4 ipv4 boa ;
M: ipv4 inet-ntop ( data addrspec -- str ) 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 ) 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 ; M: ipv4 address-size drop 4 ;
@ -141,27 +134,8 @@ ERROR: invalid-ipv6 host reason ;
M: invalid-ipv6 summary drop "Invalid IPv6 address" ; M: invalid-ipv6 summary drop "Invalid IPv6 address" ;
ERROR: bad-ipv6-component obj ; : check-ipv6 ( host -- )
[ parse-ipv6 drop ] [ invalid-ipv6 ] recover ;
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 ;
PRIVATE> PRIVATE>
@ -172,21 +146,13 @@ M: ipv6 inet-ntop ( data addrspec -- str )
<PRIVATE <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 ) : ipv6-bytes ( seq -- bytes )
[ 2 >be ] { } map-as B{ } concat-as ; [ 2 >be ] { } map-as B{ } concat-as ;
PRIVATE> PRIVATE>
M: ipv6 inet-pton ( str addrspec -- data ) M: ipv6 inet-pton ( str addrspec -- data )
drop drop [ parse-ipv6 ipv6-bytes ] [ invalid-ipv6 ] recover ;
[ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ]
[ invalid-ipv6 ]
recover ;
M: ipv6 address-size drop 16 ; 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 IN: ip-parser
HELP: parse-ipv4 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 { $description "Parses an IP string that may not have all four address components specified, following these rules:" $nl
{ $table { $table
{ { $snippet "A" } { $snippet "0.0.0.A" } } { { $snippet "A" } { $snippet "0.0.0.A" } }
@ -13,3 +13,8 @@ HELP: parse-ipv4
$nl $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." "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 IN: ip-parser
{ "0.0.0.1" } [ "1" parse-ipv4 ] unit-test { "0.0.0.1" } [ "1" normalize-ipv4 ] unit-test
{ "1.0.0.2" } [ "1.2" parse-ipv4 ] unit-test { "1.0.0.2" } [ "1.2" normalize-ipv4 ] unit-test
{ "1.2.0.3" } [ "1.2.3" parse-ipv4 ] unit-test { "1.2.0.3" } [ "1.2.3" normalize-ipv4 ] unit-test
{ "1.2.3.4" } [ "1.2.3.4" parse-ipv4 ] unit-test { "1.2.3.4" } [ "1.2.3.4" normalize-ipv4 ] unit-test
[ "1.2.3.4.5" parse-ipv4 ] must-fail [ "1.2.3.4.5" normalize-ipv4 ] must-fail
{ "0.0.0.255" } [ "255" parse-ipv4 ] unit-test { "0.0.0.255" } [ "255" normalize-ipv4 ] unit-test
{ "0.0.1.0" } [ "256" parse-ipv4 ] unit-test { "0.0.1.0" } [ "256" normalize-ipv4 ] unit-test
{ t } [ { t } [
{ {
@ -19,8 +19,18 @@ IN: ip-parser
"0x4A.0x7D.0xE2.0x04" ! dotted hex "0x4A.0x7D.0xE2.0x04" ! dotted hex
"0x4A7DE204" ! flat hex "0x4A7DE204" ! flat hex
"74.0175.0xe2.4" "74.0175.0xe2.4"
} [ parse-ipv4 "74.125.226.4" = ] all? } [ normalize-ipv4 "74.125.226.4" = ] all?
] unit-test ] unit-test
{ "74.125.226.4" } [ 1249763844 ipv4-ntoa ] unit-test { "74.125.226.4" } [ 1249763844 ipv4-ntoa ] unit-test
{ 1249763844 } [ "74.125.226.4" ipv4-aton ] 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 ! Copyright (C) 2012-2014 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: combinators combinators.short-circuit kernel math USING: byte-arrays combinators combinators.short-circuit kernel
math.bitwise math.parser math.vectors sequences splitting ; math math.bitwise math.parser sequences splitting ;
IN: ip-parser IN: ip-parser
ERROR: invalid-ipv4 str ; ERROR: malformed-ipv4 string ;
ERROR: bad-ipv4-component string ;
<PRIVATE <PRIVATE
: cleanup-octal ( str -- str ) : octal? ( str -- ? )
dup { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& ;
[ rest "0o" prepend ] when ;
: split-components ( str -- array ) : ipv4-component ( str -- n )
"." split [ cleanup-octal string>number ] map ; dup dup octal? [ oct> ] [ string>number ] if
[ ] [ bad-ipv4-component ] ?if ;
: split-ipv4 ( str -- array )
"." split [ ipv4-component ] map ;
: bubble ( array -- newarray ) : bubble ( array -- newarray )
reverse 0 swap [ + 256 /mod ] map reverse nip ; reverse 0 swap [ + 256 /mod ] map reverse nip ;
: join-components ( array -- str ) : ?bubble ( array -- array )
[ number>string ] map "." join ; dup [ 255 > ] any? [ bubble ] when ;
: (parse-ipv4) ( str -- array ) : join-ipv4 ( array -- str )
dup split-components dup length { [ number>string ] { } map-as "." join ;
PRIVATE>
: parse-ipv4 ( str -- byte-array )
dup split-ipv4 dup length {
{ 1 [ { 0 0 0 } prepend ] } { 1 [ { 0 0 0 } prepend ] }
{ 2 [ 1 cut { 0 0 } glue ] } { 2 [ 1 cut { 0 0 } glue ] }
{ 3 [ 2 cut { 0 } glue ] } { 3 [ 2 cut { 0 } glue ] }
{ 4 [ ] } { 4 [ ] }
[ drop invalid-ipv4 ] [ 2drop malformed-ipv4 ]
} case bubble nip ; inline } 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> PRIVATE>
: parse-ipv4 ( str -- ip ) : parse-ipv6 ( string -- seq )
(parse-ipv4) join-components ; "::" split1 [ [ f ] [ split-ipv6 ] if-empty ] bi@ pad-ipv6 ;
: 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 ;