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.11 by root, Fri May 23 20:09:56 2008 UTC vs.
Revision 1.22 by root, Sun May 25 03:03:51 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
… …
27use Carp (); 41use Carp ();
28use Errno (); 42use Errno ();
29use Socket (); 43use Socket ();
30 44
31use AnyEvent (); 45use AnyEvent ();
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 50
36BEGIN { 51our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect);
37 *socket_inet_aton = \&Socket::inet_aton; # take a copy, in case Coro::LWP overrides it
38}
39
40our @EXPORT = qw(inet_aton tcp_server tcp_connect);
41 52
42our $VERSION = '1.0'; 53our $VERSION = '1.0';
43 54
44=item $ipn = parse_ipv4 $dotted_quad 55=item $ipn = parse_ipv4 $dotted_quad
45 56
… …
67 + ($_[0] << 24) 78 + ($_[0] << 24)
68 + ($_[1] << 16) 79 + ($_[1] << 16)
69 + ($_[2] << 8); 80 + ($_[2] << 8);
70} 81}
71 82
72=item $ipn = parse_ipv4 $dotted_quad 83=item $ipn = parse_ipv6 $textual_ipv6_address
73 84
74Tries to parse the given IPv6 address and return it in 85Tries to parse the given IPv6 address and return it in
75octet form (or undef when it isn't in a parsable format). 86octet form (or undef when it isn't in a parsable format).
76 87
77Should support all forms specified by RFC 2373 (and additionally all IPv4 88Should support all forms specified by RFC 2373 (and additionally all IPv4
78formst supported by parse_ipv4). 89forms supported by parse_ipv4).
90
91This function works similarly to C<inet_pton AF_INET6, ...>.
79 92
80=cut 93=cut
81 94
82sub parse_ipv6($) { 95sub parse_ipv6($) {
83 # quick test to avoid longer processing 96 # quick test to avoid longer processing
… …
91 } 104 }
92 105
93 my @h = split /:/, $h; 106 my @h = split /:/, $h;
94 my @t = split /:/, $t; 107 my @t = split /:/, $t;
95 108
96 # check four ipv4 tail 109 # check for ipv4 tail
97 if (@t && $t[-1]=~ /\./) { 110 if (@t && $t[-1]=~ /\./) {
98 return undef if $n > 6; 111 return undef if $n > 6;
99 112
100 my $ipn = parse_ipv4 pop @t 113 my $ipn = parse_ipv4 pop @t
101 or return undef; 114 or return undef;
… …
128 141
129=item $text = format_ip $ipn 142=item $text = format_ip $ipn
130 143
131Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) 144Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets)
132and converts it into textual form. 145and converts it into textual form.
146
147This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
148except it automatically detects the address type.
133 149
134=cut 150=cut
135 151
136sub format_ip; 152sub format_ip;
137sub format_ip($) { 153sub format_ip($) {
… …
142 # v4mapped 158 # v4mapped
143 return "::ffff:" . format_ip substr $_[0], 12; 159 return "::ffff:" . format_ip substr $_[0], 12;
144 } else { 160 } else {
145 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 161 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
146 162
147 $ip =~ s/^0:(?:0:)*/::/ 163 $ip =~ s/^0:(?:0:)*(0$)?/::/
148 or $ip =~ s/(:0)+$/::/ 164 or $ip =~ s/(:0)+$/::/
149 or $ip =~ s/(:0)+/:/; 165 or $ip =~ s/(:0)+/:/;
150 return $ip 166 return $ip
151 } 167 }
152 } else { 168 } else {
… …
188 } 204 }
189 }); 205 });
190 } 206 }
191} 207}
192 208
209=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host
210
211Pack the given port/host combination into a binary sockaddr structure. Handles
212both IPv4 and IPv6 host addresses.
213
214=cut
215
216sub pack_sockaddr($$) {
217 if (4 == length $_[1]) {
218 Socket::pack_sockaddr_in $_[0], $_[1]
219 } elsif (16 == length $_[1]) {
220 pack "SnL a16 L",
221 AF_INET6,
222 $_[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
233Unpack the given binary sockaddr structure (as used by bind, getpeername
234etc.) into a C<$port, $host> combination.
235
236Handles both IPv4 and IPv6 sockaddr structures.
237
238=cut
239
240sub unpack_sockaddr($) {
241 my $af = unpack "S", $_[0];
242
243 if ($af == Socket::AF_INET) {
244 Socket::unpack_sockaddr_in $_[0]
245 } elsif ($af == AF_INET6) {
246 unpack "x2 n x4 a16", $_[0]
247 } else {
248 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
249 }
250}
251
193sub _tcp_port($) { 252sub _tcp_port($) {
194 $_[0] =~ /^(\d*)$/ and return $1*1; 253 $_[0] =~ /^(\d*)$/ and return $1*1;
195 254
196 (getservbyname $_[0], "tcp")[2] 255 (getservbyname $_[0], "tcp")[2]
197 or Carp::croak "$_[0]: service unknown" 256 or Carp::croak "$_[0]: service unknown"
198} 257}
199 258
200=item $guard = tcp_connect $host, $port, $connect_cb[, $prepare_cb] 259=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
201 260
202This is a convenience function that creates a tcp socket and makes a 100% 261This is a convenience function that creates a TCP socket and makes a 100%
203non-blocking connect to the given C<$host> (which can be a hostname or a 262non-blocking connect to the given C<$host> (which can be a hostname or a
204textual IP address) and C<$port> (which can be a numeric port number or a 263textual IP address) and C<$service> (which can be a numeric port number or
205service name). 264a service name, or a C<servicename=portnumber> string).
206 265
207If both C<$host> and C<$port> are names, then this function will use SRV 266If both C<$host> and C<$port> are names, then this function will use SRV
208records to locate the real target in a future version. 267records to locate the real target(s).
209 268
210Unless called in void context, it returns a guard object that will 269In either case, it will create a list of target hosts (e.g. for multihomed
211automatically abort connecting when it gets destroyed (it does not do 270hosts or hosts with both IPv4 and IPv6 addresses) and try to connect to
212anything to the socket after the connect was successful). 271each in turn.
213 272
214If the connect is successful, then the C<$connect_cb> will be invoked with 273If the connect is successful, then the C<$connect_cb> will be invoked with
215the socket filehandle (in non-blocking mode) as first and the peer host 274the socket file handle (in non-blocking mode) as first and the peer host
216(as a textual IP address) and peer port as second and third arguments, 275(as a textual IP address) and peer port as second and third arguments,
217respectively. 276respectively. The fourth argument is a code reference that you can call
277if, for some reason, you don't like this connection, which will cause
278C<tcp_connect> to try the next one (or call your callback without any
279arguments if there are no more connections). In most cases, you can simply
280ignore this argument.
281
282 $cb->($filehandle, $host, $port, $retry)
218 283
219If the connect is unsuccessful, then the C<$connect_cb> will be invoked 284If the connect is unsuccessful, then the C<$connect_cb> will be invoked
220without any arguments and C<$!> will be set appropriately (with C<ENXIO> 285without any arguments and C<$!> will be set appropriately (with C<ENXIO>
221indicating a dns resolution failure). 286indicating a DNS resolution failure).
222 287
223The filehandle is suitable to be plugged into L<AnyEvent::Handle>, but can 288The file handle is perfect for being plugged into L<AnyEvent::Handle>, but
224be used as a normal perl file handle as well. 289can be used as a normal perl file handle as well.
290
291Unless called in void context, C<tcp_connect> returns a guard object that
292will automatically abort connecting when it gets destroyed (it does not do
293anything to the socket after the connect was successful).
225 294
226Sometimes you need to "prepare" the socket before connecting, for example, 295Sometimes you need to "prepare" the socket before connecting, for example,
227to C<bind> it to some port, or you want a specific connect timeout that 296to C<bind> it to some port, or you want a specific connect timeout that
228is lower than your kernel's default timeout. In this case you can specify 297is lower than your kernel's default timeout. In this case you can specify
229a second callback, C<$prepare_cb>. It will be called with the file handle 298a second callback, C<$prepare_cb>. It will be called with the file handle
230in not-yet-connected state as only argument and must return the connection 299in not-yet-connected state as only argument and must return the connection
231timeout value (or C<0>, C<undef> or the empty list to indicate the default 300timeout value (or C<0>, C<undef> or the empty list to indicate the default
232timeout is to be used). 301timeout is to be used).
233 302
234Note that the socket could be either a IPv4 TCP socket or an IPv6 tcp 303Note that the socket could be either a IPv4 TCP socket or an IPv6 TCP
235socket (although only IPv4 is currently supported by this module). 304socket (although only IPv4 is currently supported by this module).
236 305
237Simple Example: connect to localhost on port 22. 306Simple Example: connect to localhost on port 22.
238 307
239 tcp_connect localhost => 22, sub { 308 tcp_connect localhost => 22, sub {
… …
288 # see http://cr.yp.to/docs/connect.html for some background 357 # see http://cr.yp.to/docs/connect.html for some background
289 358
290 my %state = ( fh => undef ); 359 my %state = ( fh => undef );
291 360
292 # name resolution 361 # name resolution
293 inet_aton $host, sub { 362 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub {
363 my @target = @_;
364
365 $state{next} = sub {
294 return unless exists $state{fh}; 366 return unless exists $state{fh};
295 367
296 my $ipn = shift; 368 my $target = shift @target
297
298 4 == length $ipn
299 or do { 369 or do {
370 %state = ();
371 return $connect->();
372 };
373
374 my ($domain, $type, $proto, $sockaddr) = @$target;
375
376 # 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
392 # 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
417 # 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 } else {
300 %state = (); 423 %state = ();
301 $! = &Errno::ENXIO;
302 return $connect->();
303 };
304
305 # socket creation
306 socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0
307 or do {
308 %state = ();
309 return $connect->();
310 };
311
312 fh_nonblocking $state{fh}, 1;
313
314 # prepare and optional timeout
315 if ($prepare) {
316 my $timeout = $prepare->($state{fh});
317
318 $state{to} = AnyEvent->timer (after => $timeout, cb => sub {
319 %state = ();
320 $! = &Errno::ETIMEDOUT;
321 $connect->();
322 }) if $timeout;
323 }
324
325 # called when the connect was successful, which,
326 # in theory, could be the case immediately (but never is in practise)
327 my $connected = sub {
328 my $fh = delete $state{fh};
329 %state = ();
330
331 # we are connected, or maybe there was an error
332 if (my $sin = getpeername $fh) {
333 my ($port, $host) = Socket::unpack_sockaddr_in $sin;
334 $connect->($fh, (Socket::inet_ntoa $host), $port);
335 } else {
336 # dummy read to fetch real error code
337 sysread $fh, my $buf, 1 if $! == &Errno::ENOTCONN;
338 $connect->(); 424 $connect->();
339 } 425 }
340 }; 426 };
341 427
342 # now connect 428 $! = &Errno::ENXIO;
343 if (connect $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, $ipn) { 429 $state{next}();
344 $connected->();
345 } elsif ($! == &Errno::EINPROGRESS || $! == &Errno::EWOULDBLOCK) { # EINPROGRESS is POSIX
346 $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $connected);
347 } else {
348 %state = ();
349 $connect->();
350 }
351 }; 430 };
352 431
353 defined wantarray 432 defined wantarray && guard { %state = () }
354 ? guard { %state = () } # break any circular dependencies and unregister watchers
355 : ()
356} 433}
357 434
358=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb] 435=item $guard = tcp_server $host, $port, $accept_cb[, $prepare_cb]
359 436
360Create and bind a tcp socket to the given host (any IPv4 host if undef, 437Create and bind a TCP socket to the given host, and port, set the
361otherwise it must be an IPv4 or IPv6 address) and port (service name or
362numeric port number, or an ephemeral port if given as zero or undef), set
363the SO_REUSEADDR flag and call C<listen>. 438SO_REUSEADDR flag and call C<listen>.
364 439
440C<$host> must be an IPv4 or IPv6 address (or C<undef>, in which case it
441binds either to C<0> or to C<::>, depending on whether IPv4 or IPv6 is the
442preferred protocol).
443
444To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
445wildcard address, use C<::>.
446
447The port is specified by C<$port>, which must be either a service name or
448a numeric port number (or C<0> or C<undef>, in which case an ephemeral
449port will be used).
450
365For each new connection that could be C<accept>ed, call the C<$accept_cb> 451For each new connection that could be C<accept>ed, call the C<<
366with the filehandle (in non-blocking mode) as first and the peer host and 452$accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
367port as second and third arguments (see C<tcp_connect> for details). 453mode) as first and the peer host and port as second and third arguments
454(see C<tcp_connect> for details).
368 455
369Croaks on any errors. 456Croaks on any errors it can detect before the listen.
370 457
371If called in non-void context, then this function returns a guard object 458If called in non-void context, then this function returns a guard object
372whose lifetime it tied to the tcp server: If the object gets destroyed, 459whose lifetime it tied to the TCP server: If the object gets destroyed,
373the server will be stopped (but existing accepted connections will 460the server will be stopped (but existing accepted connections will
374continue). 461continue).
375 462
376If you need more control over the listening socket, you can provide a 463If you need more control over the listening socket, you can provide a
377C<$prepare_cb>, which is called just before the C<listen ()> call, with 464C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
378the listen file handle as first argument. 465C<listen ()> call, with the listen file handle as first argument, and IP
466address and port number of the local socket endpoint as second and third
467arguments.
379 468
380It should return the length of the listen queue (or C<0> for the default). 469It should return the length of the listen queue (or C<0> for the default).
381 470
382Example: bind on tcp port 8888 on the local machine and tell each client 471Example: bind on TCP port 8888 on the local machine and tell each client
383to go away. 472to go away.
384 473
385 tcp_server undef, 8888, sub { 474 tcp_server undef, 8888, sub {
386 my ($fh, $host, $port) = @_; 475 my ($fh, $host, $port) = @_;
387 476
… …
391=cut 480=cut
392 481
393sub tcp_server($$$;$) { 482sub tcp_server($$$;$) {
394 my ($host, $port, $accept, $prepare) = @_; 483 my ($host, $port, $accept, $prepare) = @_;
395 484
485 $host = $AnyEvent::PROTOCOL{ipv4} > $AnyEvent::PROTOCOL{ipv6} && AF_INET6
486 ? "::" : "0"
487 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
396 my %state; 494 my %state;
397 495
398 socket $state{fh}, &Socket::AF_INET, &Socket::SOCK_STREAM, 0 496 socket $state{fh}, $domain, &Socket::SOCK_STREAM, 0
399 or Carp::croak "socket: $!"; 497 or Carp::croak "socket: $!";
400 498
401 setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1 499 setsockopt $state{fh}, &Socket::SOL_SOCKET, &Socket::SO_REUSEADDR, 1
402 or Carp::croak "so_reuseaddr: $!"; 500 or Carp::croak "so_reuseaddr: $!";
403 501
404 bind $state{fh}, Socket::pack_sockaddr_in _tcp_port $port, socket_inet_aton ($host || "0.0.0.0") 502 bind $state{fh}, pack_sockaddr _tcp_port $port, $ipn
405 or Carp::croak "bind: $!"; 503 or Carp::croak "bind: $!";
406 504
407 fh_nonblocking $state{fh}, 1; 505 fh_nonblocking $state{fh}, 1;
408 506
409 my $len = ($prepare && $prepare->($state{fh})) || 128; 507 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;
410 515
411 listen $state{fh}, $len 516 listen $state{fh}, $len
412 or Carp::croak "listen: $!"; 517 or Carp::croak "listen: $!";
413 518
414 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 519 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
415 # this closure keeps $state alive 520 # this closure keeps $state alive
416 while (my $peer = accept my $fh, $state{fh}) { 521 while (my $peer = accept my $fh, $state{fh}) {
417 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 522 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
418 my ($port, $host) = Socket::unpack_sockaddr_in $peer; 523 my ($port, $host) = unpack_sockaddr $peer;
419 $accept->($fh, (Socket::inet_ntoa $host), $port); 524 $accept->($fh, format_ip $host, $port);
420 } 525 }
421 }); 526 });
422 527
423 defined wantarray 528 defined wantarray
424 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 529 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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