1 |
root |
1.7 |
=head1 NAME |
2 |
elmex |
1.1 |
|
3 |
root |
1.135 |
AnyEvent::Socket - useful IPv4 and IPv6 stuff. also unix domain sockets. and stuff. |
4 |
elmex |
1.1 |
|
5 |
root |
1.7 |
=head1 SYNOPSIS |
6 |
elmex |
1.1 |
|
7 |
root |
1.45 |
use AnyEvent::Socket; |
8 |
|
|
|
9 |
|
|
tcp_connect "gameserver.deliantra.net", 13327, sub { |
10 |
|
|
my ($fh) = @_ |
11 |
|
|
or die "gameserver.deliantra.net connect failed: $!"; |
12 |
|
|
|
13 |
|
|
# enjoy your filehandle |
14 |
|
|
}; |
15 |
|
|
|
16 |
|
|
# a simple tcp server |
17 |
|
|
tcp_server undef, 8888, sub { |
18 |
|
|
my ($fh, $host, $port) = @_; |
19 |
|
|
|
20 |
|
|
syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; |
21 |
|
|
}; |
22 |
root |
1.19 |
|
23 |
root |
1.7 |
=head1 DESCRIPTION |
24 |
elmex |
1.1 |
|
25 |
root |
1.7 |
This module implements various utility functions for handling internet |
26 |
|
|
protocol addresses and sockets, in an as transparent and simple way as |
27 |
|
|
possible. |
28 |
elmex |
1.1 |
|
29 |
root |
1.7 |
All functions documented without C<AnyEvent::Socket::> prefix are exported |
30 |
|
|
by default. |
31 |
elmex |
1.1 |
|
32 |
root |
1.7 |
=over 4 |
33 |
elmex |
1.1 |
|
34 |
root |
1.7 |
=cut |
35 |
elmex |
1.1 |
|
36 |
root |
1.7 |
package AnyEvent::Socket; |
37 |
elmex |
1.1 |
|
38 |
root |
1.7 |
use Carp (); |
39 |
|
|
use Errno (); |
40 |
root |
1.34 |
use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); |
41 |
elmex |
1.1 |
|
42 |
root |
1.96 |
use AnyEvent (); BEGIN { AnyEvent::common_sense } |
43 |
root |
1.21 |
use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); |
44 |
root |
1.17 |
use AnyEvent::DNS (); |
45 |
elmex |
1.1 |
|
46 |
root |
1.7 |
use base 'Exporter'; |
47 |
elmex |
1.2 |
|
48 |
root |
1.34 |
our @EXPORT = qw( |
49 |
root |
1.93 |
getprotobyname |
50 |
root |
1.103 |
parse_hostport format_hostport |
51 |
root |
1.34 |
parse_ipv4 parse_ipv6 |
52 |
|
|
parse_ip parse_address |
53 |
root |
1.85 |
format_ipv4 format_ipv6 |
54 |
root |
1.34 |
format_ip format_address |
55 |
|
|
address_family |
56 |
|
|
inet_aton |
57 |
|
|
tcp_server |
58 |
|
|
tcp_connect |
59 |
|
|
); |
60 |
elmex |
1.2 |
|
61 |
root |
1.110 |
our $VERSION = $AnyEvent::VERSION; |
62 |
root |
1.108 |
|
63 |
root |
1.9 |
=item $ipn = parse_ipv4 $dotted_quad |
64 |
|
|
|
65 |
|
|
Tries to parse the given dotted quad IPv4 address and return it in |
66 |
|
|
octet form (or undef when it isn't in a parsable format). Supports all |
67 |
|
|
forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>, |
68 |
|
|
C<0x12345678> or C<0377.0377.0377.0377>). |
69 |
|
|
|
70 |
|
|
=cut |
71 |
|
|
|
72 |
|
|
sub parse_ipv4($) { |
73 |
|
|
$_[0] =~ /^ (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) |
74 |
|
|
(?:\. (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) ){0,3}$/x |
75 |
|
|
or return undef; |
76 |
|
|
|
77 |
|
|
@_ = map /^0/ ? oct : $_, split /\./, $_[0]; |
78 |
|
|
|
79 |
|
|
# check leading parts against range |
80 |
|
|
return undef if grep $_ >= 256, @_[0 .. @_ - 2]; |
81 |
|
|
|
82 |
|
|
# check trailing part against range |
83 |
root |
1.51 |
return undef if $_[-1] >= 2 ** (8 * (4 - $#_)); |
84 |
root |
1.9 |
|
85 |
|
|
pack "N", (pop) |
86 |
|
|
+ ($_[0] << 24) |
87 |
|
|
+ ($_[1] << 16) |
88 |
|
|
+ ($_[2] << 8); |
89 |
|
|
} |
90 |
|
|
|
91 |
root |
1.14 |
=item $ipn = parse_ipv6 $textual_ipv6_address |
92 |
root |
1.9 |
|
93 |
|
|
Tries to parse the given IPv6 address and return it in |
94 |
|
|
octet form (or undef when it isn't in a parsable format). |
95 |
|
|
|
96 |
|
|
Should support all forms specified by RFC 2373 (and additionally all IPv4 |
97 |
root |
1.26 |
forms supported by parse_ipv4). Note that scope-id's are not supported |
98 |
|
|
(and will not parse). |
99 |
root |
1.12 |
|
100 |
|
|
This function works similarly to C<inet_pton AF_INET6, ...>. |
101 |
root |
1.9 |
|
102 |
root |
1.116 |
Example: |
103 |
|
|
|
104 |
|
|
print unpack "H*", parse_ipv6 "2002:5345::10.0.0.1"; |
105 |
|
|
# => 2002534500000000000000000a000001 |
106 |
|
|
|
107 |
root |
1.9 |
=cut |
108 |
|
|
|
109 |
|
|
sub parse_ipv6($) { |
110 |
|
|
# quick test to avoid longer processing |
111 |
|
|
my $n = $_[0] =~ y/://; |
112 |
|
|
return undef if $n < 2 || $n > 8; |
113 |
|
|
|
114 |
|
|
my ($h, $t) = split /::/, $_[0], 2; |
115 |
|
|
|
116 |
root |
1.11 |
unless (defined $t) { |
117 |
root |
1.9 |
($h, $t) = (undef, $h); |
118 |
|
|
} |
119 |
|
|
|
120 |
|
|
my @h = split /:/, $h; |
121 |
|
|
my @t = split /:/, $t; |
122 |
|
|
|
123 |
root |
1.14 |
# check for ipv4 tail |
124 |
root |
1.9 |
if (@t && $t[-1]=~ /\./) { |
125 |
|
|
return undef if $n > 6; |
126 |
|
|
|
127 |
|
|
my $ipn = parse_ipv4 pop @t |
128 |
|
|
or return undef; |
129 |
|
|
|
130 |
|
|
push @t, map +(sprintf "%x", $_), unpack "nn", $ipn; |
131 |
|
|
} |
132 |
|
|
|
133 |
|
|
# no :: then we need to have exactly 8 components |
134 |
root |
1.11 |
return undef unless @h + @t == 8 || $_[0] =~ /::/; |
135 |
root |
1.9 |
|
136 |
|
|
# now check all parts for validity |
137 |
|
|
return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t; |
138 |
|
|
|
139 |
|
|
# now pad... |
140 |
|
|
push @h, 0 while @h + @t < 8; |
141 |
|
|
|
142 |
|
|
# and done |
143 |
|
|
pack "n*", map hex, @h, @t |
144 |
root |
1.7 |
} |
145 |
elmex |
1.1 |
|
146 |
root |
1.134 |
=item $token = parse_unix $hostname |
147 |
|
|
|
148 |
|
|
This fucntion exists mainly for symmetry to the other C<parse_protocol> |
149 |
|
|
functions - it takes a hostname and, if it is C<unix/>, it returns a |
150 |
|
|
special address token, otherwise C<undef>. |
151 |
|
|
|
152 |
|
|
The only use for this function is probably to detect whether a hostname |
153 |
|
|
matches whatever AnyEvent uses for unix domain sockets. |
154 |
|
|
|
155 |
|
|
=cut |
156 |
|
|
|
157 |
root |
1.34 |
sub parse_unix($) { |
158 |
|
|
$_[0] eq "unix/" |
159 |
|
|
? pack "S", AF_UNIX |
160 |
|
|
: undef |
161 |
root |
1.11 |
|
162 |
root |
1.34 |
} |
163 |
|
|
|
164 |
root |
1.81 |
=item $ipn = parse_address $ip |
165 |
root |
1.34 |
|
166 |
|
|
Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address |
167 |
|
|
here refers to the host address (not socket address) in network form |
168 |
|
|
(binary). |
169 |
|
|
|
170 |
|
|
If the C<$text> is C<unix/>, then this function returns a special token |
171 |
|
|
recognised by the other functions in this module to mean "UNIX domain |
172 |
|
|
socket". |
173 |
root |
1.11 |
|
174 |
root |
1.81 |
If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), |
175 |
|
|
then it will be treated as an IPv4 address. If you don't want that, you |
176 |
|
|
have to call C<parse_ipv4> and/or C<parse_ipv6> manually. |
177 |
|
|
|
178 |
root |
1.116 |
Example: |
179 |
|
|
|
180 |
|
|
print unpack "H*", parse_address "10.1.2.3"; |
181 |
|
|
# => 0a010203 |
182 |
|
|
|
183 |
root |
1.81 |
=item $ipn = AnyEvent::Socket::aton $ip |
184 |
root |
1.58 |
|
185 |
|
|
Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but |
186 |
|
|
I<without> name resolution). |
187 |
|
|
|
188 |
root |
1.11 |
=cut |
189 |
|
|
|
190 |
root |
1.34 |
sub parse_address($) { |
191 |
root |
1.81 |
for (&parse_ipv6) { |
192 |
|
|
if ($_) { |
193 |
|
|
s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//; |
194 |
|
|
return $_; |
195 |
|
|
} else { |
196 |
|
|
return &parse_ipv4 || &parse_unix |
197 |
|
|
} |
198 |
|
|
} |
199 |
root |
1.11 |
} |
200 |
|
|
|
201 |
root |
1.58 |
*aton = \&parse_address; |
202 |
root |
1.34 |
|
203 |
root |
1.93 |
=item ($name, $aliases, $proto) = getprotobyname $name |
204 |
|
|
|
205 |
|
|
Works like the builtin function of the same name, except it tries hard to |
206 |
|
|
work even on broken platforms (well, that's windows), where getprotobyname |
207 |
|
|
is traditionally very unreliable. |
208 |
|
|
|
209 |
root |
1.116 |
Example: get the protocol number for TCP (usually 6) |
210 |
|
|
|
211 |
|
|
my $proto = getprotobyname "tcp"; |
212 |
|
|
|
213 |
root |
1.93 |
=cut |
214 |
|
|
|
215 |
|
|
# microsoft can't even get getprotobyname working (the etc/protocols file |
216 |
|
|
# gets lost fairly often on windows), so we have to hardcode some common |
217 |
|
|
# protocol numbers ourselves. |
218 |
|
|
our %PROTO_BYNAME; |
219 |
|
|
|
220 |
|
|
$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP; |
221 |
|
|
$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP; |
222 |
|
|
$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP; |
223 |
|
|
|
224 |
|
|
sub getprotobyname($) { |
225 |
|
|
my $name = lc shift; |
226 |
|
|
|
227 |
|
|
defined (my $proton = $PROTO_BYNAME{$name} || (getprotobyname $name)[2]) |
228 |
|
|
or return; |
229 |
|
|
|
230 |
|
|
($name, uc $name, $proton) |
231 |
|
|
} |
232 |
|
|
|
233 |
root |
1.54 |
=item ($host, $service) = parse_hostport $string[, $default_service] |
234 |
|
|
|
235 |
|
|
Splitting a string of the form C<hostname:port> is a common |
236 |
|
|
problem. Unfortunately, just splitting on the colon makes it hard to |
237 |
|
|
specify IPv6 addresses and doesn't support the less common but well |
238 |
|
|
standardised C<[ip literal]> syntax. |
239 |
|
|
|
240 |
|
|
This function tries to do this job in a better way, it supports the |
241 |
|
|
following formats, where C<port> can be a numerical port number of a |
242 |
|
|
service name, or a C<name=port> string, and the C< port> and C<:port> |
243 |
|
|
parts are optional. Also, everywhere where an IP address is supported |
244 |
|
|
a hostname or unix domain socket address is also supported (see |
245 |
root |
1.134 |
C<parse_unix>), and strings starting with C</> will also be interpreted as |
246 |
|
|
unix domain sockets. |
247 |
root |
1.54 |
|
248 |
root |
1.134 |
hostname:port e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443", |
249 |
root |
1.54 |
ipv4:port e.g. "198.182.196.56", "127.1:22" |
250 |
|
|
ipv6 e.g. "::1", "affe::1" |
251 |
|
|
[ipv4or6]:port e.g. "[::1]", "[10.0.1]:80" |
252 |
|
|
[ipv4or6] port e.g. "[127.0.0.1]", "[www.x.org] 17" |
253 |
|
|
ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp" |
254 |
root |
1.134 |
unix/:path e.g. "unix/:/path/to/socket" |
255 |
|
|
/path e.g. "/path/to/socket" |
256 |
root |
1.54 |
|
257 |
|
|
It also supports defaulting the service name in a simple way by using |
258 |
|
|
C<$default_service> if no service was detected. If neither a service was |
259 |
|
|
detected nor a default was specified, then this function returns the |
260 |
root |
1.102 |
empty list. The same happens when a parse error was detected, such as a |
261 |
root |
1.54 |
hostname with a colon in it (the function is rather conservative, though). |
262 |
|
|
|
263 |
|
|
Example: |
264 |
|
|
|
265 |
|
|
print join ",", parse_hostport "localhost:443"; |
266 |
|
|
# => "localhost,443" |
267 |
|
|
|
268 |
|
|
print join ",", parse_hostport "localhost", "https"; |
269 |
|
|
# => "localhost,https" |
270 |
|
|
|
271 |
|
|
print join ",", parse_hostport "[::1]"; |
272 |
|
|
# => "," (empty list) |
273 |
|
|
|
274 |
root |
1.134 |
print join ",", parse_host_port "/tmp/debug.sock"; |
275 |
|
|
# => "unix/", "/tmp/debug.sock" |
276 |
|
|
|
277 |
root |
1.54 |
=cut |
278 |
|
|
|
279 |
|
|
sub parse_hostport($;$) { |
280 |
|
|
my ($host, $port); |
281 |
|
|
|
282 |
root |
1.56 |
for ("$_[0]") { # work on a copy, just in case, and also reset pos |
283 |
root |
1.55 |
|
284 |
root |
1.134 |
# shortcut for /path |
285 |
|
|
return ("unix/", $_) |
286 |
|
|
if m%^/%; |
287 |
|
|
|
288 |
root |
1.54 |
# parse host, special cases: "ipv6" or "ipv6 port" |
289 |
|
|
unless ( |
290 |
root |
1.55 |
($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc |
291 |
root |
1.54 |
and parse_ipv6 $host |
292 |
|
|
) { |
293 |
|
|
/^\s*/xgc; |
294 |
|
|
|
295 |
|
|
if (/^ \[ ([^\[\]]+) \]/xgc) { |
296 |
|
|
$host = $1; |
297 |
|
|
} elsif (/^ ([^\[\]:\ ]+) /xgc) { |
298 |
|
|
$host = $1; |
299 |
|
|
} else { |
300 |
|
|
return; |
301 |
|
|
} |
302 |
|
|
} |
303 |
|
|
|
304 |
|
|
# parse port |
305 |
|
|
if (/\G (?:\s+|:) ([^:[:space:]]+) \s*$/xgc) { |
306 |
|
|
$port = $1; |
307 |
|
|
} elsif (/\G\s*$/gc && length $_[1]) { |
308 |
|
|
$port = $_[1]; |
309 |
|
|
} else { |
310 |
|
|
return; |
311 |
|
|
} |
312 |
root |
1.134 |
|
313 |
root |
1.54 |
} |
314 |
|
|
|
315 |
|
|
# hostnames must not contain :'s |
316 |
|
|
return if $host =~ /:/ && !parse_ipv6 $host; |
317 |
|
|
|
318 |
|
|
($host, $port) |
319 |
|
|
} |
320 |
|
|
|
321 |
root |
1.103 |
=item $string = format_hostport $host, $port |
322 |
|
|
|
323 |
|
|
Takes a host (in textual form) and a port and formats in unambigiously in |
324 |
|
|
a way that C<parse_hostport> can parse it again. C<$port> can be C<undef>. |
325 |
|
|
|
326 |
|
|
=cut |
327 |
|
|
|
328 |
|
|
sub format_hostport($;$) { |
329 |
|
|
my ($host, $port) = @_; |
330 |
|
|
|
331 |
|
|
$port = ":$port" if length $port; |
332 |
|
|
$host = "[$host]" if $host =~ /:/; |
333 |
|
|
|
334 |
|
|
"$host$port" |
335 |
|
|
} |
336 |
|
|
|
337 |
root |
1.34 |
=item $sa_family = address_family $ipn |
338 |
|
|
|
339 |
|
|
Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :) |
340 |
|
|
of the given host address in network format. |
341 |
|
|
|
342 |
|
|
=cut |
343 |
|
|
|
344 |
|
|
sub address_family($) { |
345 |
|
|
4 == length $_[0] |
346 |
|
|
? AF_INET |
347 |
|
|
: 16 == length $_[0] |
348 |
|
|
? AF_INET6 |
349 |
|
|
: unpack "S", $_[0] |
350 |
|
|
} |
351 |
root |
1.11 |
|
352 |
root |
1.81 |
=item $text = format_ipv4 $ipn |
353 |
|
|
|
354 |
|
|
Expects a four octet string representing a binary IPv4 address and returns |
355 |
|
|
its textual format. Rarely used, see C<format_address> for a nicer |
356 |
|
|
interface. |
357 |
|
|
|
358 |
|
|
=item $text = format_ipv6 $ipn |
359 |
|
|
|
360 |
|
|
Expects a sixteen octet string representing a binary IPv6 address and |
361 |
|
|
returns its textual format. Rarely used, see C<format_address> for a |
362 |
|
|
nicer interface. |
363 |
|
|
|
364 |
root |
1.34 |
=item $text = format_address $ipn |
365 |
|
|
|
366 |
|
|
Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16 |
367 |
|
|
octets for IPv6) and convert it into textual form. |
368 |
|
|
|
369 |
|
|
Returns C<unix/> for UNIX domain sockets. |
370 |
root |
1.11 |
|
371 |
root |
1.12 |
This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, |
372 |
|
|
except it automatically detects the address type. |
373 |
|
|
|
374 |
root |
1.34 |
Returns C<undef> if it cannot detect the type. |
375 |
|
|
|
376 |
root |
1.81 |
If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just |
377 |
|
|
the contained IPv4 address will be returned. If you do not want that, you |
378 |
|
|
have to call C<format_ipv6> manually. |
379 |
|
|
|
380 |
root |
1.116 |
Example: |
381 |
|
|
|
382 |
|
|
print format_address "\x01\x02\x03\x05"; |
383 |
|
|
=> 1.2.3.5 |
384 |
|
|
|
385 |
root |
1.58 |
=item $text = AnyEvent::Socket::ntoa $ipn |
386 |
|
|
|
387 |
|
|
Same as format_address, but not exported (think C<inet_ntoa>). |
388 |
|
|
|
389 |
root |
1.11 |
=cut |
390 |
|
|
|
391 |
root |
1.81 |
sub format_ipv4($) { |
392 |
|
|
join ".", unpack "C4", $_[0] |
393 |
|
|
} |
394 |
|
|
|
395 |
|
|
sub format_ipv6($) { |
396 |
root |
1.120 |
if ($_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00/) { |
397 |
|
|
if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { |
398 |
|
|
return "::"; |
399 |
|
|
} elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { |
400 |
|
|
return "::1"; |
401 |
|
|
} elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { |
402 |
|
|
# v4compatible |
403 |
|
|
return "::" . format_ipv4 substr $_[0], 12; |
404 |
|
|
} elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { |
405 |
|
|
# v4mapped |
406 |
|
|
return "::ffff:" . format_ipv4 substr $_[0], 12; |
407 |
|
|
} elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { |
408 |
|
|
# v4translated |
409 |
|
|
return "::ffff:0:" . format_ipv4 substr $_[0], 12; |
410 |
|
|
} |
411 |
|
|
} |
412 |
|
|
|
413 |
|
|
my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; |
414 |
|
|
|
415 |
|
|
# this is admittedly rather sucky |
416 |
|
|
$ip =~ s/(?:^|:) 0:0:0:0:0:0:0 (?:$|:)/::/x |
417 |
|
|
or $ip =~ s/(?:^|:) 0:0:0:0:0:0 (?:$|:)/::/x |
418 |
|
|
or $ip =~ s/(?:^|:) 0:0:0:0:0 (?:$|:)/::/x |
419 |
|
|
or $ip =~ s/(?:^|:) 0:0:0:0 (?:$|:)/::/x |
420 |
|
|
or $ip =~ s/(?:^|:) 0:0:0 (?:$|:)/::/x |
421 |
|
|
or $ip =~ s/(?:^|:) 0:0 (?:$|:)/::/x |
422 |
|
|
or $ip =~ s/(?:^|:) 0 (?:$|:)/::/x; |
423 |
root |
1.81 |
|
424 |
root |
1.120 |
$ip |
425 |
root |
1.81 |
} |
426 |
|
|
|
427 |
root |
1.34 |
sub format_address($) { |
428 |
root |
1.120 |
if (4 == length $_[0]) { |
429 |
root |
1.81 |
return &format_ipv4; |
430 |
root |
1.120 |
} elsif (16 == length $_[0]) { |
431 |
|
|
return $_[0] =~ /^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff(....)$/s |
432 |
|
|
? format_ipv4 $1 |
433 |
root |
1.81 |
: &format_ipv6; |
434 |
root |
1.120 |
} elsif (AF_UNIX == address_family $_[0]) { |
435 |
root |
1.34 |
return "unix/" |
436 |
root |
1.11 |
} else { |
437 |
|
|
return undef |
438 |
|
|
} |
439 |
|
|
} |
440 |
|
|
|
441 |
root |
1.58 |
*ntoa = \&format_address; |
442 |
root |
1.34 |
|
443 |
root |
1.7 |
=item inet_aton $name_or_address, $cb->(@addresses) |
444 |
elmex |
1.1 |
|
445 |
root |
1.7 |
Works similarly to its Socket counterpart, except that it uses a |
446 |
root |
1.117 |
callback. Use the length to distinguish between ipv4 and ipv6 (4 octets |
447 |
|
|
for IPv4, 16 for IPv6), or use C<format_address> to convert it to a more |
448 |
|
|
readable format. |
449 |
|
|
|
450 |
|
|
Note that C<resolve_sockaddr>, while initially a more complex interface, |
451 |
root |
1.118 |
resolves host addresses, IDNs, service names and SRV records and gives you |
452 |
|
|
an ordered list of socket addresses to try and should be preferred over |
453 |
root |
1.117 |
C<inet_aton>. |
454 |
elmex |
1.2 |
|
455 |
root |
1.116 |
Example. |
456 |
|
|
|
457 |
|
|
inet_aton "www.google.com", my $cv = AE::cv; |
458 |
|
|
say unpack "H*", $_ |
459 |
|
|
for $cv->recv; |
460 |
|
|
# => d155e363 |
461 |
|
|
# => d155e367 etc. |
462 |
|
|
|
463 |
root |
1.117 |
inet_aton "ipv6.google.com", my $cv = AE::cv; |
464 |
|
|
say unpack "H*", $_ |
465 |
|
|
for $cv->recv; |
466 |
|
|
# => 20014860a00300000000000000000068 |
467 |
|
|
|
468 |
root |
1.7 |
=cut |
469 |
elmex |
1.2 |
|
470 |
root |
1.7 |
sub inet_aton { |
471 |
|
|
my ($name, $cb) = @_; |
472 |
elmex |
1.2 |
|
473 |
root |
1.9 |
if (my $ipn = &parse_ipv4) { |
474 |
|
|
$cb->($ipn); |
475 |
|
|
} elsif (my $ipn = &parse_ipv6) { |
476 |
|
|
$cb->($ipn); |
477 |
root |
1.7 |
} elsif ($name eq "localhost") { # rfc2606 et al. |
478 |
root |
1.9 |
$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1); |
479 |
root |
1.7 |
} else { |
480 |
|
|
require AnyEvent::DNS; |
481 |
elmex |
1.2 |
|
482 |
root |
1.117 |
my $ipv4 = $AnyEvent::PROTOCOL{ipv4}; |
483 |
|
|
my $ipv6 = $AnyEvent::PROTOCOL{ipv6}; |
484 |
|
|
|
485 |
|
|
my @res; |
486 |
|
|
|
487 |
|
|
my $cv = AE::cv { |
488 |
|
|
$cb->(map @$_, reverse @res); |
489 |
|
|
}; |
490 |
|
|
|
491 |
|
|
$cv->begin; |
492 |
|
|
|
493 |
|
|
if ($ipv4) { |
494 |
|
|
$cv->begin; |
495 |
|
|
AnyEvent::DNS::a ($name, sub { |
496 |
|
|
$res[$ipv4] = [map &parse_ipv4, @_]; |
497 |
|
|
$cv->end; |
498 |
|
|
}); |
499 |
|
|
}; |
500 |
|
|
|
501 |
|
|
if ($ipv6) { |
502 |
|
|
$cv->begin; |
503 |
|
|
AnyEvent::DNS::aaaa ($name, sub { |
504 |
|
|
$res[$ipv6] = [map &parse_ipv6, @_]; |
505 |
|
|
$cv->end; |
506 |
|
|
}); |
507 |
|
|
}; |
508 |
|
|
|
509 |
|
|
$cv->end; |
510 |
root |
1.7 |
} |
511 |
|
|
} |
512 |
elmex |
1.2 |
|
513 |
root |
1.95 |
BEGIN { |
514 |
|
|
*sockaddr_family = $Socket::VERSION >= 1.75 |
515 |
|
|
? \&Socket::sockaddr_family |
516 |
|
|
: # for 5.6.x, we need to do something much more horrible |
517 |
|
|
(Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55" |
518 |
|
|
| eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/ |
519 |
|
|
? sub { unpack "xC", $_[0] } |
520 |
|
|
: sub { unpack "S" , $_[0] }; |
521 |
|
|
} |
522 |
|
|
|
523 |
root |
1.117 |
# check for broken platforms with an extra field in sockaddr structure |
524 |
root |
1.32 |
# kind of a rfc vs. bsd issue, as usual (ok, normally it's a |
525 |
|
|
# unix vs. bsd issue, a iso C vs. bsd issue or simply a |
526 |
root |
1.95 |
# correctness vs. bsd issue.) |
527 |
|
|
my $pack_family = 0x55 == sockaddr_family ("\x55\x55") |
528 |
root |
1.32 |
? "xC" : "S"; |
529 |
|
|
|
530 |
root |
1.34 |
=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host |
531 |
root |
1.15 |
|
532 |
root |
1.34 |
Pack the given port/host combination into a binary sockaddr |
533 |
|
|
structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX |
534 |
|
|
domain sockets (C<$host> == C<unix/> and C<$service> == absolute |
535 |
|
|
pathname). |
536 |
root |
1.15 |
|
537 |
root |
1.116 |
Example: |
538 |
|
|
|
539 |
|
|
my $bind = AnyEvent::Socket::pack_sockaddr 43, v195.234.53.120; |
540 |
|
|
bind $socket, $bind |
541 |
|
|
or die "bind: $!"; |
542 |
|
|
|
543 |
root |
1.15 |
=cut |
544 |
|
|
|
545 |
|
|
sub pack_sockaddr($$) { |
546 |
root |
1.34 |
my $af = address_family $_[1]; |
547 |
|
|
|
548 |
|
|
if ($af == AF_INET) { |
549 |
root |
1.15 |
Socket::pack_sockaddr_in $_[0], $_[1] |
550 |
root |
1.34 |
} elsif ($af == AF_INET6) { |
551 |
root |
1.32 |
pack "$pack_family nL a16 L", |
552 |
root |
1.21 |
AF_INET6, |
553 |
root |
1.15 |
$_[0], # port |
554 |
|
|
0, # flowinfo |
555 |
|
|
$_[1], # addr |
556 |
|
|
0 # scope id |
557 |
root |
1.34 |
} elsif ($af == AF_UNIX) { |
558 |
|
|
Socket::pack_sockaddr_un $_[0] |
559 |
root |
1.15 |
} else { |
560 |
|
|
Carp::croak "pack_sockaddr: invalid host"; |
561 |
|
|
} |
562 |
|
|
} |
563 |
|
|
|
564 |
root |
1.34 |
=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa |
565 |
root |
1.15 |
|
566 |
|
|
Unpack the given binary sockaddr structure (as used by bind, getpeername |
567 |
root |
1.34 |
etc.) into a C<$service, $host> combination. |
568 |
|
|
|
569 |
|
|
For IPv4 and IPv6, C<$service> is the port number and C<$host> the host |
570 |
|
|
address in network format (binary). |
571 |
root |
1.15 |
|
572 |
root |
1.34 |
For UNIX domain sockets, C<$service> is the absolute pathname and C<$host> |
573 |
|
|
is a special token that is understood by the other functions in this |
574 |
|
|
module (C<format_address> converts it to C<unix/>). |
575 |
root |
1.15 |
|
576 |
|
|
=cut |
577 |
|
|
|
578 |
root |
1.113 |
# perl contains a bug (imho) where it requires that the kernel always returns |
579 |
|
|
# sockaddr_un structures of maximum length (which is not, AFAICS, required |
580 |
|
|
# by any standard). try to 0-pad structures for the benefit of those platforms. |
581 |
|
|
|
582 |
root |
1.114 |
my $sa_un_zero = eval { Socket::pack_sockaddr_un "" }; $sa_un_zero ^= $sa_un_zero; |
583 |
root |
1.113 |
|
584 |
root |
1.15 |
sub unpack_sockaddr($) { |
585 |
root |
1.95 |
my $af = sockaddr_family $_[0]; |
586 |
root |
1.15 |
|
587 |
root |
1.23 |
if ($af == AF_INET) { |
588 |
root |
1.15 |
Socket::unpack_sockaddr_in $_[0] |
589 |
root |
1.21 |
} elsif ($af == AF_INET6) { |
590 |
|
|
unpack "x2 n x4 a16", $_[0] |
591 |
root |
1.34 |
} elsif ($af == AF_UNIX) { |
592 |
root |
1.113 |
((Socket::unpack_sockaddr_un $_[0] ^ $sa_un_zero), pack "S", AF_UNIX) |
593 |
root |
1.15 |
} else { |
594 |
|
|
Carp::croak "unpack_sockaddr: unsupported protocol family $af"; |
595 |
|
|
} |
596 |
|
|
} |
597 |
|
|
|
598 |
root |
1.34 |
=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...) |
599 |
|
|
|
600 |
|
|
Tries to resolve the given nodename and service name into protocol families |
601 |
|
|
and sockaddr structures usable to connect to this node and service in a |
602 |
|
|
protocol-independent way. It works remotely similar to the getaddrinfo |
603 |
|
|
posix function. |
604 |
|
|
|
605 |
root |
1.118 |
For internet addresses, C<$node> is either an IPv4 or IPv6 address, an |
606 |
|
|
internet hostname (DNS domain name or IDN), and C<$service> is either |
607 |
|
|
a service name (port name from F</etc/services>) or a numerical port |
608 |
|
|
number. If both C<$node> and C<$service> are names, then SRV records |
609 |
|
|
will be consulted to find the real service, otherwise they will be |
610 |
|
|
used as-is. If you know that the service name is not in your services |
611 |
|
|
database, then you can specify the service in the format C<name=port> |
612 |
|
|
(e.g. C<http=80>). |
613 |
root |
1.34 |
|
614 |
root |
1.136 |
Hostnames will be looked up in F</etc/hosts> (or the file specified |
615 |
|
|
via C<< $ENV{PERL_ANYEVENT_HOSTS} >>). If they are found, the entries |
616 |
|
|
there will be used instead of querying DNS (SRV records will still be |
617 |
|
|
queried). The effect is as if entries from F</etc/hosts> would replace any |
618 |
|
|
existing C<A> and C<AAAA> records for the given host name and aliases. |
619 |
|
|
|
620 |
root |
1.34 |
For UNIX domain sockets, C<$node> must be the string C<unix/> and |
621 |
|
|
C<$service> must be the absolute pathname of the socket. In this case, |
622 |
|
|
C<$proto> will be ignored. |
623 |
|
|
|
624 |
|
|
C<$proto> must be a protocol name, currently C<tcp>, C<udp> or |
625 |
|
|
C<sctp>. The default is currently C<tcp>, but in the future, this function |
626 |
|
|
might try to use other protocols such as C<sctp>, depending on the socket |
627 |
|
|
type and any SRV records it might find. |
628 |
|
|
|
629 |
|
|
C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use |
630 |
root |
1.67 |
only IPv4) or C<6> (use only IPv6). The default is influenced by |
631 |
root |
1.34 |
C<$ENV{PERL_ANYEVENT_PROTOCOLS}>. |
632 |
|
|
|
633 |
|
|
C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or |
634 |
root |
1.67 |
C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM> |
635 |
|
|
unless C<$proto> is C<udp>). |
636 |
root |
1.34 |
|
637 |
|
|
The callback will receive zero or more array references that contain |
638 |
|
|
C<$family, $type, $proto> for use in C<socket> and a binary |
639 |
|
|
C<$sockaddr> for use in C<connect> (or C<bind>). |
640 |
|
|
|
641 |
|
|
The application should try these in the order given. |
642 |
|
|
|
643 |
|
|
Example: |
644 |
|
|
|
645 |
|
|
resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; |
646 |
|
|
|
647 |
|
|
=cut |
648 |
|
|
|
649 |
root |
1.136 |
our %HOSTS; |
650 |
|
|
our $HOSTS; |
651 |
|
|
|
652 |
|
|
if ( |
653 |
|
|
open my $fh, "<", |
654 |
|
|
length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS} |
655 |
|
|
: AnyEvent::WIN32 ? "$ENV{SystemRoot}/system32/drivers/etc/hosts" |
656 |
|
|
: "/etc/hosts" |
657 |
|
|
) { |
658 |
|
|
local $/; |
659 |
|
|
binmode $fh; |
660 |
|
|
$HOSTS = <$fh>; |
661 |
|
|
} else { |
662 |
|
|
$HOSTS = ""; |
663 |
|
|
} |
664 |
|
|
|
665 |
|
|
sub _parse_hosts() { |
666 |
|
|
#%HOSTS = (); |
667 |
|
|
|
668 |
|
|
for (split /\n/, $HOSTS) { |
669 |
|
|
s/#.*$//; |
670 |
|
|
s/^[ \t]+//; |
671 |
|
|
|
672 |
|
|
my ($addr, @aliases) = split /[ \t]+/; |
673 |
|
|
next unless @aliases; |
674 |
|
|
|
675 |
|
|
if (my $ip = parse_ipv4 $addr) { |
676 |
|
|
push @{ $HOSTS{$_}[0] }, $ip |
677 |
|
|
for @aliases; |
678 |
|
|
} elsif (my $ip = parse_ipv6 $addr) { |
679 |
|
|
push @{ $HOSTS{$_}[1] }, $ip |
680 |
|
|
for @aliases; |
681 |
|
|
} |
682 |
|
|
} |
683 |
|
|
|
684 |
|
|
undef $HOSTS; |
685 |
|
|
} |
686 |
|
|
|
687 |
root |
1.34 |
sub resolve_sockaddr($$$$$$) { |
688 |
|
|
my ($node, $service, $proto, $family, $type, $cb) = @_; |
689 |
|
|
|
690 |
|
|
if ($node eq "unix/") { |
691 |
root |
1.67 |
return $cb->() if $family || $service !~ /^\//; # no can do |
692 |
root |
1.34 |
|
693 |
root |
1.67 |
return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]); |
694 |
root |
1.34 |
} |
695 |
|
|
|
696 |
|
|
unless (AF_INET6) { |
697 |
|
|
$family != 6 |
698 |
|
|
or return $cb->(); |
699 |
|
|
|
700 |
|
|
$family = 4; |
701 |
|
|
} |
702 |
|
|
|
703 |
|
|
$cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4}; |
704 |
|
|
$cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6}; |
705 |
|
|
|
706 |
|
|
$family ||= 4 unless $AnyEvent::PROTOCOL{ipv6}; |
707 |
|
|
$family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; |
708 |
|
|
|
709 |
|
|
$proto ||= "tcp"; |
710 |
|
|
$type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; |
711 |
|
|
|
712 |
root |
1.124 |
my $proton = AnyEvent::Socket::getprotobyname $proto |
713 |
root |
1.34 |
or Carp::croak "$proto: protocol unknown"; |
714 |
|
|
|
715 |
|
|
my $port; |
716 |
|
|
|
717 |
|
|
if ($service =~ /^(\S+)=(\d+)$/) { |
718 |
|
|
($service, $port) = ($1, $2); |
719 |
|
|
} elsif ($service =~ /^\d+$/) { |
720 |
|
|
($service, $port) = (undef, $service); |
721 |
|
|
} else { |
722 |
|
|
$port = (getservbyname $service, $proto)[2] |
723 |
root |
1.35 |
or Carp::croak "$service/$proto: service unknown"; |
724 |
root |
1.34 |
} |
725 |
|
|
|
726 |
|
|
# resolve a records / provide sockaddr structures |
727 |
|
|
my $resolve = sub { |
728 |
root |
1.118 |
my @target = @_; |
729 |
|
|
|
730 |
root |
1.34 |
my @res; |
731 |
root |
1.107 |
my $cv = AE::cv { |
732 |
root |
1.34 |
$cb->( |
733 |
|
|
map $_->[2], |
734 |
|
|
sort { |
735 |
|
|
$AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]} |
736 |
|
|
or $a->[0] <=> $b->[0] |
737 |
|
|
} |
738 |
|
|
@res |
739 |
|
|
) |
740 |
root |
1.107 |
}; |
741 |
root |
1.34 |
|
742 |
|
|
$cv->begin; |
743 |
|
|
for my $idx (0 .. $#target) { |
744 |
|
|
my ($node, $port) = @{ $target[$idx] }; |
745 |
|
|
|
746 |
|
|
if (my $noden = parse_address $node) { |
747 |
root |
1.40 |
my $af = address_family $noden; |
748 |
|
|
|
749 |
|
|
if ($af == AF_INET && $family != 6) { |
750 |
root |
1.34 |
push @res, [$idx, "ipv4", [AF_INET, $type, $proton, |
751 |
|
|
pack_sockaddr $port, $noden]] |
752 |
|
|
} |
753 |
|
|
|
754 |
root |
1.40 |
if ($af == AF_INET6 && $family != 4) { |
755 |
root |
1.34 |
push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, |
756 |
|
|
pack_sockaddr $port, $noden]] |
757 |
|
|
} |
758 |
root |
1.136 |
} elsif (my $hosts = $HOSTS{$node}) { |
759 |
|
|
# hosts |
760 |
|
|
if (exists $HOSTS{$node}) { |
761 |
|
|
push @res, |
762 |
|
|
map [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, $_]], |
763 |
|
|
@{ $hosts->[0] } |
764 |
|
|
if $family != 6; |
765 |
|
|
|
766 |
|
|
push @res, |
767 |
|
|
map [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]], |
768 |
|
|
@{ $hosts->[1] } |
769 |
|
|
if $family != 4; |
770 |
|
|
} |
771 |
root |
1.34 |
} else { |
772 |
|
|
# ipv4 |
773 |
|
|
if ($family != 6) { |
774 |
|
|
$cv->begin; |
775 |
root |
1.39 |
AnyEvent::DNS::a $node, sub { |
776 |
root |
1.136 |
push @res, [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, parse_ipv4 $_]] |
777 |
root |
1.34 |
for @_; |
778 |
|
|
$cv->end; |
779 |
|
|
}; |
780 |
|
|
} |
781 |
|
|
|
782 |
|
|
# ipv6 |
783 |
|
|
if ($family != 4) { |
784 |
|
|
$cv->begin; |
785 |
root |
1.39 |
AnyEvent::DNS::aaaa $node, sub { |
786 |
root |
1.136 |
push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, parse_ipv6 $_]] |
787 |
root |
1.34 |
for @_; |
788 |
|
|
$cv->end; |
789 |
|
|
}; |
790 |
|
|
} |
791 |
|
|
} |
792 |
|
|
} |
793 |
|
|
$cv->end; |
794 |
|
|
}; |
795 |
|
|
|
796 |
root |
1.118 |
$node = AnyEvent::Util::idn_to_ascii $node |
797 |
|
|
if $node =~ /[^\x00-\x7f]/; |
798 |
|
|
|
799 |
root |
1.136 |
# parse hosts |
800 |
|
|
if (defined $HOSTS) { |
801 |
|
|
_parse_hosts; |
802 |
|
|
undef &_parse_hosts; |
803 |
|
|
} |
804 |
|
|
|
805 |
root |
1.34 |
# try srv records, if applicable |
806 |
|
|
if ($node eq "localhost") { |
807 |
root |
1.118 |
$resolve->(["127.0.0.1", $port], ["::1", $port]); |
808 |
root |
1.34 |
} elsif (defined $service && !parse_address $node) { |
809 |
root |
1.39 |
AnyEvent::DNS::srv $service, $proto, $node, sub { |
810 |
root |
1.34 |
my (@srv) = @_; |
811 |
|
|
|
812 |
root |
1.118 |
if (@srv) { |
813 |
|
|
# the only srv record has "." ("" here) => abort |
814 |
|
|
$srv[0][2] ne "" || $#srv |
815 |
|
|
or return $cb->(); |
816 |
|
|
|
817 |
|
|
# use srv records then |
818 |
|
|
$resolve->( |
819 |
|
|
map ["$_->[3].", $_->[2]], |
820 |
|
|
grep $_->[3] ne ".", |
821 |
|
|
@srv |
822 |
|
|
); |
823 |
|
|
} else { |
824 |
|
|
# no srv records, continue traditionally |
825 |
|
|
$resolve->([$node, $port]); |
826 |
|
|
} |
827 |
root |
1.34 |
}; |
828 |
|
|
} else { |
829 |
root |
1.118 |
# most common case |
830 |
|
|
$resolve->([$node, $port]); |
831 |
root |
1.34 |
} |
832 |
|
|
} |
833 |
|
|
|
834 |
root |
1.15 |
=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] |
835 |
elmex |
1.1 |
|
836 |
root |
1.118 |
This is a convenience function that creates a TCP socket and makes a |
837 |
|
|
100% non-blocking connect to the given C<$host> (which can be a DNS/IDN |
838 |
|
|
hostname or a textual IP address, or the string C<unix/> for UNIX domain |
839 |
|
|
sockets) and C<$service> (which can be a numeric port number or a service |
840 |
|
|
name, or a C<servicename=portnumber> string, or the pathname to a UNIX |
841 |
|
|
domain socket). |
842 |
root |
1.7 |
|
843 |
root |
1.8 |
If both C<$host> and C<$port> are names, then this function will use SRV |
844 |
root |
1.15 |
records to locate the real target(s). |
845 |
root |
1.8 |
|
846 |
root |
1.15 |
In either case, it will create a list of target hosts (e.g. for multihomed |
847 |
root |
1.17 |
hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to |
848 |
root |
1.15 |
each in turn. |
849 |
root |
1.7 |
|
850 |
root |
1.108 |
After the connection is established, then the C<$connect_cb> will be |
851 |
root |
1.128 |
invoked with the socket file handle (in non-blocking mode) as first, and |
852 |
root |
1.108 |
the peer host (as a textual IP address) and peer port as second and third |
853 |
|
|
arguments, respectively. The fourth argument is a code reference that you |
854 |
|
|
can call if, for some reason, you don't like this connection, which will |
855 |
|
|
cause C<tcp_connect> to try the next one (or call your callback without |
856 |
|
|
any arguments if there are no more connections). In most cases, you can |
857 |
|
|
simply ignore this argument. |
858 |
root |
1.15 |
|
859 |
|
|
$cb->($filehandle, $host, $port, $retry) |
860 |
root |
1.7 |
|
861 |
|
|
If the connect is unsuccessful, then the C<$connect_cb> will be invoked |
862 |
|
|
without any arguments and C<$!> will be set appropriately (with C<ENXIO> |
863 |
root |
1.17 |
indicating a DNS resolution failure). |
864 |
root |
1.7 |
|
865 |
root |
1.108 |
The callback will I<never> be invoked before C<tcp_connect> returns, even |
866 |
|
|
if C<tcp_connect> was able to connect immediately (e.g. on unix domain |
867 |
|
|
sockets). |
868 |
|
|
|
869 |
root |
1.17 |
The file handle is perfect for being plugged into L<AnyEvent::Handle>, but |
870 |
|
|
can be used as a normal perl file handle as well. |
871 |
root |
1.7 |
|
872 |
root |
1.15 |
Unless called in void context, C<tcp_connect> returns a guard object that |
873 |
root |
1.122 |
will automatically cancel the connection attempt when it gets destroyed |
874 |
|
|
- in which case the callback will not be invoked. Destroying it does not |
875 |
|
|
do anything to the socket after the connect was successful - you cannot |
876 |
|
|
"uncall" a callback that has been invoked already. |
877 |
root |
1.15 |
|
878 |
root |
1.7 |
Sometimes you need to "prepare" the socket before connecting, for example, |
879 |
|
|
to C<bind> it to some port, or you want a specific connect timeout that |
880 |
|
|
is lower than your kernel's default timeout. In this case you can specify |
881 |
|
|
a second callback, C<$prepare_cb>. It will be called with the file handle |
882 |
|
|
in not-yet-connected state as only argument and must return the connection |
883 |
|
|
timeout value (or C<0>, C<undef> or the empty list to indicate the default |
884 |
|
|
timeout is to be used). |
885 |
|
|
|
886 |
root |
1.17 |
Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP |
887 |
root |
1.7 |
socket (although only IPv4 is currently supported by this module). |
888 |
|
|
|
889 |
root |
1.28 |
Note to the poor Microsoft Windows users: Windows (of course) doesn't |
890 |
|
|
correctly signal connection errors, so unless your event library works |
891 |
|
|
around this, failed connections will simply hang. The only event libraries |
892 |
|
|
that handle this condition correctly are L<EV> and L<Glib>. Additionally, |
893 |
|
|
AnyEvent works around this bug with L<Event> and in its pure-perl |
894 |
|
|
backend. All other libraries cannot correctly handle this condition. To |
895 |
|
|
lessen the impact of this windows bug, a default timeout of 30 seconds |
896 |
|
|
will be imposed on windows. Cygwin is not affected. |
897 |
root |
1.27 |
|
898 |
root |
1.7 |
Simple Example: connect to localhost on port 22. |
899 |
|
|
|
900 |
root |
1.45 |
tcp_connect localhost => 22, sub { |
901 |
|
|
my $fh = shift |
902 |
|
|
or die "unable to connect: $!"; |
903 |
|
|
# do something |
904 |
|
|
}; |
905 |
root |
1.7 |
|
906 |
|
|
Complex Example: connect to www.google.com on port 80 and make a simple |
907 |
|
|
GET request without much error handling. Also limit the connection timeout |
908 |
|
|
to 15 seconds. |
909 |
|
|
|
910 |
|
|
tcp_connect "www.google.com", "http", |
911 |
|
|
sub { |
912 |
|
|
my ($fh) = @_ |
913 |
|
|
or die "unable to connect: $!"; |
914 |
|
|
|
915 |
|
|
my $handle; # avoid direct assignment so on_eof has it in scope. |
916 |
|
|
$handle = new AnyEvent::Handle |
917 |
|
|
fh => $fh, |
918 |
root |
1.90 |
on_error => sub { |
919 |
|
|
warn "error $_[2]\n"; |
920 |
root |
1.91 |
$_[0]->destroy; |
921 |
root |
1.90 |
}, |
922 |
root |
1.7 |
on_eof => sub { |
923 |
root |
1.90 |
$handle->destroy; # destroy handle |
924 |
root |
1.7 |
warn "done.\n"; |
925 |
|
|
}; |
926 |
|
|
|
927 |
|
|
$handle->push_write ("GET / HTTP/1.0\015\012\015\012"); |
928 |
|
|
|
929 |
elmex |
1.111 |
$handle->push_read (line => "\015\012\015\012", sub { |
930 |
root |
1.7 |
my ($handle, $line) = @_; |
931 |
|
|
|
932 |
|
|
# print response header |
933 |
|
|
print "HEADER\n$line\n\nBODY\n"; |
934 |
|
|
|
935 |
|
|
$handle->on_read (sub { |
936 |
|
|
# print response body |
937 |
|
|
print $_[0]->rbuf; |
938 |
|
|
$_[0]->rbuf = ""; |
939 |
|
|
}); |
940 |
|
|
}); |
941 |
|
|
}, sub { |
942 |
|
|
my ($fh) = @_; |
943 |
|
|
# could call $fh->bind etc. here |
944 |
elmex |
1.2 |
|
945 |
root |
1.7 |
15 |
946 |
|
|
}; |
947 |
elmex |
1.2 |
|
948 |
root |
1.34 |
Example: connect to a UNIX domain socket. |
949 |
|
|
|
950 |
|
|
tcp_connect "unix/", "/tmp/.X11-unix/X0", sub { |
951 |
|
|
... |
952 |
|
|
} |
953 |
|
|
|
954 |
root |
1.7 |
=cut |
955 |
elmex |
1.2 |
|
956 |
root |
1.7 |
sub tcp_connect($$$;$) { |
957 |
|
|
my ($host, $port, $connect, $prepare) = @_; |
958 |
elmex |
1.2 |
|
959 |
root |
1.118 |
# see http://cr.yp.to/docs/connect.html for some tricky aspects |
960 |
root |
1.33 |
# also http://advogato.org/article/672.html |
961 |
elmex |
1.2 |
|
962 |
root |
1.7 |
my %state = ( fh => undef ); |
963 |
elmex |
1.2 |
|
964 |
root |
1.33 |
# name/service to type/sockaddr resolution |
965 |
root |
1.67 |
resolve_sockaddr $host, $port, 0, 0, undef, sub { |
966 |
root |
1.15 |
my @target = @_; |
967 |
root |
1.7 |
|
968 |
root |
1.15 |
$state{next} = sub { |
969 |
|
|
return unless exists $state{fh}; |
970 |
root |
1.7 |
|
971 |
root |
1.15 |
my $target = shift @target |
972 |
root |
1.132 |
or return AE::postpone { |
973 |
root |
1.123 |
return unless exists $state{fh}; |
974 |
|
|
%state = (); |
975 |
|
|
$connect->(); |
976 |
|
|
}; |
977 |
root |
1.7 |
|
978 |
root |
1.15 |
my ($domain, $type, $proto, $sockaddr) = @$target; |
979 |
root |
1.7 |
|
980 |
root |
1.15 |
# socket creation |
981 |
|
|
socket $state{fh}, $domain, $type, $proto |
982 |
|
|
or return $state{next}(); |
983 |
|
|
|
984 |
|
|
fh_nonblocking $state{fh}, 1; |
985 |
|
|
|
986 |
root |
1.27 |
my $timeout = $prepare && $prepare->($state{fh}); |
987 |
|
|
|
988 |
root |
1.30 |
$timeout ||= 30 if AnyEvent::WIN32; |
989 |
root |
1.15 |
|
990 |
root |
1.107 |
$state{to} = AE::timer $timeout, 0, sub { |
991 |
root |
1.90 |
$! = Errno::ETIMEDOUT; |
992 |
root |
1.27 |
$state{next}(); |
993 |
root |
1.107 |
} if $timeout; |
994 |
root |
1.7 |
|
995 |
root |
1.107 |
# now connect |
996 |
|
|
if ( |
997 |
|
|
(connect $state{fh}, $sockaddr) |
998 |
|
|
|| ($! == Errno::EINPROGRESS # POSIX |
999 |
|
|
|| $! == Errno::EWOULDBLOCK |
1000 |
|
|
# WSAEINPROGRESS intentionally not checked - it means something else entirely |
1001 |
|
|
|| $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt |
1002 |
|
|
|| $! == AnyEvent::Util::WSAEWOULDBLOCK) |
1003 |
|
|
) { |
1004 |
|
|
$state{ww} = AE::io $state{fh}, 1, sub { |
1005 |
|
|
# we are connected, or maybe there was an error |
1006 |
|
|
if (my $sin = getpeername $state{fh}) { |
1007 |
|
|
my ($port, $host) = unpack_sockaddr $sin; |
1008 |
|
|
|
1009 |
|
|
delete $state{ww}; delete $state{to}; |
1010 |
|
|
|
1011 |
|
|
my $guard = guard { %state = () }; |
1012 |
|
|
|
1013 |
|
|
$connect->(delete $state{fh}, format_address $host, $port, sub { |
1014 |
|
|
$guard->cancel; |
1015 |
|
|
$state{next}(); |
1016 |
|
|
}); |
1017 |
|
|
} else { |
1018 |
root |
1.119 |
if ($! == Errno::ENOTCONN) { |
1019 |
|
|
# dummy read to fetch real error code if !cygwin |
1020 |
|
|
sysread $state{fh}, my $buf, 1; |
1021 |
|
|
|
1022 |
|
|
# cygwin 1.5 continously reports "ready' but never delivers |
1023 |
|
|
# an error with getpeername or sysread. |
1024 |
|
|
# cygwin 1.7 only reports readyness *once*, but is otherwise |
1025 |
root |
1.130 |
# the same, which is actually more broken. |
1026 |
root |
1.119 |
# Work around both by using unportable SO_ERROR for cygwin. |
1027 |
|
|
$! = (unpack "l", getsockopt $state{fh}, Socket::SOL_SOCKET(), Socket::SO_ERROR()) || Errno::EAGAIN |
1028 |
|
|
if AnyEvent::CYGWIN && $! == Errno::EAGAIN; |
1029 |
|
|
} |
1030 |
root |
1.15 |
|
1031 |
root |
1.107 |
return if $! == Errno::EAGAIN; # skip spurious wake-ups |
1032 |
root |
1.89 |
|
1033 |
root |
1.107 |
delete $state{ww}; delete $state{to}; |
1034 |
root |
1.15 |
|
1035 |
|
|
$state{next}(); |
1036 |
root |
1.107 |
} |
1037 |
|
|
}; |
1038 |
root |
1.7 |
} else { |
1039 |
root |
1.29 |
$state{next}(); |
1040 |
root |
1.7 |
} |
1041 |
|
|
}; |
1042 |
elmex |
1.1 |
|
1043 |
root |
1.90 |
$! = Errno::ENXIO; |
1044 |
root |
1.15 |
$state{next}(); |
1045 |
root |
1.7 |
}; |
1046 |
elmex |
1.1 |
|
1047 |
root |
1.15 |
defined wantarray && guard { %state = () } |
1048 |
elmex |
1.1 |
} |
1049 |
|
|
|
1050 |
root |
1.35 |
=item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb] |
1051 |
elmex |
1.1 |
|
1052 |
root |
1.35 |
Create and bind a stream socket to the given host, and port, set the |
1053 |
|
|
SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name |
1054 |
|
|
implies, this function can also bind on UNIX domain sockets. |
1055 |
|
|
|
1056 |
|
|
For internet sockets, C<$host> must be an IPv4 or IPv6 address (or |
1057 |
root |
1.38 |
C<undef>, in which case it binds either to C<0> or to C<::>, depending |
1058 |
|
|
on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in |
1059 |
|
|
future versions, as applicable). |
1060 |
root |
1.21 |
|
1061 |
|
|
To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 |
1062 |
|
|
wildcard address, use C<::>. |
1063 |
|
|
|
1064 |
root |
1.35 |
The port is specified by C<$service>, which must be either a service name or |
1065 |
root |
1.21 |
a numeric port number (or C<0> or C<undef>, in which case an ephemeral |
1066 |
|
|
port will be used). |
1067 |
|
|
|
1068 |
root |
1.35 |
For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be |
1069 |
|
|
the absolute pathname of the socket. This function will try to C<unlink> |
1070 |
root |
1.133 |
the socket before it tries to bind to it, and will try to unlink it after |
1071 |
|
|
it stops using it. See SECURITY CONSIDERATIONS, below. |
1072 |
root |
1.35 |
|
1073 |
root |
1.21 |
For each new connection that could be C<accept>ed, call the C<< |
1074 |
|
|
$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking |
1075 |
root |
1.128 |
mode) as first, and the peer host and port as second and third arguments |
1076 |
root |
1.21 |
(see C<tcp_connect> for details). |
1077 |
|
|
|
1078 |
|
|
Croaks on any errors it can detect before the listen. |
1079 |
elmex |
1.1 |
|
1080 |
root |
1.7 |
If called in non-void context, then this function returns a guard object |
1081 |
root |
1.17 |
whose lifetime it tied to the TCP server: If the object gets destroyed, |
1082 |
root |
1.7 |
the server will be stopped (but existing accepted connections will |
1083 |
root |
1.129 |
not be affected). |
1084 |
elmex |
1.1 |
|
1085 |
root |
1.7 |
If you need more control over the listening socket, you can provide a |
1086 |
root |
1.21 |
C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the |
1087 |
|
|
C<listen ()> call, with the listen file handle as first argument, and IP |
1088 |
|
|
address and port number of the local socket endpoint as second and third |
1089 |
|
|
arguments. |
1090 |
elmex |
1.2 |
|
1091 |
root |
1.7 |
It should return the length of the listen queue (or C<0> for the default). |
1092 |
elmex |
1.2 |
|
1093 |
root |
1.38 |
Note to IPv6 users: RFC-compliant behaviour for IPv6 sockets listening on |
1094 |
|
|
C<::> is to bind to both IPv6 and IPv4 addresses by default on dual-stack |
1095 |
|
|
hosts. Unfortunately, only GNU/Linux seems to implement this properly, so |
1096 |
|
|
if you want both IPv4 and IPv6 listening sockets you should create the |
1097 |
|
|
IPv6 socket first and then attempt to bind on the IPv4 socket, but ignore |
1098 |
|
|
any C<EADDRINUSE> errors. |
1099 |
|
|
|
1100 |
root |
1.24 |
Example: bind on some TCP port on the local machine and tell each client |
1101 |
root |
1.7 |
to go away. |
1102 |
elmex |
1.2 |
|
1103 |
root |
1.24 |
tcp_server undef, undef, sub { |
1104 |
root |
1.7 |
my ($fh, $host, $port) = @_; |
1105 |
elmex |
1.1 |
|
1106 |
root |
1.7 |
syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; |
1107 |
root |
1.24 |
}, sub { |
1108 |
|
|
my ($fh, $thishost, $thisport) = @_; |
1109 |
|
|
warn "bound to $thishost, port $thisport\n"; |
1110 |
root |
1.7 |
}; |
1111 |
elmex |
1.1 |
|
1112 |
root |
1.67 |
Example: bind a server on a unix domain socket. |
1113 |
|
|
|
1114 |
|
|
tcp_server "unix/", "/tmp/mydir/mysocket", sub { |
1115 |
|
|
my ($fh) = @_; |
1116 |
|
|
}; |
1117 |
|
|
|
1118 |
root |
1.7 |
=cut |
1119 |
elmex |
1.1 |
|
1120 |
root |
1.7 |
sub tcp_server($$$;$) { |
1121 |
root |
1.35 |
my ($host, $service, $accept, $prepare) = @_; |
1122 |
elmex |
1.1 |
|
1123 |
root |
1.25 |
$host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 |
1124 |
root |
1.22 |
? "::" : "0" |
1125 |
root |
1.21 |
unless defined $host; |
1126 |
|
|
|
1127 |
root |
1.34 |
my $ipn = parse_address $host |
1128 |
|
|
or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address"; |
1129 |
root |
1.21 |
|
1130 |
root |
1.35 |
my $af = address_family $ipn; |
1131 |
root |
1.21 |
|
1132 |
root |
1.7 |
my %state; |
1133 |
elmex |
1.1 |
|
1134 |
root |
1.36 |
# win32 perl is too stupid to get this right :/ |
1135 |
|
|
Carp::croak "tcp_server/socket: address family not supported" |
1136 |
|
|
if AnyEvent::WIN32 && $af == AF_UNIX; |
1137 |
|
|
|
1138 |
root |
1.35 |
socket $state{fh}, $af, SOCK_STREAM, 0 |
1139 |
root |
1.36 |
or Carp::croak "tcp_server/socket: $!"; |
1140 |
elmex |
1.1 |
|
1141 |
root |
1.35 |
if ($af == AF_INET || $af == AF_INET6) { |
1142 |
|
|
setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1 |
1143 |
root |
1.36 |
or Carp::croak "tcp_server/so_reuseaddr: $!" |
1144 |
root |
1.37 |
unless AnyEvent::WIN32; # work around windows bug |
1145 |
root |
1.35 |
|
1146 |
|
|
unless ($service =~ /^\d*$/) { |
1147 |
|
|
$service = (getservbyname $service, "tcp")[2] |
1148 |
|
|
or Carp::croak "$service: service unknown" |
1149 |
|
|
} |
1150 |
|
|
} elsif ($af == AF_UNIX) { |
1151 |
|
|
unlink $service; |
1152 |
|
|
} |
1153 |
elmex |
1.1 |
|
1154 |
root |
1.35 |
bind $state{fh}, pack_sockaddr $service, $ipn |
1155 |
root |
1.7 |
or Carp::croak "bind: $!"; |
1156 |
elmex |
1.1 |
|
1157 |
root |
1.133 |
if ($af == AF_UNIX) { |
1158 |
|
|
my $fh = $state{fh}; |
1159 |
|
|
my $ino = (stat $fh)[1]; |
1160 |
|
|
$state{unlink} = guard { |
1161 |
|
|
# this is racy, but is not designed to be foolproof, just best-effort |
1162 |
|
|
unlink $service |
1163 |
|
|
if $ino == (stat $fh)[1]; |
1164 |
|
|
}; |
1165 |
|
|
} |
1166 |
|
|
|
1167 |
root |
1.7 |
fh_nonblocking $state{fh}, 1; |
1168 |
elmex |
1.1 |
|
1169 |
root |
1.21 |
my $len; |
1170 |
|
|
|
1171 |
|
|
if ($prepare) { |
1172 |
root |
1.35 |
my ($service, $host) = unpack_sockaddr getsockname $state{fh}; |
1173 |
|
|
$len = $prepare && $prepare->($state{fh}, format_address $host, $service); |
1174 |
root |
1.21 |
} |
1175 |
|
|
|
1176 |
|
|
$len ||= 128; |
1177 |
elmex |
1.1 |
|
1178 |
root |
1.7 |
listen $state{fh}, $len |
1179 |
|
|
or Carp::croak "listen: $!"; |
1180 |
elmex |
1.1 |
|
1181 |
root |
1.107 |
$state{aw} = AE::io $state{fh}, 0, sub { |
1182 |
root |
1.7 |
# this closure keeps $state alive |
1183 |
root |
1.115 |
while ($state{fh} && (my $peer = accept my $fh, $state{fh})) { |
1184 |
root |
1.7 |
fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not |
1185 |
root |
1.37 |
|
1186 |
root |
1.35 |
my ($service, $host) = unpack_sockaddr $peer; |
1187 |
|
|
$accept->($fh, format_address $host, $service); |
1188 |
root |
1.7 |
} |
1189 |
root |
1.107 |
}; |
1190 |
elmex |
1.1 |
|
1191 |
root |
1.7 |
defined wantarray |
1192 |
|
|
? guard { %state = () } # clear fh and watcher, which breaks the circular dependency |
1193 |
|
|
: () |
1194 |
elmex |
1.1 |
} |
1195 |
|
|
|
1196 |
root |
1.125 |
=item tcp_nodelay $fh, $enable |
1197 |
|
|
|
1198 |
|
|
Enables (or disables) the C<TCP_NODELAY> socket option (also known as |
1199 |
|
|
Nagle's algorithm). Returns false on error, true otherwise. |
1200 |
|
|
|
1201 |
|
|
=cut |
1202 |
|
|
|
1203 |
|
|
sub tcp_nodelay($$) { |
1204 |
|
|
my $onoff = int ! ! $_[1]; |
1205 |
|
|
|
1206 |
|
|
setsockopt $_[0], Socket::IPPROTO_TCP (), Socket::TCP_NODELAY (), $onoff |
1207 |
|
|
} |
1208 |
|
|
|
1209 |
|
|
=item tcp_congestion $fh, $algorithm |
1210 |
|
|
|
1211 |
root |
1.126 |
Sets the tcp congestion avoidance algorithm (via the C<TCP_CONGESTION> |
1212 |
|
|
socket option). The default is OS-specific, but is usually |
1213 |
|
|
C<reno>. Typical other available choices include C<cubic>, C<lp>, C<bic>, |
1214 |
|
|
C<highspeed>, C<htcp>, C<hybla>, C<illinois>, C<scalable>, C<vegas>, |
1215 |
|
|
C<veno>, C<westwood> and C<yeah>. |
1216 |
root |
1.125 |
|
1217 |
|
|
=cut |
1218 |
|
|
|
1219 |
|
|
sub tcp_congestion($$) { |
1220 |
root |
1.127 |
defined TCP_CONGESTION |
1221 |
|
|
? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]" |
1222 |
root |
1.125 |
: undef |
1223 |
|
|
} |
1224 |
|
|
|
1225 |
root |
1.7 |
1; |
1226 |
|
|
|
1227 |
elmex |
1.1 |
=back |
1228 |
|
|
|
1229 |
root |
1.38 |
=head1 SECURITY CONSIDERATIONS |
1230 |
|
|
|
1231 |
|
|
This module is quite powerful, with with power comes the ability to abuse |
1232 |
|
|
as well: If you accept "hostnames" and ports from untrusted sources, |
1233 |
|
|
then note that this can be abused to delete files (host=C<unix/>). This |
1234 |
|
|
is not really a problem with this module, however, as blindly accepting |
1235 |
|
|
any address and protocol and trying to bind a server or connect to it is |
1236 |
|
|
harmful in general. |
1237 |
|
|
|
1238 |
elmex |
1.1 |
=head1 AUTHOR |
1239 |
|
|
|
1240 |
root |
1.7 |
Marc Lehmann <schmorp@schmorp.de> |
1241 |
|
|
http://home.schmorp.de/ |
1242 |
elmex |
1.1 |
|
1243 |
|
|
=cut |
1244 |
|
|
|