[ViewVC] Diff of: cvs/AnyEvent/lib/AnyEvent/Socket.pm

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.80 by root, Fri Jun 26 06:33:17 2009 UTC vs.
Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC

 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
    tcp_server
    tcp_connect
 );
-our $VERSION = 4.42;
+our $VERSION = 4.83;
 =item $ipn = parse_ipv4 $dotted_quad
 Tries to parse the given dotted quad IPv4 address and return it in
 octet form (or undef when it isn't in a parsable format). Supports all
       ? pack "S", AF_UNIX
       : undef
 }
-=item $ipn = parse_address $text
+=item $ipn = parse_address $ip
 Combines C<parse_ipv4> and C<parse_ipv6> in one function. The address
 here refers to the host address (not socket address) in network form
 (binary).
 If the C<$text> is C<unix/>, then this function returns a special token
 recognised by the other functions in this module to mean "UNIX domain
 socket".
+If the C<$text> to parse is a mapped IPv4 in IPv6 address (:ffff::<ipv4>),
+then it will be treated as an IPv4 address. If you don't want that, you
+have to call C<parse_ipv4> and/or C<parse_ipv6> manually.
-=item $text = AnyEvent::Socket::aton $ipn
+=item $ipn = AnyEvent::Socket::aton $ip
 Same as C<parse_address>, but not exported (think C<Socket::inet_aton> but
 I<without> name resolution).
 =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<hostname:port> is a common
 problem. Unfortunately, just splitting on the colon makes it hard to
       : 16 == length $_[0]
          ? AF_INET6
          : 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<format_address> 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<format_address> for a
+nicer interface.
 =item $text = format_address $ipn
 Covnvert a host address in network format (e.g. 4 octets for IPv4 or 16
 octets for IPv6) and convert it into textual form.
 This function works similarly to C<inet_ntop AF_INET || AF_INET6, ...>,
 except it automatically detects the address type.
 Returns C<undef> if it cannot detect the type.
+If the C<$ipn> is a mapped IPv4 in IPv6 address (:ffff::<ipv4>), then just
+the contained IPv4 address will be returned. If you do not want that, you
+have to call C<format_ipv6> manually.
 =item $text = AnyEvent::Socket::ntoa $ipn
 Same as format_address, but not exported (think C<inet_ntoa>).
 =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) {
+      return (v0.0.0.0.0.0.0.0.0.0.255.255 eq substr $_[0], 0, 12)
-         # v4mapped
+         ? format_ipv4 substr $_[0], 12
-         return "::ffff:" . format_address substr $_[0], 12;
+         : &format_ipv6;
-      } 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
-      }
    } elsif ($af == AF_UNIX) {
       return "unix/"
    } else {
       return undef
    }
    resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
 =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) = @_;
    if ($node eq "unix/") {
       return $cb->() if $family || $service !~ /^\//; # no can do
    $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
    $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;
    if ($service =~ /^(\S+)=(\d+)$/) {
             or die "unable to connect: $!";
          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";
             };
          $handle->push_write ("GET / HTTP/1.0\015\012\015\012");
       $state{next} = sub {
          return unless exists $state{fh};
          my $target = shift @target
-            or do {
-               %state = ();
-               return $connect->();
+            or return (%state = (), $connect->());
-            };
          my ($domain, $type, $proto, $sockaddr) = @$target;
          # socket creation
          socket $state{fh}, $domain, $type, $proto
          my $timeout = $prepare && $prepare->($state{fh});
          $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 {
                   $guard->cancel;
                   $state{next}();
                });
             } 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}();
             }
          };
          # now connect
          if (connect $state{fh}, $sockaddr) {
             $state{connected}->();
-         } elsif ($! == &Errno::EINPROGRESS # POSIX
+         } elsif ($! == Errno::EINPROGRESS # POSIX
-                  || $! == &Errno::EWOULDBLOCK
+                  || $! == Errno::EWOULDBLOCK
                   # WSAEINPROGRESS intentionally not checked - it means something else entirely
                   || $! == AnyEvent::Util::WSAEINVAL # not convinced, but doesn't hurt
                   || $! == AnyEvent::Util::WSAEWOULDBLOCK) {
             $state{ww} = AnyEvent->io (fh => $state{fh}, poll => 'w', cb => $state{connected});
          } else {
             $state{next}();
          }
       };
-      $! = &Errno::ENXIO;
+      $! = Errno::ENXIO;
       $state{next}();
    };
    defined wantarray && guard { %state = () }
 }

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.80 by root, Fri Jun 26 06:33:17 2009 UTC vs. Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.80 by root, Fri Jun 26 06:33:17 2009 UTC vs.
Revision 1.94 by root, Fri Jul 17 14:57:03 2009 UTC