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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.45 by root, Sat May 31 13:38:01 2008 UTC vs.
Revision 1.99 by root, Sun Jul 26 00:17:25 2009 UTC

 =cut
 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
    tcp_server
    tcp_connect
 );
-our $VERSION = 4.1;
+our $VERSION = 4.87;
 =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
    # check leading parts against range
    return undef if grep $_ >= 256, @_[0 .. @_ - 2];
    # check trailing part against range
-   return undef if $_[-1] >= 1 << (8 * (4 - $#_));
+   return undef if $_[-1] >= 2 ** (8 * (4 - $#_));
    pack "N", (pop)
              + ($_[0] << 24)
              + ($_[1] << 16)
              + ($_[2] <<  8);
       ? 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 $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
+      }
+   }
 }
-*parse_ip =\&parse_address; #d#
+*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
+specify IPv6 addresses and doesn't support the less common but well
+standardised C<[ip literal]> syntax.
+This function tries to do this job in a better way, it supports the
+following formats, where C<port> can be a numerical port number of a
+service name, or a C<name=port> string, and the C< port> and C<:port>
+parts are optional. Also, everywhere where an IP address is supported
+a hostname or unix domain socket address is also supported (see
+C<parse_unix>).
+   hostname:port    e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
+   ipv4:port        e.g. "198.182.196.56", "127.1:22"
+   ipv6             e.g. "::1", "affe::1"
+   [ipv4or6]:port   e.g. "[::1]", "[10.0.1]:80"
+   [ipv4or6] port   e.g. "[127.0.0.1]", "[www.x.org] 17"
+   ipv4or6 port     e.g. "::1 443", "10.0.0.1 smtp"
+It also supports defaulting the service name in a simple way by using
+C<$default_service> if no service was detected. If neither a service was
+detected nor a default was specified, then this function returns the
+empty list. The same happens when a parse error weas detected, such as a
+hostname with a colon in it (the function is rather conservative, though).
+Example:
+  print join ",", parse_hostport "localhost:443";
+  # => "localhost,443"
+  print join ",", parse_hostport "localhost", "https";
+  # => "localhost,https"
+  print join ",", parse_hostport "[::1]";
+  # => "," (empty list)
+=cut
+sub parse_hostport($;$) {
+   my ($host, $port);
+   for ("$_[0]") { # work on a copy, just in case, and also reset pos
+      # parse host, special cases: "ipv6" or "ipv6 port"
+      unless (
+         ($host) = /^\s* ([0-9a-fA-F:]*:[0-9a-fA-F:]*:[0-9a-fA-F\.:]*)/xgc
+         and parse_ipv6 $host
+      ) {
+         /^\s*/xgc;
+         if (/^ \[ ([^\[\]]+) \]/xgc) {
+            $host = $1;
+         } elsif (/^ ([^\[\]:\ ]+) /xgc) {
+            $host = $1;
+         } else {
+            return;
+         }
+      }
+      # parse port
+      if (/\G (?:\s+|:) ([^:[:space:]]+) \s*$/xgc) {
+         $port = $1;
+      } elsif (/\G\s*$/gc && length $_[1]) {
+         $port = $_[1];
+      } else {
+         return;
+      }
+   }
+   # hostnames must not contain :'s
+   return if $host =~ /:/ && !parse_ipv6 $host;
+   ($host, $port)
+}
 =item $sa_family = address_family $ipn
 Returns the address family/protocol-family (AF_xxx/PF_xxx, in one value :)
 of the given host address in network format.
       : 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.
-=cut
+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.
-sub format_address;
+=item $text = AnyEvent::Socket::ntoa $ipn
+Same as format_address, but not exported (think C<inet_ntoa>).
+=cut
+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
    }
 }
-*format_ip = \&format_address;
+*ntoa = \&format_address;
 =item inet_aton $name_or_address, $cb->(@addresses)
 Works similarly to its Socket counterpart, except that it uses a
 callback. Also, if a host has only an IPv6 address, this might be passed
          }
       });
    }
 }
+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.
+# correctness vs. bsd issue.)
-my $pack_family = (0x55 == Socket::sockaddr_family "\x55\x55")
+my $pack_family = 0x55 == sockaddr_family ("\x55\x55")
                   ? "xC" : "S";
 =item $sa = AnyEvent::Socket::pack_sockaddr $service, $host
 Pack the given port/host combination into a binary sockaddr
 module (C<format_address> converts it to C<unix/>).
 =cut
 sub unpack_sockaddr($) {
-   my $af = Socket::sockaddr_family $_[0];
+   my $af = sockaddr_family $_[0];
    if ($af == AF_INET) {
       Socket::unpack_sockaddr_in $_[0]
    } elsif ($af == AF_INET6) {
       unpack "x2 n x4 a16", $_[0]
 C<sctp>. The default is currently C<tcp>, but in the future, this function
 might try to use other protocols such as C<sctp>, depending on the socket
 type and any SRV records it might find.
 C<$family> must be either C<0> (meaning any protocol is OK), C<4> (use
-only IPv4) or C<6> (use only IPv6). This setting might be influenced by
+only IPv4) or C<6> (use only IPv6). The default is influenced by
 C<$ENV{PERL_ANYEVENT_PROTOCOLS}>.
 C<$type> must be C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_SEQPACKET> (or
-C<undef> in which case it gets automatically chosen).
+C<undef> in which case it gets automatically chosen to be C<SOCK_STREAM>
+unless C<$proto> is C<udp>).
 The callback will receive zero or more array references that contain
 C<$family, $type, $proto> for use in C<socket> and a binary
 C<$sockaddr> for use in C<connect> (or C<bind>).
 sub resolve_sockaddr($$$$$$) {
    my ($node, $service, $proto, $family, $type, $cb) = @_;
    if ($node eq "unix/") {
-      return $cb->() if $family || !/^\//; # no can do
+      return $cb->() if $family || $service !~ /^\//; # no can do
-      return $cb->([AF_UNIX, $type, 0, Socket::pack_sockaddr_un $service]);
+      return $cb->([AF_UNIX, defined $type ? $type : SOCK_STREAM, 0, Socket::pack_sockaddr_un $service]);
    }
    unless (AF_INET6) {
       $family != 6
          or return $cb->();
    $family ||= 6 unless $AnyEvent::PROTOCOL{ipv4};
    $proto ||= "tcp";
    $type  ||= $proto eq "udp" ? SOCK_DGRAM : SOCK_STREAM;
-   my $proton = (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");
    # also http://advogato.org/article/672.html
    my %state = ( fh => undef );
    # name/service to type/sockaddr resolution
-   resolve_sockaddr $host, $port, 0, 0, 0, sub {
+   resolve_sockaddr $host, $port, 0, 0, undef, sub {
       my @target = @_;
       $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)
-         my $connected = sub {
+         $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 {
+               my $guard = guard { %state = () };
-                  %state = ();
-               };
-               $connect->($state{fh}, format_address $host, $port, sub {
+               $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) {
-            $connected->();
+            $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 => $connected);
+            $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 = () }
 }
    }, sub {
       my ($fh, $thishost, $thisport) = @_;
       warn "bound to $thishost, port $thisport\n";
    };
+Example: bind a server on a unix domain socket.
+   tcp_server "unix/", "/tmp/mydir/mysocket", sub {
+      my ($fh) = @_;
+   };
 =cut
 sub tcp_server($$$;$) {
    my ($host, $service, $accept, $prepare) = @_;

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.45 by root, Sat May 31 13:38:01 2008 UTC vs. Revision 1.99 by root, Sun Jul 26 00:17:25 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.45 by root, Sat May 31 13:38:01 2008 UTC vs.
Revision 1.99 by root, Sun Jul 26 00:17:25 2009 UTC