ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent/lib/AnyEvent/Socket.pm
(Generate patch)

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.15 by root, Sat May 24 01:15:19 2008 UTC vs.
Revision 1.28 by root, Mon May 26 05:09:53 2008 UTC

… …
3AnyEvent::Socket - useful IPv4 and IPv6 stuff. 3AnyEvent::Socket - useful IPv4 and IPv6 stuff.
4 4
5=head1 SYNOPSIS 5=head1 SYNOPSIS
6 6
7 use AnyEvent::Socket; 7 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 };
8 22
9=head1 DESCRIPTION 23=head1 DESCRIPTION
10 24
11This module implements various utility functions for handling internet 25This module implements various utility functions for handling internet
12protocol addresses and sockets, in an as transparent and simple way as 26protocol addresses and sockets, in an as transparent and simple way as
… …
24no warnings; 38no warnings;
25use strict; 39use strict;
26 40
27use Carp (); 41use Carp ();
28use Errno (); 42use Errno ();
29use Socket (); 43use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
30 44
31use AnyEvent (); 45use AnyEvent qw(WIN32);
32use AnyEvent::Util qw(guard fh_nonblocking); 46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47use AnyEvent::DNS ();
33 48
34use base 'Exporter'; 49use base 'Exporter';
35
36BEGIN {
37 *socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
38}
39
40BEGIN {
41 my $af_inet6 = eval { &Socket::AF_INET6 };
42 eval "sub AF_INET6() { $af_inet6 }"; die if $@;
43
44 delete $AnyEvent::PROTOCOL{ipv6} unless $af_inet6;
45}
46 50
47our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect); 51our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);
48 52
49our $VERSION = '1.0'; 53our $VERSION = '1.0';
50 54
… …
80 84
81Tries to parse the given IPv6 address and return it in 85Tries to parse the given IPv6 address and return it in
82octet form (or undef when it isn't in a parsable format). 86octet form (or undef when it isn't in a parsable format).
83 87
84Should support all forms specified by RFC 2373 (and additionally all IPv4 88Should support all forms specified by RFC 2373 (and additionally all IPv4
85forms supported by parse_ipv4). 89forms supported by parse_ipv4). Note that scope-id's are not supported
90(and will not parse).
86 91
87This function works similarly to C<inet_pton AF_INET6, ...>. 92This function works similarly to C<inet_pton AF_INET6, ...>.
88 93
89=cut 94=cut
90 95
… …
154 # v4mapped 159 # v4mapped
155 return "::ffff:" . format_ip substr $_[0], 12; 160 return "::ffff:" . format_ip substr $_[0], 12;
156 } else { 161 } else {
157 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 162 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
158 163
159 $ip =~ s/^0:(?:0:)*/::/ 164 $ip =~ s/^0:(?:0:)*(0$)?/::/
160 or $ip =~ s/(:0)+$/::/ 165 or $ip =~ s/(:0)+$/::/
161 or $ip =~ s/(:0)+/:/; 166 or $ip =~ s/(:0)+/:/;
162 return $ip 167 return $ip
163 } 168 }
164 } else { 169 } else {
… …
202 } 207 }
203} 208}
204 209
205=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host 210=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
206 211
207Pack the given port/hst combination into a binary sockaddr structure. Handles 212Pack the given port/host combination into a binary sockaddr structure. Handles
208both IPv4 and IPv6 host addresses. 213both IPv4 and IPv6 host addresses.
209 214
210=cut 215=cut
211 216
212sub pack_sockaddr($$) { 217sub pack_sockaddr($$) {
213 if (4 == length $_[1]) { 218 if (4 == length $_[1]) {
214 Socket::pack_sockaddr_in $_[0], $_[1] 219 Socket::pack_sockaddr_in $_[0], $_[1]
215 } elsif (16 == length $_[1]) { 220 } elsif (16 == length $_[1]) {
216 pack "SSL a16 L", 221 pack "SnL a16 L",
217 Socket::AF_INET6, 222 AF_INET6,
218 $_[0], # port 223 $_[0], # port
219 0, # flowinfo 224 0, # flowinfo
220 $_[1], # addr 225 $_[1], # addr
221 0 # scope id 226 0 # scope id
222 } else { 227 } else {
… …
234=cut 239=cut
235 240
236sub unpack_sockaddr($) { 241sub unpack_sockaddr($) {
237 my $af = unpack "S", $_[0]; 242 my $af = unpack "S", $_[0];
238 243
239 if ($af == &Socket::AF_INET) { 244 if ($af == AF_INET) {
240 Socket::unpack_sockaddr_in $_[0] 245 Socket::unpack_sockaddr_in $_[0]
241 } elsif ($af == AF_INET6) { 246 } elsif ($af == AF_INET6) {
242 (unpack "SSL a16 L")[1, 3] 247 unpack "x2 n x4 a16", $_[0]
243 } else { 248 } else {
244 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 249 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
245 } 250 }
246} 251}
247 252
… …
261 266
262If both C<$host> and C<$port> are names, then this function will use SRV 267If both C<$host> and C<$port> are names, then this function will use SRV
263records to locate the real target(s). 268records to locate the real target(s).
264 269
265In either case, it will create a list of target hosts (e.g. for multihomed 270In either case, it will create a list of target hosts (e.g. for multihomed
266hosts or hosts with both IPv4 and IPV6 addrsesses) and try to connetc to 271hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
267each in turn. 272each in turn.
268 273
269If the connect is successful, then the C<$connect_cb> will be invoked with 274If the connect is successful, then the C<$connect_cb> will be invoked with
270the socket filehandle (in non-blocking mode) as first and the peer host 275the socket file handle (in non-blocking mode) as first and the peer host
271(as a textual IP address) and peer port as second and third arguments, 276(as a textual IP address) and peer port as second and third arguments,
272respectively. The fourth argument is a code reference that you can call 277respectively. The fourth argument is a code reference that you can call
273if, for some reason, you don't like this connection, which will cause 278if, for some reason, you don't like this connection, which will cause
274C<tcp_connect> to try the next one (or call your callback without any 279C<tcp_connect> to try the next one (or call your callback without any
275arguments if there are no more connections). In most cases, you can simply 280arguments if there are no more connections). In most cases, you can simply
… …
277 282
278 $cb->($filehandle, $host, $port, $retry) 283 $cb->($filehandle, $host, $port, $retry)
279 284
280If the connect is unsuccessful, then the C<$connect_cb> will be invoked 285If the connect is unsuccessful, then the C<$connect_cb> will be invoked
281without any arguments and C<$!> will be set appropriately (with C<ENXIO> 286without any arguments and C<$!> will be set appropriately (with C<ENXIO>
282indicating a dns resolution failure). 287indicating a DNS resolution failure).
283 288
284The filehandle is suitable to be plugged into L<AnyEvent::Handle>, but can 289The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
285be used as a normal perl file handle as well. 290can be used as a normal perl file handle as well.
286 291
287Unless called in void context, C<tcp_connect> returns a guard object that 292Unless called in void context, C<tcp_connect> returns a guard object that
288will automatically abort connecting when it gets destroyed (it does not do 293will automatically abort connecting when it gets destroyed (it does not do
289anything to the socket after the connect was successful). 294anything to the socket after the connect was successful).
290 295
… …
294a second callback, C<$prepare_cb>. It will be called with the file handle 299a second callback, C<$prepare_cb>. It will be called with the file handle
295in not-yet-connected state as only argument and must return the connection 300in not-yet-connected state as only argument and must return the connection
296timeout value (or C<0>, C<undef> or the empty list to indicate the default 301timeout value (or C<0>, C<undef> or the empty list to indicate the default
297timeout is to be used). 302timeout is to be used).
298 303
299Note that the socket could be either a IPv4 TCP socket or an IPv6 tcp 304Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
300socket (although only IPv4 is currently supported by this module). 305socket (although only IPv4 is currently supported by this module).
306
307Note to the poor Microsoft Windows users: Windows (of course) doesn't
308correctly signal connection errors, so unless your event library works
309around this, failed connections will simply hang. The only event libraries
310that handle this condition correctly are L<EV> and L<Glib>. Additionally,
311AnyEvent works around this bug with L<Event> and in its pure-perl
312backend. All other libraries cannot correctly handle this condition. To
313lessen the impact of this windows bug, a default timeout of 30 seconds
314will be imposed on windows. Cygwin is not affected.
301 315
302Simple Example: connect to localhost on port 22. 316Simple Example: connect to localhost on port 22.
303 317
304 tcp_connect localhost => 22, sub { 318 tcp_connect localhost => 22, sub {
305 my $fh = shift 319 my $fh = shift
… …
373 socket $state{fh}, $domain, $type, $proto 387 socket $state{fh}, $domain, $type, $proto
374 or return $state{next}(); 388 or return $state{next}();
375 389
376 fh_nonblocking $state{fh}, 1; 390 fh_nonblocking $state{fh}, 1;
377 391
378 # prepare and optional timeout
379 if ($prepare) {
380 my $timeout = $prepare->($state{fh}); 392 my $timeout = $prepare && $prepare->($state{fh});
381 393
394 $timeout ||= 30 if WIN32;
395
382 $state{to} = AnyEvent->timer (after => $timeout, cb => sub { 396 $state{to} = AnyEvent->timer (after => $timeout, cb => sub {
383 $! = &Errno::ETIMEDOUT; 397 $! = &Errno::ETIMEDOUT;
384 $state{next}(); 398 $state{next}();
385 }) if $timeout; 399 }) if $timeout;
386 }
387 400
388 # called when the connect was successful, which, 401 # called when the connect was successful, which,
389 # in theory, could be the case immediately (but never is in practise) 402 # in theory, could be the case immediately (but never is in practise)
390 my $connected = sub { 403 my $connected = sub {
391 delete $state{ww}; 404 delete $state{ww};
… …
428 defined wantarray && guard { %state = () } 441 defined wantarray && guard { %state = () }
429} 442}
430 443
431=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 444=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
432 445
433Create and bind a tcp socket to the given host (any IPv4 host if undef, 446Create and bind a TCP socket to the given host, and port, set the
434otherwise it must be an IPv4 or IPv6 address) and port (service name or
435numeric port number, or an ephemeral port if given as zero or undef), set
436the SO_REUSEADDR flag and call C<listen>. 447SO_REUSEADDR flag and call C<listen>.
437 448
449C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
450binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
451preferred protocol).
452
453To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
454wildcard address, use C<::>.
455
456The port is specified by C<$port>, which must be either a service name or
457a numeric port number (or C<0> or C<undef>, in which case an ephemeral
458port will be used).
459
438For each new connection that could be C<accept>ed, call the C<$accept_cb> 460For each new connection that could be C<accept>ed, call the C<<
439with the filehandle (in non-blocking mode) as first and the peer host and 461$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
440port as second and third arguments (see C<tcp_connect> for details). 462mode) as first and the peer host and port as second and third arguments
463(see C<tcp_connect> for details).
441 464
442Croaks on any errors. 465Croaks on any errors it can detect before the listen.
443 466
444If called in non-void context, then this function returns a guard object 467If called in non-void context, then this function returns a guard object
445whose lifetime it tied to the tcp server: If the object gets destroyed, 468whose lifetime it tied to the TCP server: If the object gets destroyed,
446the server will be stopped (but existing accepted connections will 469the server will be stopped (but existing accepted connections will
447continue). 470continue).
448 471
449If you need more control over the listening socket, you can provide a 472If you need more control over the listening socket, you can provide a
450C<$prepare_cb>, which is called just before the C<listen ()> call, with 473C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
451the listen file handle as first argument. 474C<listen ()> call, with the listen file handle as first argument, and IP
475address and port number of the local socket endpoint as second and third
476arguments.
452 477
453It should return the length of the listen queue (or C<0> for the default). 478It should return the length of the listen queue (or C<0> for the default).
454 479
455Example: bind on tcp port 8888 on the local machine and tell each client 480Example: bind on some TCP port on the local machine and tell each client
456to go away. 481to go away.
457 482
458 tcp_server undef, 8888, sub { 483 tcp_server undef, undef, sub {
459 my ($fh, $host, $port) = @_; 484 my ($fh, $host, $port) = @_;
460 485
461 syswrite $fh, "The internet is full, $host:$port. Go away!\015\012"; 486 syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
487 }, sub {
488 my ($fh, $thishost, $thisport) = @_;
489 warn "bound to $thishost, port $thisport\n";
462 }; 490 };
463 491
464=cut 492=cut
465 493
466sub tcp_server($$$;$) { 494sub tcp_server($$$;$) {
467 my ($host, $port, $accept, $prepare) = @_; 495 my ($host, $port, $accept, $prepare) = @_;
468 496
497 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
498 ? "::" : "0"
499 unless defined $host;
500
501 my $ipn = parse_ip $host
502 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address";
503
504 my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
505
469 my %state; 506 my %state;
470 507
471 socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0 508 socket $state{fh}, $domain, SOCK_STREAM, 0
472 or Carp::croak "socket: $!"; 509 or Carp::croak "socket: $!";
473 510
474 setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1 511 setsockopt $state{fh}, SOL_SOCKET, SO_REUSEADDR, 1
475 or Carp::croak "so_reuseaddr: $!"; 512 or Carp::croak "so_reuseaddr: $!";
476 513
477 bind $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, socket_inet_aton ($host || "0.0.0.0") 514 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
478 or Carp::croak "bind: $!"; 515 or Carp::croak "bind: $!";
479 516
480 fh_nonblocking $state{fh}, 1; 517 fh_nonblocking $state{fh}, 1;
481 518
482 my $len = ($prepare && $prepare->($state{fh})) || 128; 519 my $len;
520
521 if ($prepare) {
522 my ($port, $host) = unpack_sockaddr getsockname $state{fh};
523 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port);
524 }
525
526 $len ||= 128;
483 527
484 listen $state{fh}, $len 528 listen $state{fh}, $len
485 or Carp::croak "listen: $!"; 529 or Carp::croak "listen: $!";
486 530
487 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 531 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
488 # this closure keeps $state alive 532 # this closure keeps $state alive
489 while (my $peer = accept my $fh, $state{fh}) { 533 while (my $peer = accept my $fh, $state{fh}) {
490 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 534 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
491 my ($port, $host) = Socket::unpack_sockaddr_in $peer; 535 my ($port, $host) = unpack_sockaddr $peer;
492 $accept->($fh, (Socket::inet_ntoa $host), $port); 536 $accept->($fh, format_ip $host, $port);
493 } 537 }
494 }); 538 });
495 539
496 defined wantarray 540 defined wantarray
497 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 541 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines