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

io.sockets: check ipv4 and ipv6 for valid address strings.

db4
John Benediktsson 2011-08-19 14:19:09 -07:00
parent 8335ceff8c
commit d7d1b6fea1
2 changed files with 41 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/io/sockets/sockets-tests.factor
View File

@ -29,6 +29,12 @@ os unix? [
[ T{ inet f "google.com" 80 } ] [ "google.com" 80 with-port ] unit-test [ T{ inet f "google.com" 80 } ] [ "google.com" 80 with-port ] unit-test
! Test bad hostnames
[ "google.com" f <inet4> ] must-fail
[ "a.b.c.d" f <inet4> ] must-fail
[ "google.com" f <inet6> ] must-fail
[ "a.b.c.d" f <inet6> ] must-fail
! Test present on addrspecs ! Test present on addrspecs
[ "4.4.4.4:12" ] [ "4.4.4.4" 12 <inet4> present ] unit-test [ "4.4.4.4:12" ] [ "4.4.4.4" 12 <inet4> present ] unit-test
[ "::1:12" ] [ "::1" 12 <inet6> present ] unit-test [ "::1:12" ] [ "::1" 12 <inet6> present ] unit-test

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

@ -68,27 +68,32 @@ SLOT: port
TUPLE: ipv4 { host ?string read-only } ; TUPLE: ipv4 { host ?string read-only } ;
C: <ipv4> ipv4
M: ipv4 inet-ntop ( data addrspec -- str )
drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
<PRIVATE <PRIVATE
ERROR: invalid-ipv4 string reason ;
M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
ERROR: malformed-ipv4 sequence ; ERROR: malformed-ipv4 sequence ;
ERROR: bad-ipv4-component string ; ERROR: bad-ipv4-component string ;
: parse-ipv4 ( string -- seq ) : parse-ipv4 ( string -- seq )
"." split dup length 4 = [ malformed-ipv4 ] unless [ f ] [
[ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as ; "." split dup length 4 = [ malformed-ipv4 ] unless
[ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as
] if-empty ;
ERROR: invalid-ipv4 string reason ; : check-ipv4 ( string -- )
[ parse-ipv4 drop ] [ invalid-ipv4 ] recover ;
M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
PRIVATE> 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 ;
M: ipv4 inet-pton ( str addrspec -- data ) M: ipv4 inet-pton ( str addrspec -- data )
drop [ parse-ipv4 ] [ invalid-ipv4 ] recover ; drop [ parse-ipv4 ] [ invalid-ipv4 ] recover ;
@ -113,7 +118,8 @@ M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
TUPLE: inet4 < ipv4 { port integer read-only } ; TUPLE: inet4 < ipv4 { port integer read-only } ;
C: <inet4> inet4 : <inet4> ( host port -- inet4 )
over check-ipv4 inet4 boa ;
M: ipv4 with-port [ host>> ] dip <inet4> ; M: ipv4 with-port [ host>> ] dip <inet4> ;
@ -129,15 +135,12 @@ TUPLE: ipv6
{ host ?string read-only } { host ?string read-only }
{ scope-id integer read-only } ; { scope-id integer read-only } ;
: <ipv6> ( host -- ipv6 ) 0 ipv6 boa ;
M: ipv6 inet-ntop ( data addrspec -- str )
drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
ERROR: invalid-ipv6 string reason ;
<PRIVATE <PRIVATE
ERROR: invalid-ipv6 host reason ;
M: invalid-ipv6 summary drop "Invalid IPv6 address" ;
ERROR: bad-ipv6-component obj ; ERROR: bad-ipv6-component obj ;
ERROR: bad-ipv4-embedded-prefix obj ; ERROR: bad-ipv4-embedded-prefix obj ;
@ -157,6 +160,18 @@ ERROR: more-than-8-components ;
] if ] if
] if-empty ; ] if-empty ;
: check-ipv6 ( string -- )
[ "::" split1 [ parse-ipv6 ] bi@ 2drop ] [ invalid-ipv6 ] recover ;
PRIVATE>
: <ipv6> ( host -- ipv6 ) dup check-ipv6 0 ipv6 boa ;
M: ipv6 inet-ntop ( data addrspec -- str )
drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
<PRIVATE
: pad-ipv6 ( string1 string2 -- seq ) : pad-ipv6 ( string1 string2 -- seq )
2dup [ length ] bi@ + 8 swap - 2dup [ length ] bi@ + 8 swap -
dup 0 < [ more-than-8-components ] when dup 0 < [ more-than-8-components ] when
@ -200,7 +215,8 @@ M: ipv6 present
TUPLE: inet6 < ipv6 { port integer read-only } ; TUPLE: inet6 < ipv6 { port integer read-only } ;
: <inet6> ( host port -- inet6 ) [ 0 ] dip inet6 boa ; : <inet6> ( host port -- inet6 )
[ dup check-ipv6 0 ] dip inet6 boa ;
M: ipv6 with-port M: ipv6 with-port
[ [ host>> ] [ scope-id>> ] bi ] dip [ [ host>> ] [ scope-id>> ] bi ] dip