TUPLE: ipv4 { host ?string read-only } ;
-C: <ipv4> ipv4
+<PRIVATE
-M: ipv4 inet-ntop ( data addrspec -- str )
- drop 4 memory>byte-array [ number>string ] { } map-as "." join ;
+ERROR: invalid-ipv4 string reason ;
-<PRIVATE
+M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
ERROR: malformed-ipv4 sequence ;
ERROR: bad-ipv4-component string ;
: parse-ipv4 ( string -- seq )
- "." split dup length 4 = [ malformed-ipv4 ] unless
- [ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as ;
-
-ERROR: invalid-ipv4 string reason ;
+ [ f ] [
+ "." split dup length 4 = [ malformed-ipv4 ] unless
+ [ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as
+ ] if-empty ;
-M: invalid-ipv4 summary drop "Invalid IPv4 address" ;
+: check-ipv4 ( string -- )
+ [ 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 ;
+
M: ipv4 inet-pton ( str addrspec -- data )
drop [ parse-ipv4 ] [ invalid-ipv4 ] recover ;
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> ;
{ host ?string read-only }
{ scope-id integer read-only } ;
-: <ipv6> ( host -- ipv6 ) 0 ipv6 boa ;
+<PRIVATE
-M: ipv6 inet-ntop ( data addrspec -- str )
- drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
+ERROR: invalid-ipv6 host reason ;
-ERROR: invalid-ipv6 string reason ;
-
-<PRIVATE
+M: invalid-ipv6 summary drop "Invalid IPv6 address" ;
ERROR: bad-ipv6-component obj ;
] if
] 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 )
2dup [ length ] bi@ + 8 swap -
dup 0 < [ more-than-8-components ] when
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
[ [ host>> ] [ scope-id>> ] bi ] dip