1 ! Copyright (C) 2012-2014 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
3 USING: byte-arrays combinators combinators.short-circuit kernel
4 math math.bitwise math.parser sequences splitting ;
8 ERROR: malformed-ipv4 string ;
10 ERROR: bad-ipv4-component string ;
15 { [ "0" = not ] [ "0" head? ] [ "0x" head? not ] } 1&& ;
17 : ipv4-component ( str -- n )
18 dup dup octal? [ oct> ] [ string>number ] if
19 [ ] [ bad-ipv4-component ] ?if ;
21 : split-ipv4 ( str -- array )
22 "." split [ ipv4-component ] map ;
24 : bubble ( array -- newarray )
25 reverse 0 swap [ + 256 /mod ] map reverse nip ;
27 : ?bubble ( array -- array )
28 dup [ 255 > ] any? [ bubble ] when ;
30 : join-ipv4 ( array -- str )
31 [ number>string ] { } map-as "." join ;
35 : parse-ipv4 ( str -- byte-array )
36 dup split-ipv4 dup length {
37 { 1 [ { 0 0 0 } prepend ] }
38 { 2 [ 1 cut { 0 0 } glue ] }
39 { 3 [ 2 cut { 0 } glue ] }
41 [ 2drop malformed-ipv4 ]
42 } case ?bubble nip B{ } like ; inline
44 : normalize-ipv4 ( str -- newstr )
45 parse-ipv4 join-ipv4 ;
47 : ipv4-ntoa ( integer -- ip )
48 { -24 -16 -8 0 } [ 8 shift-mod ] with map join-ipv4 ;
50 : ipv4-aton ( ip -- integer )
51 parse-ipv4 { 24 16 8 0 } [ shift ] [ + ] 2map-reduce ;
53 ERROR: bad-ipv6-component obj ;
55 ERROR: bad-ipv4-embedded-prefix obj ;
57 ERROR: more-than-8-components ;
61 : ipv6-component ( str -- n )
62 dup hex> [ ] [ bad-ipv6-component ] ?if ;
64 : split-ipv6 ( string -- seq )
65 ":" split CHAR: . over last member? [ unclip-last ] [ f ] if
66 [ [ ipv6-component ] map ]
67 [ [ parse-ipv4 append ] unless-empty ] bi* ;
69 : pad-ipv6 ( string1 string2 -- seq )
70 2dup [ length ] bi@ + 8 swap -
71 dup 0 < [ more-than-8-components ] when
76 : parse-ipv6 ( string -- seq )
77 "::" split1 [ [ f ] [ split-ipv6 ] if-empty ] bi@ pad-ipv6 ;