--- AnyEvent/lib/AnyEvent/Socket.pm 2009/04/20 14:34:18 1.75 +++ AnyEvent/lib/AnyEvent/Socket.pm 2009/07/18 05:19:09 1.97 @@ -35,23 +35,22 @@ package AnyEvent::Socket; -no warnings; -use strict; - use Carp (); use Errno (); use Socket qw(AF_INET AF_UNIX SOCK_STREAM SOCK_DGRAM SOL_SOCKET SO_REUSEADDR); -use AnyEvent (); +use AnyEvent (); BEGIN { AnyEvent::common_sense } use AnyEvent::Util qw(guard fh_nonblocking AF_INET6); use AnyEvent::DNS (); use base 'Exporter'; our @EXPORT = qw( + getprotobyname parse_hostport parse_ipv4 parse_ipv6 parse_ip parse_address + format_ipv4 format_ipv6 format_ip format_address address_family inet_aton @@ -59,7 +58,7 @@ tcp_connect ); -our $VERSION = 4.352; +our $VERSION = 4.85; =item $ipn = parse_ipv4 $dotted_quad @@ -146,7 +145,7 @@ } -=item $ipn = parse_address $text +=item $ipn = parse_address $ip Combines C and C in one function. The address here refers to the host address (not socket address) in network form @@ -156,7 +155,11 @@ recognised by the other functions in this module to mean "UNIX domain socket". -=item $text = AnyEvent::Socket::aton $ipn +If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::), +then it will be treated as an IPv4 address. If you don't want that, you +have to call C and/or C manually. + +=item $ipn = AnyEvent::Socket::aton $ip Same as C, but not exported (think C but I name resolution). @@ -164,11 +167,44 @@ =cut sub parse_address($) { - &parse_ipv4 || &parse_ipv6 || &parse_unix + for (&parse_ipv6) { + if ($_) { + s/^\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff//; + return $_; + } else { + return &parse_ipv4 || &parse_unix + } + } } *aton = \&parse_address; +=item ($name, $aliases, $proto) = getprotobyname $name + +Works like the builtin function of the same name, except it tries hard to +work even on broken platforms (well, that's windows), where getprotobyname +is traditionally very unreliable. + +=cut + +# microsoft can't even get getprotobyname working (the etc/protocols file +# gets lost fairly often on windows), so we have to hardcode some common +# protocol numbers ourselves. +our %PROTO_BYNAME; + +$PROTO_BYNAME{tcp} = Socket::IPPROTO_TCP () if defined &Socket::IPPROTO_TCP; +$PROTO_BYNAME{udp} = Socket::IPPROTO_UDP () if defined &Socket::IPPROTO_UDP; +$PROTO_BYNAME{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP; + +sub getprotobyname($) { + my $name = lc shift; + + defined (my $proton = $PROTO_BYNAME{$name} || (getprotobyname $name)[2]) + or return; + + ($name, uc $name, $proton) +} + =item ($host, $service) = parse_hostport $string[, $default_service] Splitting a string of the form C is a common @@ -261,6 +297,18 @@ : unpack "S", $_[0] } +=item $text = format_ipv4 $ipn + +Expects a four octet string representing a binary IPv4 address and returns +its textual format. Rarely used, see C for a nicer +interface. + +=item $text = format_ipv6 $ipn + +Expects a sixteen octet string representing a binary IPv6 address and +returns its textual format. Rarely used, see C for a +nicer interface. + =item $text = format_address $ipn Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16 @@ -273,45 +321,58 @@ Returns C if it cannot detect the type. +If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::), then just +the contained IPv4 address will be returned. If you do not want that, you +have to call C manually. + =item $text = AnyEvent::Socket::ntoa $ipn Same as format_address, but not exported (think C). =cut -sub format_address; +sub format_ipv4($) { + join ".", unpack "C4", $_[0] +} + +sub format_ipv6($) { + if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { + return "::"; + } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { + return "::1"; + } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { + # v4compatible + return "::" . format_ipv4 substr $_[0], 12; + } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { + # v4mapped + return "::ffff:" . format_ipv4 substr $_[0], 12; + } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { + # v4translated + return "::ffff:0:" . format_ipv4 substr $_[0], 12; + } else { + my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; + + # this is rather sucky, I admit + $ip =~ s/^0:(?:0:)*(0$)?/::/ + or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/ + or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/ + or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/ + or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/ + or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/ + or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/ + or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/; + return $ip + } +} + sub format_address($) { my $af = address_family $_[0]; if ($af == AF_INET) { - return join ".", unpack "C4", $_[0] + return &format_ipv4; } elsif ($af == AF_INET6) { - if (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0 eq $_[0]) { - return "::"; - } elsif (v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1 eq $_[0]) { - return "::1"; - } elsif (v0.0.0.0.0.0.0.0.0.0.0.0 eq substr $_[0], 0, 12) { - # v4compatible - return "::" . format_address substr $_[0], 12; - } elsif (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) { - # v4mapped - return "::ffff:" . format_address substr $_[0], 12; - } elsif (v0.0.0.0.0.0.0.0.255.255.0.0 eq substr $_[0], 0, 12) { - # v4translated - return "::ffff:0:" . format_address substr $_[0], 12; - } else { - my $ip = sprintf "%x:%x:%x:%x:%x:%x:%x:%x", unpack "n8", $_[0]; - - # this is rather sucky, I admit - $ip =~ s/^0:(?:0:)*(0$)?/::/ - or $ip =~ s/(:0){7}$/::/ or $ip =~ s/(:0){7}/:/ - or $ip =~ s/(:0){6}$/::/ or $ip =~ s/(:0){6}/:/ - or $ip =~ s/(:0){5}$/::/ or $ip =~ s/(:0){5}/:/ - or $ip =~ s/(:0){4}$/::/ or $ip =~ s/(:0){4}/:/ - or $ip =~ s/(:0){3}$/::/ or $ip =~ s/(:0){3}/:/ - or $ip =~ s/(:0){2}$/::/ or $ip =~ s/(:0){2}/:/ - or $ip =~ s/(:0){1}$/::/ or $ip =~ s/(:0){1}/:/; - return $ip - } + return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12) + ? format_ipv4 substr $_[0], 12 + : &format_ipv6; } elsif ($af == AF_UNIX) { return "unix/" } else { @@ -357,11 +418,21 @@ } } +BEGIN { + *sockaddr_family = $Socket::VERSION >= 1.75 + ? \&Socket::sockaddr_family + : # for 5.6.x, we need to do something much more horrible + (Socket::pack_sockaddr_in 0x5555, "\x55\x55\x55\x55" + | eval { Socket::pack_sockaddr_un "U" }) =~ /^\x00/ + ? sub { unpack "xC", $_[0] } + : sub { unpack "S" , $_[0] }; +} + # check for broken platforms with extra field in sockaddr structure # kind of a rfc vs. bsd issue, as usual (ok, normally it's a # unix vs. bsd issue, a iso C vs. bsd issue or simply a -# correctness vs. bsd issue. -my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55") +# correctness vs. bsd issue.) +my $pack_family = 0x55 == sockaddr_family ("\x55\x55") ? "xC" : "S"; =item $sa = AnyEvent::Socket::pack_sockaddr $service, $host @@ -407,7 +478,7 @@ =cut sub unpack_sockaddr($) { - my $af = Socket::sockaddr_family $_[0]; + my $af = sockaddr_family $_[0]; if ($af == AF_INET) { Socket::unpack_sockaddr_in $_[0] @@ -464,15 +535,6 @@ =cut -# microsoft can't even get getprotobyname working (the etc/protocols file -# gets lost fairly often on windows), so we have to hardcode some common -# protocol numbers ourselves. -our %PROTO_BYNAME; - -$PROTO_BYNAME{tcp} = &Socket::IPPROTO_TCP if defined &Socket::IPPROTO_TCP; -$PROTO_BYNAME{udp} = &Socket::IPPROTO_UDP if defined &Socket::IPPROTO_UDP; -$PROTO_BYNAME{icmp} = &Socket::IPPROTO_ICMP if defined &Socket::IPPROTO_ICMP; - sub resolve_sockaddr($$$$$$) { my ($node, $service, $proto, $family, $type, $cb) = @_; @@ -498,7 +560,7 @@ $proto ||= "tcp"; $type ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM; - my $proton = $PROTO_BYNAME{lc $proto} || (getprotobyname $proto)[2] + my $proton = getprotobyname $proto or Carp::croak "$proto: protocol unknown"; my $port; @@ -677,8 +739,12 @@ my $handle; # avoid direct assignment so on_eof has it in scope. $handle = new AnyEvent::Handle fh => $fh, + on_error => sub { + warn "error $_[2]\n"; + $_[0]->destroy; + }, on_eof => sub { - undef $handle; # keep it alive till eof + $handle->destroy; # destroy handle warn "done.\n"; }; @@ -727,10 +793,7 @@ return unless exists $state{fh}; my $target = shift @target - or do { - %state = (); - return $connect->(); - }; + or return (%state = (), $connect->()); my ($domain, $type, $proto, $sockaddr) = @$target; @@ -745,20 +808,19 @@ $timeout ||= 30 if AnyEvent::WIN32; $state{to} = AnyEvent->timer (after => $timeout, cb => sub { - $! = &Errno::ETIMEDOUT; + $! = Errno::ETIMEDOUT; $state{next}(); }) if $timeout; # called when the connect was successful, which, # in theory, could be the case immediately (but never is in practise) $state{connected} = sub { - delete $state{ww}; - delete $state{to}; - # we are connected, or maybe there was an error if (my $sin = getpeername $state{fh}) { my ($port, $host) = unpack_sockaddr $sin; + delete $state{ww}; delete $state{to}; + my $guard = guard { %state = () }; $connect->(delete $state{fh}, format_address $host, $port, sub { @@ -767,7 +829,12 @@ }); } else { # dummy read to fetch real error code - sysread $state{fh}, my $buf, 1 if $! == &Errno::ENOTCONN; + sysread $state{fh}, my $buf, 1 if $! == Errno::ENOTCONN; + + return if $! == Errno::EAGAIN; # skip spurious wake-ups + + delete $state{ww}; delete $state{to}; + $state{next}(); } }; @@ -775,8 +842,8 @@ # now connect if (connect $state{fh}, $sockaddr) { $state{connected}->(); - } elsif ($! == &Errno::EINPROGRESS # POSIX - || $! == &Errno::EWOULDBLOCK + } elsif ($! == Errno::EINPROGRESS # POSIX + || $! == Errno::EWOULDBLOCK # WSAEINPROGRESS intentionally not checked - it means something else entirely || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt || $! == AnyEvent::Util::WSAEWOULDBLOCK) { @@ -786,7 +853,7 @@ } }; - $! = &Errno::ENXIO; + $! = Errno::ENXIO; $state{next}(); };