| … | |
… | |
| 39 | |
39 | |
| 40 | our @EXPORT = qw(inet_aton tcp_server tcp_connect); |
40 | our @EXPORT = qw(inet_aton tcp_server tcp_connect); |
| 41 | |
41 | |
| 42 | our $VERSION = '1.0'; |
42 | our $VERSION = '1.0'; |
| 43 | |
43 | |
| 44 | sub dotted_quad($) { |
44 | =item $ipn = parse_ipv4 $dotted_quad |
| 45 | $_[0] =~ /^(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) |
45 | |
| 46 | \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) |
46 | Tries to parse the given dotted quad IPv4 address and return it in |
| 47 | \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?) |
47 | octet form (or undef when it isn't in a parsable format). Supports all |
| 48 | \.(?:25[0-5]|2[0-4][0-9]|1[0-9][0-9]|[0-9][0-9]?)$/x |
48 | forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>, |
|
|
49 | C<0x12345678> or C<0377.0377.0377.0377>). |
|
|
50 | |
|
|
51 | =cut |
|
|
52 | |
|
|
53 | sub parse_ipv4($) { |
|
|
54 | $_[0] =~ /^ (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) |
|
|
55 | (?:\. (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) ){0,3}$/x |
|
|
56 | or return undef; |
|
|
57 | |
|
|
58 | @_ = map /^0/ ? oct : $_, split /\./, $_[0]; |
|
|
59 | |
|
|
60 | # check leading parts against range |
|
|
61 | return undef if grep $_ >= 256, @_[0 .. @_ - 2]; |
|
|
62 | |
|
|
63 | # check trailing part against range |
|
|
64 | return undef if $_[-1] >= 1 << (8 * (4 - $#_)); |
|
|
65 | |
|
|
66 | pack "N", (pop) |
|
|
67 | + ($_[0] << 24) |
|
|
68 | + ($_[1] << 16) |
|
|
69 | + ($_[2] << 8); |
|
|
70 | } |
|
|
71 | |
|
|
72 | =item $ipn = parse_ipv4 $dotted_quad |
|
|
73 | |
|
|
74 | Tries to parse the given IPv6 address and return it in |
|
|
75 | octet form (or undef when it isn't in a parsable format). |
|
|
76 | |
|
|
77 | Should support all forms specified by RFC 2373 (and additionally all IPv4 |
|
|
78 | formst supported by parse_ipv4). |
|
|
79 | |
|
|
80 | =cut |
|
|
81 | |
|
|
82 | sub parse_ipv6($) { |
|
|
83 | # quick test to avoid longer processing |
|
|
84 | my $n = $_[0] =~ y/://; |
|
|
85 | return undef if $n < 2 || $n > 8; |
|
|
86 | |
|
|
87 | my ($h, $t) = split /::/, $_[0], 2; |
|
|
88 | |
|
|
89 | unless (defined $t) { |
|
|
90 | ($h, $t) = (undef, $h); |
|
|
91 | } |
|
|
92 | |
|
|
93 | my @h = split /:/, $h; |
|
|
94 | my @t = split /:/, $t; |
|
|
95 | |
|
|
96 | # check four ipv4 tail |
|
|
97 | if (@t && $t[-1]=~ /\./) { |
|
|
98 | return undef if $n > 6; |
|
|
99 | |
|
|
100 | my $ipn = parse_ipv4 pop @t |
|
|
101 | or return undef; |
|
|
102 | |
|
|
103 | push @t, map +(sprintf "%x", $_), unpack "nn", $ipn; |
|
|
104 | } |
|
|
105 | |
|
|
106 | # no :: then we need to have exactly 8 components |
|
|
107 | return undef unless @h + @t == 8 || $_[0] =~ /::/; |
|
|
108 | |
|
|
109 | # now check all parts for validity |
|
|
110 | return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t; |
|
|
111 | |
|
|
112 | # now pad... |
|
|
113 | push @h, 0 while @h + @t < 8; |
|
|
114 | |
|
|
115 | # and done |
|
|
116 | pack "n*", map hex, @h, @t |
|
|
117 | } |
|
|
118 | |
|
|
119 | =item $ipn = parse_ip $text |
|
|
120 | |
|
|
121 | Combines C<parse_ipv4> and C<parse_ipv6> in one function. |
|
|
122 | |
|
|
123 | =cut |
|
|
124 | |
|
|
125 | sub parse_ip($) { |
|
|
126 | &parse_ipv4 || &parse_ipv6 |
|
|
127 | } |
|
|
128 | |
|
|
129 | =item $text = format_ip $ipn |
|
|
130 | |
|
|
131 | Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) |
|
|
132 | and converts it into textual form. |
|
|
133 | |
|
|
134 | =cut |
|
|
135 | |
|
|
136 | sub format_ip; |
|
|
137 | sub format_ip($) { |
|
|
138 | if (4 == length $_[0]) { |
|
|
139 | return join ".", unpack "C4", $_[0] |
|
|
140 | } elsif (16 == length $_[0]) { |
|
|
141 | if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { |
|
|
142 | # v4mapped |
|
|
143 | return "::ffff:" . format_ip substr $_[0], 12; |
|
|
144 | } else { |
|
|
145 | my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; |
|
|
146 | |
|
|
147 | $ip =~ s/^0:(?:0:)*/::/ |
|
|
148 | or $ip =~ s/(:0)+$/::/ |
|
|
149 | or $ip =~ s/(:0)+/:/; |
|
|
150 | return $ip |
|
|
151 | } |
|
|
152 | } else { |
|
|
153 | return undef |
|
|
154 | } |
| 49 | } |
155 | } |
| 50 | |
156 | |
| 51 | =item inet_aton $name_or_address, $cb->(@addresses) |
157 | =item inet_aton $name_or_address, $cb->(@addresses) |
| 52 | |
158 | |
| 53 | Works similarly to its Socket counterpart, except that it uses a |
159 | Works similarly to its Socket counterpart, except that it uses a |
| … | |
… | |
| 61 | =cut |
167 | =cut |
| 62 | |
168 | |
| 63 | sub inet_aton { |
169 | sub inet_aton { |
| 64 | my ($name, $cb) = @_; |
170 | my ($name, $cb) = @_; |
| 65 | |
171 | |
| 66 | if (&dotted_quad) { |
172 | if (my $ipn = &parse_ipv4) { |
| 67 | $cb->(socket_inet_aton $name); |
173 | $cb->($ipn); |
|
|
174 | } elsif (my $ipn = &parse_ipv6) { |
|
|
175 | $cb->($ipn); |
| 68 | } elsif ($name eq "localhost") { # rfc2606 et al. |
176 | } elsif ($name eq "localhost") { # rfc2606 et al. |
| 69 | $cb->(v127.0.0.1); |
177 | $cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1); |
| 70 | } else { |
178 | } else { |
| 71 | require AnyEvent::DNS; |
179 | require AnyEvent::DNS; |
| 72 | |
180 | |
| 73 | # simple, bad suboptimal algorithm |
181 | # simple, bad suboptimal algorithm |
| 74 | AnyEvent::DNS::a ($name, sub { |
182 | AnyEvent::DNS::a ($name, sub { |
| 75 | if (@_) { |
183 | if (@_) { |
| 76 | $cb->(map +(socket_inet_aton $_), @_); |
184 | $cb->(map +(parse_ipv4 $_), @_); |
| 77 | } else { |
185 | } else { |
| 78 | $cb->(); |
186 | $cb->(); |
| 79 | #AnyEvent::DNS::aaaa ($name, $cb); need inet_pton |
187 | #AnyEvent::DNS::aaaa ($name, $cb); need inet_pton |
| 80 | } |
188 | } |
| 81 | }); |
189 | }); |
