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.91 by root, Thu Jul 16 04:20:24 2009 UTC vs.
Revision 1.102 by root, Thu Jul 30 16:39:19 2009 UTC

… …
33 33
34=cut 34=cut
35 35
36package AnyEvent::Socket; 36package AnyEvent::Socket;
37 37
38no warnings;
39use strict;
40
41use Carp (); 38use Carp ();
42use Errno (); 39use Errno ();
43use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); 40use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR);
44 41
45use AnyEvent (); 42use AnyEvent (); BEGIN { AnyEvent::common_sense }
46use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); 43use AnyEvent::Util qw(guard fh_nonblocking AF_INET6);
47use AnyEvent::DNS (); 44use AnyEvent::DNS ();
48 45
49use base 'Exporter'; 46use base 'Exporter';
50 47
51our @EXPORT = qw( 48our @EXPORT = qw(
49 getprotobyname
52 parse_hostport 50 parse_hostport
53 parse_ipv4 parse_ipv6 51 parse_ipv4 parse_ipv6
54 parse_ip parse_address 52 parse_ip parse_address
55 format_ipv4 format_ipv6 53 format_ipv4 format_ipv6
56 format_ip format_address 54 format_ip format_address
… …
58 inet_aton 56 inet_aton
59 tcp_server 57 tcp_server
60 tcp_connect 58 tcp_connect
61); 59);
62 60
63our $VERSION = 4.82; 61our $VERSION = 4.881;
64 62
65=item $ipn = parse_ipv4 $dotted_quad 63=item $ipn = parse_ipv4 $dotted_quad
66 64
67Tries to parse the given dotted quad IPv4 address and return it in 65Tries to parse the given dotted quad IPv4 address and return it in
68octet form (or undef when it isn't in a parsable format). Supports all 66octet form (or undef when it isn't in a parsable format). Supports all
… …
179 } 177 }
180} 178}
181 179
182*aton = \&parse_address; 180*aton = \&parse_address;
183 181
182=item ($name, $aliases, $proto) = getprotobyname $name
183
184Works like the builtin function of the same name, except it tries hard to
185work even on broken platforms (well, that's windows), where getprotobyname
186is traditionally very unreliable.
187
188=cut
189
190# microsoft can't even get getprotobyname working (the etc/protocols file
191# gets lost fairly often on windows), so we have to hardcode some common
192# protocol numbers ourselves.
193our %PROTO_BYNAME;
194
195$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP;
196$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP;
197$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
198
199sub getprotobyname($) {
200 my $name = lc shift;
201
202 defined (my $proton = $PROTO_BYNAME{$name} || (getprotobyname $name)[2])
203 or return;
204
205 ($name, uc $name, $proton)
206}
207
184=item ($host, $service) = parse_hostport $string[, $default_service] 208=item ($host, $service) = parse_hostport $string[, $default_service]
185 209
186Splitting a string of the form C<hostname:port> is a common 210Splitting a string of the form C<hostname:port> is a common
187problem. Unfortunately, just splitting on the colon makes it hard to 211problem. Unfortunately, just splitting on the colon makes it hard to
188specify IPv6 addresses and doesn't support the less common but well 212specify IPv6 addresses and doesn't support the less common but well
… …
203 ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp" 227 ipv4or6 port e.g. "::1 443", "10.0.0.1 smtp"
204 228
205It also supports defaulting the service name in a simple way by using 229It also supports defaulting the service name in a simple way by using
206C<$default_service> if no service was detected. If neither a service was 230C<$default_service> if no service was detected. If neither a service was
207detected nor a default was specified, then this function returns the 231detected nor a default was specified, then this function returns the
208empty list. The same happens when a parse error weas detected, such as a 232empty list. The same happens when a parse error was detected, such as a
209hostname with a colon in it (the function is rather conservative, though). 233hostname with a colon in it (the function is rather conservative, though).
210 234
211Example: 235Example:
212 236
213 print join ",", parse_hostport "localhost:443"; 237 print join ",", parse_hostport "localhost:443";
… …
392 } 416 }
393 }); 417 });
394 } 418 }
395} 419}
396 420
421BEGIN {
422 *sockaddr_family = $Socket::VERSION >= 1.75
423 ? \&Socket::sockaddr_family
424 : # for 5.6.x, we need to do something much more horrible
425 (Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55"
426 | eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/
427 ? sub { unpack "xC", $_[0] }
428 : sub { unpack "S" , $_[0] };
429}
430
397# check for broken platforms with extra field in sockaddr structure 431# check for broken platforms with extra field in sockaddr structure
398# kind of a rfc vs. bsd issue, as usual (ok, normally it's a 432# kind of a rfc vs. bsd issue, as usual (ok, normally it's a
399# unix vs. bsd issue, a iso C vs. bsd issue or simply a 433# unix vs. bsd issue, a iso C vs. bsd issue or simply a
400# correctness vs. bsd issue. 434# correctness vs. bsd issue.)
401my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55") 435my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
402 ? "xC" : "S"; 436 ? "xC" : "S";
403 437
404=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host 438=item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
405 439
406Pack the given port/host combination into a binary sockaddr 440Pack the given port/host combination into a binary sockaddr
… …
442module (C<format_address> converts it to C<unix/>). 476module (C<format_address> converts it to C<unix/>).
443 477
444=cut 478=cut
445 479
446sub unpack_sockaddr($) { 480sub unpack_sockaddr($) {
447 my $af = Socket::sockaddr_family $_[0]; 481 my $af = sockaddr_family $_[0];
448 482
449 if ($af == AF_INET) { 483 if ($af == AF_INET) {
450 Socket::unpack_sockaddr_in $_[0] 484 Socket::unpack_sockaddr_in $_[0]
451 } elsif ($af == AF_INET6) { 485 } elsif ($af == AF_INET6) {
452 unpack "x2 n x4 a16", $_[0] 486 unpack "x2 n x4 a16", $_[0]
… …
499 533
500 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... }; 534 resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
501 535
502=cut 536=cut
503 537
504# microsoft can't even get getprotobyname working (the etc/protocols file
505# gets lost fairly often on windows), so we have to hardcode some common
506# protocol numbers ourselves.
507our %PROTO_BYNAME;
508
509$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP;
510$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP;
511$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP;
512
513sub resolve_sockaddr($$$$$$) { 538sub resolve_sockaddr($$$$$$) {
514 my ($node, $service, $proto, $family, $type, $cb) = @_; 539 my ($node, $service, $proto, $family, $type, $cb) = @_;
515 540
516 if ($node eq "unix/") { 541 if ($node eq "unix/") {
517 return $cb->() if $family || $service !~ /^\//; # no can do 542 return $cb->() if $family || $service !~ /^\//; # no can do
… …
533 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4}; 558 $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
534 559
535 $proto ||= "tcp"; 560 $proto ||= "tcp";
536 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; 561 $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
537 562
538 my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2] 563 my $proton = getprotobyname $proto
539 or Carp::croak "$proto: protocol unknown"; 564 or Carp::croak "$proto: protocol unknown";
540 565
541 my $port; 566 my $port;
542 567
543 if ($service =~ /^(\S+)=(\d+)$/) { 568 if ($service =~ /^(\S+)=(\d+)$/) {
… …
766 791
767 $state{next} = sub { 792 $state{next} = sub {
768 return unless exists $state{fh}; 793 return unless exists $state{fh};
769 794
770 my $target = shift @target 795 my $target = shift @target
771 or do {
772 %state = ();
773 return $connect->(); 796 or return (%state = (), $connect->());
774 };
775 797
776 my ($domain, $type, $proto, $sockaddr) = @$target; 798 my ($domain, $type, $proto, $sockaddr) = @$target;
777 799
778 # socket creation 800 # socket creation
779 socket $state{fh}, $domain, $type, $proto 801 socket $state{fh}, $domain, $type, $proto

Diff Legend

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