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.33 by root, Tue May 27 06:23:15 2008 UTC vs.
Revision 1.34 by root, Wed May 28 21:07:07 2008 UTC

… …
38no warnings; 38no warnings;
39use strict; 39use strict;
40 40
41use Carp (); 41use Carp ();
42use Errno (); 42use Errno ();
43use Socket qw(AF_INET SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); 43use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
44 44
45use AnyEvent (); 45use AnyEvent ();
46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); 46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47use AnyEvent::DNS (); 47use AnyEvent::DNS ();
48 48
49use base 'Exporter'; 49use base 'Exporter';
50 50
51our @EXPORT = qw(parse_ipv4 parse_ipv6 parse_ip format_ip inet_aton tcp_server tcp_connect); 51our @EXPORT = qw(
52 parse_ipv4 parse_ipv6
53 parse_ip parse_address
54 format_ip format_address
55 address_family
56 inet_aton
57 tcp_server
58 tcp_connect
59);
52 60
53our $VERSION = '1.0'; 61our $VERSION = '1.0';
54 62
55=item $ipn = parse_ipv4 $dotted_quad 63=item $ipn = parse_ipv4 $dotted_quad
56 64
… …
128 136
129 # and done 137 # and done
130 pack "n*", map hex, @h, @t 138 pack "n*", map hex, @h, @t
131} 139}
132 140
141sub parse_unix($) {
142 $_[0] eq "unix/"
143 ? pack "S", AF_UNIX
144 : undef
145
146}
147
133=item $ipn = parse_ip $text 148=item $ipn = parse_address $text
134 149
135Combines C<parse_ipv4> and C<parse_ipv6> in one function. 150Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
151here refers to the host address (not socket address) in network form
152(binary).
136 153
137=cut 154If the C<$text> is C<unix/>, then this function returns a special token
155recognised by the other functions in this module to mean "UNIX domain
156socket".
138 157
158=cut
159
139sub parse_ip($) { 160sub parse_address($) {
140 &parse_ipv4 || &parse_ipv6 161 &parse_ipv4 || &parse_ipv6 || &parse_unix
141} 162}
142 163
164*parse_ip =\&parse_address; #d#
165
166=item $sa_family = address_family $ipn
167
168Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
169of the given host address in network format.
170
171=cut
172
173sub address_family($) {
174 4 == length $_[0]
175 ? AF_INET
176 : 16 == length $_[0]
177 ? AF_INET6
178 : unpack "S", $_[0]
179}
180
143=item $text = format_ip $ipn 181=item $text = format_address $ipn
144 182
145Takes either an IPv4 address (4 octets) or and IPv6 address (16 octets) 183Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
146and converts it into textual form. 184octets for IPv6) and convert it into textual form.
185
186Returns C<unix/> for UNIX domain sockets.
147 187
148This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>, 188This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
149except it automatically detects the address type. 189except it automatically detects the address type.
150 190
151=cut 191Returns C<undef> if it cannot detect the type.
152 192
153sub format_ip; 193=cut
194
195sub format_address;
154sub format_ip($) { 196sub format_address($) {
155 if (4 == length $_[0]) { 197 my $af = address_family $_[0];
198 if ($af == AF_INET) {
156 return join ".", unpack "C4", $_[0] 199 return join ".", unpack "C4", $_[0]
157 } elsif (16 == length $_[0]) { 200 } elsif ($af == AF_INET6) {
201 if (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) {
202 # v4compatible
203 return "::" . format_address substr $_[0], 12;
158 if (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { 204 } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) {
159 # v4mapped 205 # v4mapped
160 return "::ffff:" . format_ip substr $_[0], 12; 206 return "::ffff:" . format_address substr $_[0], 12;
207 } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) {
208 # v4translated
209 return "::ffff:0:" . format_address substr $_[0], 12;
161 } else { 210 } else {
162 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; 211 my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0];
163 212
164 $ip =~ s/^0:(?:0:)*(0$)?/::/ 213 $ip =~ s/^0:(?:0:)*(0$)?/::/
165 or $ip =~ s/(:0)+$/::/ 214 or $ip =~ s/(:0)+$/::/
166 or $ip =~ s/(:0)+/:/; 215 or $ip =~ s/(:0)+/:/;
167 return $ip 216 return $ip
168 } 217 }
218 } elsif ($af == AF_UNIX) {
219 return "unix/"
169 } else { 220 } else {
170 return undef 221 return undef
171 } 222 }
172} 223}
224
225*format_ip = \&format_address;
173 226
174=item inet_aton $name_or_address, $cb->(@addresses) 227=item inet_aton $name_or_address, $cb->(@addresses)
175 228
176Works similarly to its Socket counterpart, except that it uses a 229Works similarly to its Socket counterpart, except that it uses a
177callback. Also, if a host has only an IPv6 address, this might be passed 230callback. Also, if a host has only an IPv6 address, this might be passed
178to the callback instead (use the length to detect this - 4 for IPv4, 16 231to the callback instead (use the length to detect this - 4 for IPv4, 16
179for IPv6). 232for IPv6).
180 233
181Unlike the L<Socket> function of the same name, you can get multiple IPv4 234Unlike the L<Socket> function of the same name, you can get multiple IPv4
182and IPv6 addresses as result. 235and IPv6 addresses as result (and maybe even other adrdess types).
183 236
184=cut 237=cut
185 238
186sub inet_aton { 239sub inet_aton {
187 my ($name, $cb) = @_; 240 my ($name, $cb) = @_;
… …
212# unix vs. bsd issue, a iso C vs. bsd issue or simply a 265# unix vs. bsd issue, a iso C vs. bsd issue or simply a
213# correctness vs. bsd issue. 266# correctness vs. bsd issue.
214my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55" 267my $pack_family = 0x55 == Socket::sockaddr_family "\x55\x55"
215 ? "xC" : "S"; 268 ? "xC" : "S";
216 269
217=item $sa = AnyEvent::Socket::pack_sockaddr $port, $host 270=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
218 271
219Pack the given port/host combination into a binary sockaddr structure. Handles 272Pack the given port/host combination into a binary sockaddr
220both IPv4 and IPv6 host addresses. 273structure. Handles both IPv4 and IPv6 host addresses, as well as UNIX
274domain sockets (C<$host> == C<unix/> and C<$service> == absolute
275pathname).
221 276
222=cut 277=cut
223 278
224sub pack_sockaddr($$) { 279sub pack_sockaddr($$) {
225 if (4 == length $_[1]) { 280 my $af = address_family $_[1];
281
282 if ($af == AF_INET) {
226 Socket::pack_sockaddr_in $_[0], $_[1] 283 Socket::pack_sockaddr_in $_[0], $_[1]
227 } elsif (16 == length $_[1]) { 284 } elsif ($af == AF_INET6) {
228 pack "$pack_family nL a16 L", 285 pack "$pack_family nL a16 L",
229 AF_INET6, 286 AF_INET6,
230 $_[0], # port 287 $_[0], # port
231 0, # flowinfo 288 0, # flowinfo
232 $_[1], # addr 289 $_[1], # addr
233 0 # scope id 290 0 # scope id
291 } elsif ($af == AF_UNIX) {
292 Socket::pack_sockaddr_un $_[0]
234 } else { 293 } else {
235 Carp::croak "pack_sockaddr: invalid host"; 294 Carp::croak "pack_sockaddr: invalid host";
236 } 295 }
237} 296}
238 297
239=item ($port, $host) = AnyEvent::Socket::unpack_sockaddr $sa 298=item ($service, $host) = AnyEvent::Socket::unpack_sockaddr $sa
240 299
241Unpack the given binary sockaddr structure (as used by bind, getpeername 300Unpack the given binary sockaddr structure (as used by bind, getpeername
242etc.) into a C<$port, $host> combination. 301etc.) into a C<$service, $host> combination.
243 302
244Handles both IPv4 and IPv6 sockaddr structures. 303For IPv4 and IPv6, C<$service> is the port number and C<$host> the host
304address in network format (binary).
305
306For UNIX domain sockets, C<$service> is the absolute pathname and C<$host>
307is a special token that is understood by the other functions in this
308module (C<format_address> converts it to C<unix/>).
245 309
246=cut 310=cut
247 311
248sub unpack_sockaddr($) { 312sub unpack_sockaddr($) {
249 my $af = Socket::sockaddr_family $_[0]; 313 my $af = Socket::sockaddr_family $_[0];
250 314
251 if ($af == AF_INET) { 315 if ($af == AF_INET) {
252 Socket::unpack_sockaddr_in $_[0] 316 Socket::unpack_sockaddr_in $_[0]
253 } elsif ($af == AF_INET6) { 317 } elsif ($af == AF_INET6) {
254 unpack "x2 n x4 a16", $_[0] 318 unpack "x2 n x4 a16", $_[0]
319 } elsif ($af == AF_UNIX) {
320 ((Socket::unpack_sockaddr_un $_[0]), "unix/")
255 } else { 321 } else {
256 Carp::croak "unpack_sockaddr: unsupported protocol family $af"; 322 Carp::croak "unpack_sockaddr: unsupported protocol family $af";
257 } 323 }
258} 324}
259 325
… …
262 328
263 (getservbyname $_[0], "tcp")[2] 329 (getservbyname $_[0], "tcp")[2]
264 or Carp::croak "$_[0]: service unknown" 330 or Carp::croak "$_[0]: service unknown"
265} 331}
266 332
333=item resolve_sockaddr $node, $service, $proto, $family, $type, $cb->([$family, $type, $proto, $sockaddr], ...)
334
335Tries to resolve the given nodename and service name into protocol families
336and sockaddr structures usable to connect to this node and service in a
337protocol-independent way. It works remotely similar to the getaddrinfo
338posix function.
339
340For internet addresses, C<$node> is either an IPv4 or IPv6 address or an
341internet hostname, and C<$service> is either a service name (port name
342from F</etc/services>) or a numerical port number. If both C<$node> and
343C<$service> are names, then SRV records will be consulted to find the real
344service, otherwise they will be used as-is. If you know that the service
345name is not in your services database, then you can specify the service in
346the format C<name=port> (e.g. C<http=80>).
347
348For UNIX domain sockets, C<$node> must be the string C<unix/> and
349C<$service> must be the absolute pathname of the socket. In this case,
350C<$proto> will be ignored.
351
352C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
353C<sctp>. The default is currently C<tcp>, but in the future, this function
354might try to use other protocols such as C<sctp>, depending on the socket
355type and any SRV records it might find.
356
357C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
358only IPv4) or C<6> (use only IPv6). This setting might be influenced by
359C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
360
361C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
362C<undef> in which case it gets automatically chosen).
363
364The callback will receive zero or more array references that contain
365C<$family, $type, $proto> for use in C<socket> and a binary
366C<$sockaddr> for use in C<connect> (or C<bind>).
367
368The application should try these in the order given.
369
370Example:
371
372 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
373
374=cut
375
376sub resolve_sockaddr($$$$$$) {
377 my ($node, $service, $proto, $family, $type, $cb) = @_;
378
379 if ($node eq "unix/") {
380 return $cb->() if $family || !/^\//; # no can do
381
382 return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]);
383 }
384
385 unless (AF_INET6) {
386 $family != 6
387 or return $cb->();
388
389 $family = 4;
390 }
391
392 $cb->() if $family == 4 && !$AnyEvent::PROTOCOL{ipv4};
393 $cb->() if $family == 6 && !$AnyEvent::PROTOCOL{ipv6};
394
395 $family ||= 4 unless $AnyEvent::PROTOCOL{ipv6};
396 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
397
398 $proto ||= "tcp";
399 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
400
401 my $proton = (getprotobyname $proto)[2]
402 or Carp::croak "$proto: protocol unknown";
403
404 my $port;
405
406 if ($service =~ /^(\S+)=(\d+)$/) {
407 ($service, $port) = ($1, $2);
408 } elsif ($service =~ /^\d+$/) {
409 ($service, $port) = (undef, $service);
410 } else {
411 $port = (getservbyname $service, $proto)[2]
412 or Carp::croak "$service/$proto: service unknown";
413 }
414
415 my @target = [$node, $port];
416
417 # resolve a records / provide sockaddr structures
418 my $resolve = sub {
419 my @res;
420 my $cv = AnyEvent->condvar (cb => sub {
421 $cb->(
422 map $_->[2],
423 sort {
424 $AnyEvent::PROTOCOL{$b->[1]} <=> $AnyEvent::PROTOCOL{$a->[1]}
425 or $a->[0] <=> $b->[0]
426 }
427 @res
428 )
429 });
430
431 $cv->begin;
432 for my $idx (0 .. $#target) {
433 my ($node, $port) = @{ $target[$idx] };
434
435 if (my $noden = parse_address $node) {
436 if (4 == length $noden && $family != 6) {
437 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
438 pack_sockaddr $port, $noden]]
439 }
440
441 if (16 == length $noden && $family != 4) {
442 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
443 pack_sockaddr $port, $noden]]
444 }
445 } else {
446 # ipv4
447 if ($family != 6) {
448 $cv->begin;
449 a $node, sub {
450 push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
451 pack_sockaddr $port, parse_ipv4 $_]]
452 for @_;
453 $cv->end;
454 };
455 }
456
457 # ipv6
458 if ($family != 4) {
459 $cv->begin;
460 aaaa $node, sub {
461 push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
462 pack_sockaddr $port, parse_ipv6 $_]]
463 for @_;
464 $cv->end;
465 };
466 }
467 }
468 }
469 $cv->end;
470 };
471
472 # try srv records, if applicable
473 if ($node eq "localhost") {
474 @target = (["127.0.0.1", $port], ["::1", $port]);
475 &$resolve;
476 } elsif (defined $service && !parse_address $node) {
477 srv $service, $proto, $node, sub {
478 my (@srv) = @_;
479
480 # no srv records, continue traditionally
481 @srv
482 or return &$resolve;
483
484 # only srv record has "." => abort
485 $srv[0][2] ne "." || $#srv
486 or return $cb->();
487
488 # use srv records then
489 @target = map ["$_->[3].", $_->[2]],
490 grep $_->[3] ne ".",
491 @srv;
492
493 &$resolve;
494 };
495 } else {
496 &$resolve;
497 }
498}
499
267=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb] 500=item $guard = tcp_connect $host, $service, $connect_cb[, $prepare_cb]
268 501
269This is a convenience function that creates a TCP socket and makes a 100% 502This is a convenience function that creates a TCP socket and makes a 100%
270non-blocking connect to the given C<$host> (which can be a hostname or a 503non-blocking connect to the given C<$host> (which can be a hostname or
504a textual IP address, or the string C<unix/> for UNIX domain sockets)
271textual IP address) and C<$service> (which can be a numeric port number or 505and C<$service> (which can be a numeric port number or a service name,
272a service name, or a C<servicename=portnumber> string). 506or a C<servicename=portnumber> string, or the pathname to a UNIX domain
507socket).
273 508
274If both C<$host> and C<$port> are names, then this function will use SRV 509If both C<$host> and C<$port> are names, then this function will use SRV
275records to locate the real target(s). 510records to locate the real target(s).
276 511
277In either case, it will create a list of target hosts (e.g. for multihomed 512In either case, it will create a list of target hosts (e.g. for multihomed
… …
364 # could call $fh->bind etc. here 599 # could call $fh->bind etc. here
365 600
366 15 601 15
367 }; 602 };
368 603
604Example: connect to a UNIX domain socket.
605
606 tcp_connect "unix/", "/tmp/.X11-unix/X0", sub {
607 ...
608 }
609
369=cut 610=cut
370 611
371sub tcp_connect($$$;$) { 612sub tcp_connect($$$;$) {
372 my ($host, $port, $connect, $prepare) = @_; 613 my ($host, $port, $connect, $prepare) = @_;
373 614
… …
375 # also http://advogato.org/article/672.html 616 # also http://advogato.org/article/672.html
376 617
377 my %state = ( fh => undef ); 618 my %state = ( fh => undef );
378 619
379 # name/service to type/sockaddr resolution 620 # name/service to type/sockaddr resolution
380 AnyEvent::DNS::addr $host, $port, 0, 0, 0, sub { 621 resolve_sockaddr $host, $port, 0, 0, 0, sub {
381 my @target = @_; 622 my @target = @_;
382 623
383 $state{next} = sub { 624 $state{next} = sub {
384 return unless exists $state{fh}; 625 return unless exists $state{fh};
385 626
… …
418 659
419 my $guard = guard { 660 my $guard = guard {
420 %state = (); 661 %state = ();
421 }; 662 };
422 663
423 $connect->($state{fh}, format_ip $host, $port, sub { 664 $connect->($state{fh}, format_address $host, $port, sub {
424 $guard->cancel; 665 $guard->cancel;
425 $state{next}(); 666 $state{next}();
426 }); 667 });
427 } else { 668 } else {
428 # dummy read to fetch real error code 669 # dummy read to fetch real error code
… …
507 748
508 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6 749 $host = $AnyEvent::PROTOCOL{ipv4} < $AnyEvent::PROTOCOL{ipv6} && AF_INET6
509 ? "::" : "0" 750 ? "::" : "0"
510 unless defined $host; 751 unless defined $host;
511 752
512 my $ipn = parse_ip $host 753 my $ipn = parse_address $host
513 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as IPv4 or IPv6 address"; 754 or Carp::croak "AnyEvent::Socket::tcp_server: cannot parse '$host' as host address";
514 755
515 my $domain = 4 == length $ipn ? AF_INET : AF_INET6; 756 my $domain = 4 == length $ipn ? AF_INET : AF_INET6;
516 757
517 my %state; 758 my %state;
518 759
… …
529 770
530 my $len; 771 my $len;
531 772
532 if ($prepare) { 773 if ($prepare) {
533 my ($port, $host) = unpack_sockaddr getsockname $state{fh}; 774 my ($port, $host) = unpack_sockaddr getsockname $state{fh};
534 $len = $prepare && $prepare->($state{fh}, format_ip $host, $port); 775 $len = $prepare && $prepare->($state{fh}, format_address $host, $port);
535 } 776 }
536 777
537 $len ||= 128; 778 $len ||= 128;
538 779
539 listen $state{fh}, $len 780 listen $state{fh}, $len
… …
542 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub { 783 $state{aw} = AnyEvent->io (fh => $state{fh}, poll => 'r', cb => sub {
543 # this closure keeps $state alive 784 # this closure keeps $state alive
544 while (my $peer = accept my $fh, $state{fh}) { 785 while (my $peer = accept my $fh, $state{fh}) {
545 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not 786 fh_nonblocking $fh, 1; # POSIX requires inheritance, the outside world does not
546 my ($port, $host) = unpack_sockaddr $peer; 787 my ($port, $host) = unpack_sockaddr $peer;
547 $accept->($fh, format_ip $host, $port); 788 $accept->($fh, format_address $host, $port);
548 } 789 }
549 }); 790 });
550 791
551 defined wantarray 792 defined wantarray
552 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency 793 ? guard { %state = () } # clear fh and watcher, which breaks the circular dependency

Diff Legend

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