1 |
root |
1.7 |
=head1 NAME |
2 |
elmex |
1.1 |
|
3 |
root |
1.7 |
AnyEvent::Socket - useful IPv4 and IPv6 stuff. |
4 |
elmex |
1.1 |
|
5 |
root |
1.7 |
=head1 SYNOPSIS |
6 |
elmex |
1.1 |
|
7 |
root |
1.7 |
use AnyEvent::Socket; |
8 |
elmex |
1.1 |
|
9 |
root |
1.18 |
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 |
root |
1.19 |
# 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 |
|
|
|
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 |
no warnings; |
39 |
|
|
use strict; |
40 |
elmex |
1.1 |
|
41 |
root |
1.7 |
use Carp (); |
42 |
|
|
use Errno (); |
43 |
|
|
use Socket (); |
44 |
elmex |
1.1 |
|
45 |
root |
1.7 |
use AnyEvent (); |
46 |
root |
1.21 |
use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); |
47 |
root |
1.17 |
use AnyEvent::DNS (); |
48 |
elmex |
1.1 |
|
49 |
root |
1.7 |
use base 'Exporter'; |
50 |
elmex |
1.2 |
|
51 |
root |
1.13 |
our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect); |
52 |
elmex |
1.2 |
|
53 |
root |
1.7 |
our $VERSION = '1.0'; |
54 |
elmex |
1.1 |
|
55 |
root |
1.9 |
=item $ipn = parse_ipv4 $dotted_quad |
56 |
|
|
|
57 |
|
|
Tries to parse the given dotted quad IPv4 address and return it in |
58 |
|
|
octet form (or undef when it isn't in a parsable format). Supports all |
59 |
|
|
forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>, |
60 |
|
|
C<0x12345678> or C<0377.0377.0377.0377>). |
61 |
|
|
|
62 |
|
|
=cut |
63 |
|
|
|
64 |
|
|
sub parse_ipv4($) { |
65 |
|
|
$_[0] =~ /^ (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) |
66 |
|
|
(?:\. (?: 0x[0-9a-fA-F]+ | 0[0-7]* | [1-9][0-9]* ) ){0,3}$/x |
67 |
|
|
or return undef; |
68 |
|
|
|
69 |
|
|
@_ = map /^0/ ? oct : $_, split /\./, $_[0]; |
70 |
|
|
|
71 |
|
|
# check leading parts against range |
72 |
|
|
return undef if grep $_ >= 256, @_[0 .. @_ - 2]; |
73 |
|
|
|
74 |
|
|
# check trailing part against range |
75 |
|
|
return undef if $_[-1] >= 1 << (8 * (4 - $#_)); |
76 |
|
|
|
77 |
|
|
pack "N", (pop) |
78 |
|
|
+ ($_[0] << 24) |
79 |
|
|
+ ($_[1] << 16) |
80 |
|
|
+ ($_[2] << 8); |
81 |
|
|
} |
82 |
|
|
|
83 |
root |
1.14 |
=item $ipn = parse_ipv6 $textual_ipv6_address |
84 |
root |
1.9 |
|
85 |
|
|
Tries to parse the given IPv6 address and return it in |
86 |
|
|
octet form (or undef when it isn't in a parsable format). |
87 |
|
|
|
88 |
|
|
Should support all forms specified by RFC 2373 (and additionally all IPv4 |
89 |
root |
1.12 |
forms supported by parse_ipv4). |
90 |
|
|
|
91 |
|
|
This function works similarly to C<inet_pton AF_INET6, ...>. |
92 |
root |
1.9 |
|
93 |
|
|
=cut |
94 |
|
|
|
95 |
|
|
sub parse_ipv6($) { |
96 |
|
|
# quick test to avoid longer processing |
97 |
|
|
my $n = $_[0] =~ y/://; |
98 |
|
|
return undef if $n < 2 || $n > 8; |
99 |
|
|
|
100 |
|
|
my ($h, $t) = split /::/, $_[0], 2; |
101 |
|
|
|
102 |
root |
1.11 |
unless (defined $t) { |
103 |
root |
1.9 |
($h, $t) = (undef, $h); |
104 |
|
|
} |
105 |
|
|
|
106 |
|
|
my @h = split /:/, $h; |
107 |
|
|
my @t = split /:/, $t; |
108 |
|
|
|
109 |
root |
1.14 |
# check for ipv4 tail |
110 |
root |
1.9 |
if (@t && $t[-1]=~ /\./) { |
111 |
|
|
return undef if $n > 6; |
112 |
|
|
|
113 |
|
|
my $ipn = parse_ipv4 pop @t |
114 |
|
|
or return undef; |
115 |
|
|
|
116 |
|
|
push @t, map +(sprintf "%x", $_), unpack "nn", $ipn; |
117 |
|
|
} |
118 |
|
|
|
119 |
|
|
# no :: then we need to have exactly 8 components |
120 |
root |
1.11 |
return undef unless @h + @t == 8 || $_[0] =~ /::/; |
121 |
root |
1.9 |
|
122 |
|
|
# now check all parts for validity |
123 |
|
|
return undef if grep !/^[0-9a-fA-F]{1,4}$/, @h, @t; |
124 |
|
|
|
125 |
|
|
# now pad... |
126 |
|
|
push @h, 0 while @h + @t < 8; |
127 |
|
|
|
128 |
|
|
# and done |
129 |
|
|
pack "n*", map hex, @h, @t |
130 |
root |
1.7 |
} |
131 |
elmex |
1.1 |
|
132 |
root |
1.11 |
=item $ipn = parse_ip $text |
133 |
|
|
|
134 |
|
|
Combines C<parse_ipv4> and C<parse_ipv6> in one function. |
135 |
|
|
|
136 |
|
|
=cut |
137 |
|
|
|
138 |
|
|
sub parse_ip($) { |
139 |
|
|
&parse_ipv4 || &parse_ipv6 |
140 |
|
|
} |
141 |
|
|
|
142 |
|
|
=item $text = format_ip $ipn |
143 |
|
|
|
144 |
|
|
Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) |
145 |
|
|
and converts it into textual form. |
146 |
|
|
|
147 |
root |
1.12 |
This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, |
148 |
|
|
except it automatically detects the address type. |
149 |
|
|
|
150 |
root |
1.11 |
=cut |
151 |
|
|
|
152 |
|
|
sub format_ip; |
153 |
|
|
sub format_ip($) { |
154 |
|
|
if (4 == length $_[0]) { |
155 |
|
|
return join ".", unpack "C4", $_[0] |
156 |
|
|
} elsif (16 == length $_[0]) { |
157 |
|
|
if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { |
158 |
|
|
# v4mapped |
159 |
|
|
return "::ffff:" . format_ip substr $_[0], 12; |
160 |
|
|
} else { |
161 |
|
|
my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; |
162 |
|
|
|
163 |
root |
1.21 |
$ip =~ s/^0:(?:0:)*(0$)?/::/ |
164 |
root |
1.11 |
or $ip =~ s/(:0)+$/::/ |
165 |
|
|
or $ip =~ s/(:0)+/:/; |
166 |
|
|
return $ip |
167 |
|
|
} |
168 |
|
|
} else { |
169 |
|
|
return undef |
170 |
|
|
} |
171 |
|
|
} |
172 |
|
|
|
173 |
root |
1.7 |
=item inet_aton $name_or_address, $cb->(@addresses) |
174 |
elmex |
1.1 |
|
175 |
root |
1.7 |
Works similarly to its Socket counterpart, except that it uses a |
176 |
|
|
callback. Also, if a host has only an IPv6 address, this might be passed |
177 |
|
|
to the callback instead (use the length to detect this - 4 for IPv4, 16 |
178 |
|
|
for IPv6). |
179 |
elmex |
1.2 |
|
180 |
root |
1.7 |
Unlike the L<Socket> function of the same name, you can get multiple IPv4 |
181 |
|
|
and IPv6 addresses as result. |
182 |
elmex |
1.2 |
|
183 |
root |
1.7 |
=cut |
184 |
elmex |
1.2 |
|
185 |
root |
1.7 |
sub inet_aton { |
186 |
|
|
my ($name, $cb) = @_; |
187 |
elmex |
1.2 |
|
188 |
root |
1.9 |
if (my $ipn = &parse_ipv4) { |
189 |
|
|
$cb->($ipn); |
190 |
|
|
} elsif (my $ipn = &parse_ipv6) { |
191 |
|
|
$cb->($ipn); |
192 |
root |
1.7 |
} elsif ($name eq "localhost") { # rfc2606 et al. |
193 |
root |
1.9 |
$cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1); |
194 |
root |
1.7 |
} else { |
195 |
|
|
require AnyEvent::DNS; |
196 |
elmex |
1.2 |
|
197 |
root |
1.7 |
# simple, bad suboptimal algorithm |
198 |
|
|
AnyEvent::DNS::a ($name, sub { |
199 |
|
|
if (@_) { |
200 |
root |
1.9 |
$cb->(map +(parse_ipv4 $_), @_); |
201 |
root |
1.7 |
} else { |
202 |
root |
1.8 |
$cb->(); |
203 |
|
|
#AnyEvent::DNS::aaaa ($name, $cb); need inet_pton |
204 |
root |
1.7 |
} |
205 |
|
|
}); |
206 |
|
|
} |
207 |
|
|
} |
208 |
elmex |
1.2 |
|
209 |
root |
1.15 |
=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host |
210 |
|
|
|
211 |
root |
1.17 |
Pack the given port/host combination into a binary sockaddr structure. Handles |
212 |
root |
1.15 |
both IPv4 and IPv6 host addresses. |
213 |
|
|
|
214 |
|
|
=cut |
215 |
|
|
|
216 |
|
|
sub pack_sockaddr($$) { |
217 |
|
|
if (4 == length $_[1]) { |
218 |
|
|
Socket::pack_sockaddr_in $_[0], $_[1] |
219 |
|
|
} elsif (16 == length $_[1]) { |
220 |
root |
1.16 |
pack "SnL a16 L", |
221 |
root |
1.21 |
AF_INET6, |
222 |
root |
1.15 |
$_[0], # port |
223 |
|
|
0, # flowinfo |
224 |
|
|
$_[1], # addr |
225 |
|
|
0 # scope id |
226 |
|
|
} else { |
227 |
|
|
Carp::croak "pack_sockaddr: invalid host"; |
228 |
|
|
} |
229 |
|
|
} |
230 |
|
|
|
231 |
|
|
=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa |
232 |
|
|
|
233 |
|
|
Unpack the given binary sockaddr structure (as used by bind, getpeername |
234 |
|
|
etc.) into a C<$port, $host> combination. |
235 |
|
|
|
236 |
|
|
Handles both IPv4 and IPv6 sockaddr structures. |
237 |
|
|
|
238 |
|
|
=cut |
239 |
|
|
|
240 |
|
|
sub unpack_sockaddr($) { |
241 |
|
|
my $af = unpack "S", $_[0]; |
242 |
|
|
|
243 |
root |
1.21 |
if ($af == Socket::AF_INET) { |
244 |
root |
1.15 |
Socket::unpack_sockaddr_in $_[0] |
245 |
root |
1.21 |
} elsif ($af == AF_INET6) { |
246 |
|
|
unpack "x2 n x4 a16", $_[0] |
247 |
root |
1.15 |
} else { |
248 |
|
|
Carp::croak "unpack_sockaddr: unsupported protocol family $af"; |
249 |
|
|
} |
250 |
|
|
} |
251 |
|
|
|
252 |
root |
1.7 |
sub _tcp_port($) { |
253 |
|
|
$_[0] =~ /^(\d*)$/ and return $1*1; |
254 |
elmex |
1.2 |
|
255 |
root |
1.7 |
(getservbyname $_[0], "tcp")[2] |
256 |
|
|
or Carp::croak "$_[0]: service unknown" |
257 |
|
|
} |
258 |
elmex |
1.2 |
|
259 |
root |
1.15 |
=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] |
260 |
elmex |
1.1 |
|
261 |
root |
1.15 |
This is a convenience function that creates a TCP socket and makes a 100% |
262 |
root |
1.7 |
non-blocking connect to the given C<$host> (which can be a hostname or a |
263 |
root |
1.15 |
textual IP address) and C<$service> (which can be a numeric port number or |
264 |
|
|
a service name, or a C<servicename=portnumber> string). |
265 |
root |
1.7 |
|
266 |
root |
1.8 |
If both C<$host> and C<$port> are names, then this function will use SRV |
267 |
root |
1.15 |
records to locate the real target(s). |
268 |
root |
1.8 |
|
269 |
root |
1.15 |
In either case, it will create a list of target hosts (e.g. for multihomed |
270 |
root |
1.17 |
hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to |
271 |
root |
1.15 |
each in turn. |
272 |
root |
1.7 |
|
273 |
|
|
If the connect is successful, then the C<$connect_cb> will be invoked with |
274 |
root |
1.17 |
the socket file handle (in non-blocking mode) as first and the peer host |
275 |
root |
1.7 |
(as a textual IP address) and peer port as second and third arguments, |
276 |
root |
1.15 |
respectively. The fourth argument is a code reference that you can call |
277 |
|
|
if, for some reason, you don't like this connection, which will cause |
278 |
|
|
C<tcp_connect> to try the next one (or call your callback without any |
279 |
|
|
arguments if there are no more connections). In most cases, you can simply |
280 |
|
|
ignore this argument. |
281 |
|
|
|
282 |
|
|
$cb->($filehandle, $host, $port, $retry) |
283 |
root |
1.7 |
|
284 |
|
|
If the connect is unsuccessful, then the C<$connect_cb> will be invoked |
285 |
|
|
without any arguments and C<$!> will be set appropriately (with C<ENXIO> |
286 |
root |
1.17 |
indicating a DNS resolution failure). |
287 |
root |
1.7 |
|
288 |
root |
1.17 |
The file handle is perfect for being plugged into L<AnyEvent::Handle>, but |
289 |
|
|
can be used as a normal perl file handle as well. |
290 |
root |
1.7 |
|
291 |
root |
1.15 |
Unless called in void context, C<tcp_connect> returns a guard object that |
292 |
|
|
will automatically abort connecting when it gets destroyed (it does not do |
293 |
|
|
anything to the socket after the connect was successful). |
294 |
|
|
|
295 |
root |
1.7 |
Sometimes you need to "prepare" the socket before connecting, for example, |
296 |
|
|
to C<bind> it to some port, or you want a specific connect timeout that |
297 |
|
|
is lower than your kernel's default timeout. In this case you can specify |
298 |
|
|
a second callback, C<$prepare_cb>. It will be called with the file handle |
299 |
|
|
in not-yet-connected state as only argument and must return the connection |
300 |
|
|
timeout value (or C<0>, C<undef> or the empty list to indicate the default |
301 |
|
|
timeout is to be used). |
302 |
|
|
|
303 |
root |
1.17 |
Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP |
304 |
root |
1.7 |
socket (although only IPv4 is currently supported by this module). |
305 |
|
|
|
306 |
|
|
Simple Example: connect to localhost on port 22. |
307 |
|
|
|
308 |
root |
1.8 |
tcp_connect localhost => 22, sub { |
309 |
root |
1.7 |
my $fh = shift |
310 |
|
|
or die "unable to connect: $!"; |
311 |
|
|
# do something |
312 |
|
|
}; |
313 |
|
|
|
314 |
|
|
Complex Example: connect to www.google.com on port 80 and make a simple |
315 |
|
|
GET request without much error handling. Also limit the connection timeout |
316 |
|
|
to 15 seconds. |
317 |
|
|
|
318 |
|
|
tcp_connect "www.google.com", "http", |
319 |
|
|
sub { |
320 |
|
|
my ($fh) = @_ |
321 |
|
|
or die "unable to connect: $!"; |
322 |
|
|
|
323 |
|
|
my $handle; # avoid direct assignment so on_eof has it in scope. |
324 |
|
|
$handle = new AnyEvent::Handle |
325 |
|
|
fh => $fh, |
326 |
|
|
on_eof => sub { |
327 |
|
|
undef $handle; # keep it alive till eof |
328 |
|
|
warn "done.\n"; |
329 |
|
|
}; |
330 |
|
|
|
331 |
|
|
$handle->push_write ("GET / HTTP/1.0\015\012\015\012"); |
332 |
|
|
|
333 |
|
|
$handle->push_read_line ("\015\012\015\012", sub { |
334 |
|
|
my ($handle, $line) = @_; |
335 |
|
|
|
336 |
|
|
# print response header |
337 |
|
|
print "HEADER\n$line\n\nBODY\n"; |
338 |
|
|
|
339 |
|
|
$handle->on_read (sub { |
340 |
|
|
# print response body |
341 |
|
|
print $_[0]->rbuf; |
342 |
|
|
$_[0]->rbuf = ""; |
343 |
|
|
}); |
344 |
|
|
}); |
345 |
|
|
}, sub { |
346 |
|
|
my ($fh) = @_; |
347 |
|
|
# could call $fh->bind etc. here |
348 |
elmex |
1.2 |
|
349 |
root |
1.7 |
15 |
350 |
|
|
}; |
351 |
elmex |
1.2 |
|
352 |
root |
1.7 |
=cut |
353 |
elmex |
1.2 |
|
354 |
root |
1.7 |
sub tcp_connect($$$;$) { |
355 |
|
|
my ($host, $port, $connect, $prepare) = @_; |
356 |
elmex |
1.2 |
|
357 |
root |
1.7 |
# see http://cr.yp.to/docs/connect.html for some background |
358 |
elmex |
1.2 |
|
359 |
root |
1.7 |
my %state = ( fh => undef ); |
360 |
elmex |
1.2 |
|
361 |
root |
1.7 |
# name resolution |
362 |
root |
1.15 |
AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { |
363 |
|
|
my @target = @_; |
364 |
root |
1.7 |
|
365 |
root |
1.15 |
$state{next} = sub { |
366 |
|
|
return unless exists $state{fh}; |
367 |
root |
1.7 |
|
368 |
root |
1.15 |
my $target = shift @target |
369 |
|
|
or do { |
370 |
|
|
%state = (); |
371 |
|
|
return $connect->(); |
372 |
|
|
}; |
373 |
root |
1.7 |
|
374 |
root |
1.15 |
my ($domain, $type, $proto, $sockaddr) = @$target; |
375 |
root |
1.7 |
|
376 |
root |
1.15 |
# socket creation |
377 |
|
|
socket $state{fh}, $domain, $type, $proto |
378 |
|
|
or return $state{next}(); |
379 |
|
|
|
380 |
|
|
fh_nonblocking $state{fh}, 1; |
381 |
|
|
|
382 |
|
|
# prepare and optional timeout |
383 |
|
|
if ($prepare) { |
384 |
|
|
my $timeout = $prepare->($state{fh}); |
385 |
|
|
|
386 |
|
|
$state{to} = AnyEvent->timer (after => $timeout, cb => sub { |
387 |
|
|
$! = &Errno::ETIMEDOUT; |
388 |
|
|
$state{next}(); |
389 |
|
|
}) if $timeout; |
390 |
|
|
} |
391 |
root |
1.7 |
|
392 |
root |
1.15 |
# called when the connect was successful, which, |
393 |
|
|
# in theory, could be the case immediately (but never is in practise) |
394 |
|
|
my $connected = sub { |
395 |
|
|
delete $state{ww}; |
396 |
|
|
delete $state{to}; |
397 |
|
|
|
398 |
|
|
# we are connected, or maybe there was an error |
399 |
|
|
if (my $sin = getpeername $state{fh}) { |
400 |
|
|
my ($port, $host) = unpack_sockaddr $sin; |
401 |
|
|
|
402 |
|
|
my $guard = guard { |
403 |
|
|
%state = (); |
404 |
|
|
}; |
405 |
|
|
|
406 |
|
|
$connect->($state{fh}, format_ip $host, $port, sub { |
407 |
|
|
$guard->cancel; |
408 |
|
|
$state{next}(); |
409 |
|
|
}); |
410 |
|
|
} else { |
411 |
|
|
# dummy read to fetch real error code |
412 |
|
|
sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN; |
413 |
|
|
$state{next}(); |
414 |
|
|
} |
415 |
|
|
}; |
416 |
elmex |
1.1 |
|
417 |
root |
1.15 |
# now connect |
418 |
|
|
if (connect $state{fh}, $sockaddr) { |
419 |
|
|
$connected->(); |
420 |
|
|
} elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX |
421 |
|
|
$state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected); |
422 |
root |
1.7 |
} else { |
423 |
root |
1.15 |
%state = (); |
424 |
root |
1.7 |
$connect->(); |
425 |
|
|
} |
426 |
|
|
}; |
427 |
elmex |
1.1 |
|
428 |
root |
1.15 |
$! = &Errno::ENXIO; |
429 |
|
|
$state{next}(); |
430 |
root |
1.7 |
}; |
431 |
elmex |
1.1 |
|
432 |
root |
1.15 |
defined wantarray && guard { %state = () } |
433 |
elmex |
1.1 |
} |
434 |
|
|
|
435 |
root |
1.7 |
=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] |
436 |
|
|
|
437 |
root |
1.21 |
Create and bind a TCP socket to the given host, and port, set the |
438 |
|
|
SO_REUSEADDR flag and call C<listen>. |
439 |
elmex |
1.1 |
|
440 |
root |
1.21 |
C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it |
441 |
|
|
binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the |
442 |
|
|
preferred protocol). |
443 |
|
|
|
444 |
|
|
To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6 |
445 |
|
|
wildcard address, use C<::>. |
446 |
|
|
|
447 |
|
|
The port is specified by C<$port>, which must be either a service name or |
448 |
|
|
a numeric port number (or C<0> or C<undef>, in which case an ephemeral |
449 |
|
|
port will be used). |
450 |
|
|
|
451 |
|
|
For each new connection that could be C<accept>ed, call the C<< |
452 |
|
|
$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking |
453 |
|
|
mode) as first and the peer host and port as second and third arguments |
454 |
|
|
(see C<tcp_connect> for details). |
455 |
|
|
|
456 |
|
|
Croaks on any errors it can detect before the listen. |
457 |
elmex |
1.1 |
|
458 |
root |
1.7 |
If called in non-void context, then this function returns a guard object |
459 |
root |
1.17 |
whose lifetime it tied to the TCP server: If the object gets destroyed, |
460 |
root |
1.7 |
the server will be stopped (but existing accepted connections will |
461 |
|
|
continue). |
462 |
elmex |
1.1 |
|
463 |
root |
1.7 |
If you need more control over the listening socket, you can provide a |
464 |
root |
1.21 |
C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the |
465 |
|
|
C<listen ()> call, with the listen file handle as first argument, and IP |
466 |
|
|
address and port number of the local socket endpoint as second and third |
467 |
|
|
arguments. |
468 |
elmex |
1.2 |
|
469 |
root |
1.7 |
It should return the length of the listen queue (or C<0> for the default). |
470 |
elmex |
1.2 |
|
471 |
root |
1.17 |
Example: bind on TCP port 8888 on the local machine and tell each client |
472 |
root |
1.7 |
to go away. |
473 |
elmex |
1.2 |
|
474 |
root |
1.7 |
tcp_server undef, 8888, sub { |
475 |
|
|
my ($fh, $host, $port) = @_; |
476 |
elmex |
1.1 |
|
477 |
root |
1.7 |
syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; |
478 |
|
|
}; |
479 |
elmex |
1.1 |
|
480 |
root |
1.7 |
=cut |
481 |
elmex |
1.1 |
|
482 |
root |
1.7 |
sub tcp_server($$$;$) { |
483 |
|
|
my ($host, $port, $accept, $prepare) = @_; |
484 |
elmex |
1.1 |
|
485 |
root |
1.22 |
$host = $AnyEvent::PROTOCOL{ipv4} > $AnyEvent::PROTOCOL{ipv6} && AF_INET6 |
486 |
|
|
? "::" : "0" |
487 |
root |
1.21 |
unless defined $host; |
488 |
|
|
|
489 |
|
|
my $ipn = parse_ip $host |
490 |
|
|
or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; |
491 |
|
|
|
492 |
|
|
my $domain = 4 == length $ipn ? Socket::AF_INET : AF_INET6; |
493 |
|
|
|
494 |
root |
1.7 |
my %state; |
495 |
elmex |
1.1 |
|
496 |
root |
1.21 |
socket $state{fh}, $domain, &Socket::SOCK_STREAM, 0 |
497 |
root |
1.7 |
or Carp::croak "socket: $!"; |
498 |
elmex |
1.1 |
|
499 |
root |
1.7 |
setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1 |
500 |
|
|
or Carp::croak "so_reuseaddr: $!"; |
501 |
elmex |
1.1 |
|
502 |
root |
1.21 |
bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn |
503 |
root |
1.7 |
or Carp::croak "bind: $!"; |
504 |
elmex |
1.1 |
|
505 |
root |
1.7 |
fh_nonblocking $state{fh}, 1; |
506 |
elmex |
1.1 |
|
507 |
root |
1.21 |
my $len; |
508 |
|
|
|
509 |
|
|
if ($prepare) { |
510 |
|
|
my ($port, $host) = unpack_sockaddr getsockname $state{fh}; |
511 |
|
|
$len = $prepare && $prepare->($state{fh}, format_ip $host, $port); |
512 |
|
|
} |
513 |
|
|
|
514 |
|
|
$len ||= 128; |
515 |
elmex |
1.1 |
|
516 |
root |
1.7 |
listen $state{fh}, $len |
517 |
|
|
or Carp::croak "listen: $!"; |
518 |
elmex |
1.1 |
|
519 |
root |
1.7 |
$state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { |
520 |
|
|
# this closure keeps $state alive |
521 |
|
|
while (my $peer = accept my $fh, $state{fh}) { |
522 |
|
|
fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not |
523 |
root |
1.21 |
my ($port, $host) = unpack_sockaddr $peer; |
524 |
|
|
$accept->($fh, format_ip $host, $port); |
525 |
root |
1.7 |
} |
526 |
|
|
}); |
527 |
elmex |
1.1 |
|
528 |
root |
1.7 |
defined wantarray |
529 |
|
|
? guard { %state = () } # clear fh and watcher, which breaks the circular dependency |
530 |
|
|
: () |
531 |
elmex |
1.1 |
} |
532 |
|
|
|
533 |
root |
1.7 |
1; |
534 |
|
|
|
535 |
elmex |
1.1 |
=back |
536 |
|
|
|
537 |
|
|
=head1 AUTHOR |
538 |
|
|
|
539 |
root |
1.7 |
Marc Lehmann <schmorp@schmorp.de> |
540 |
|
|
http://home.schmorp.de/ |
541 |
elmex |
1.1 |
|
542 |
|
|
=cut |
543 |
|
|
|