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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC vs.
Revision 1.146 by root, Tue Mar 27 23:47:57 2012 UTC

 =head1 NAME
-AnyEvent::Socket - useful IPv4 and IPv6 stuff.
+AnyEvent::Socket - useful IPv4 and IPv6 stuff. also unix domain sockets. and stuff.
 =head1 SYNOPSIS
    use AnyEvent::Socket;
    tcp_connect
 );
 our $VERSION = $AnyEvent::VERSION;
-# used in cases where we may return immediately but want the
-# caller to do stuff first
-sub _postpone {
-   my ($cb, @args) = (@_, $!);
-   my $w; $w = AE::timer 0, 0, sub {
-      undef $w;
-      $! = pop @args;
-      $cb->(@args);
-   };
-}
 =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
 forms specified by POSIX (e.g. C<10.0.0.1>, C<10.1>, C<10.0x020304>,
    push @h, 0 while @h + @t < 8;
    # and done
    pack "n*", map hex, @h, @t
 }
+=item $token = parse_unix $hostname
+This fucntion exists mainly for symmetry to the other C<parse_protocol>
+functions - it takes a hostname and, if it is C<unix/>, it returns a
+special address token, otherwise C<undef>.
+The only use for this function is probably to detect whether a hostname
+matches whatever AnyEvent uses for unix domain sockets.
+=cut
 sub parse_unix($) {
    $_[0] eq "unix/"
       ? pack "S", AF_UNIX
       : undef
 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>).
+C<parse_unix>), and strings starting with C</> will also be interpreted as
+unix domain sockets.
-   hostname:port    e.g. "www.linux.org", "www.x.de:443", "www.x.de:https=443"
+   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"
+   unix/:path       e.g. "unix/:/path/to/socket"
+   /path            e.g. "/path/to/socket"
 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 was detected, such as a
   # => "localhost,https"
   print join ",", parse_hostport "[::1]";
   # => "," (empty list)
+  print join ",", parse_host_port "/tmp/debug.sock";
+  # => "unix/", "/tmp/debug.sock"
 =cut
 sub parse_hostport($;$) {
    my ($host, $port);
    for ("$_[0]") { # work on a copy, just in case, and also reset pos
+      # shortcut for /path
+      return ("unix/", $_)
+         if m%^/%;
       # 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
       } elsif (/\G\s*$/gc && length $_[1]) {
          $port = $_[1];
       } else {
          return;
       }
    }
    # hostnames must not contain :'s
    return if $host =~ /:/ && !parse_ipv6 $host;
    } elsif (my $ipn = &parse_ipv6) {
       $cb->($ipn);
    } elsif ($name eq "localhost") { # rfc2606 et al.
       $cb->(v127.0.0.1, v0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.1);
    } else {
-      require AnyEvent::DNS;
+      require AnyEvent::DNS unless $AnyEvent::DNS::VERSION;
       my $ipv4 = $AnyEvent::PROTOCOL{ipv4};
       my $ipv6 = $AnyEvent::PROTOCOL{ipv6};
       my @res;
 will be consulted to find the real service, otherwise they will be
 used as-is. If you know that the service name is not in your services
 database, then you can specify the service in the format C<name=port>
 (e.g. C<http=80>).
+If a host cannot be found via DNS, then it will be looked up in
+F</etc/hosts> (or the file specified via C<< $ENV{PERL_ANYEVENT_HOSTS}
+>>). If they are found, the addresses there will be used. The effect is as
+if entries from F</etc/hosts> would yield C<A> and C<AAAA> records for the
+host name unless DNS already had records for them.
 For UNIX domain sockets, C<$node> must be the string C<unix/> and
 C<$service> must be the absolute pathname of the socket. In this case,
 C<$proto> will be ignored.
 C<$proto> must be a protocol name, currently C<tcp>, C<udp> or
 Example:
    resolve_sockaddr "google.com", "http", 0, undef, undef, sub { ... };
 =cut
+our %HOSTS;
+our $HOSTS;
+if (
+   open my $fh, "<",
+      length $ENV{PERL_ANYEVENT_HOSTS} ? $ENV{PERL_ANYEVENT_HOSTS}
+      : AnyEvent::WIN32                ? "$ENV{SystemRoot}/system32/drivers/etc/hosts"
+      :                                  "/etc/hosts"
+) {
+   local $/;
+   binmode $fh;
+   $HOSTS = <$fh>;
+} else {
+   $HOSTS = "";
+}
+sub _parse_hosts() {
+   #%HOSTS = ();
+   for (split /\n/, $HOSTS) {
+      s/#.*$//;
+      s/^[ \t]+//;
+      y/A-Z/a-z/;
+      my ($addr, @aliases) = split /[ \t]+/;
+      next unless @aliases;
+      if (my $ip = parse_ipv4 $addr) {
+         push @{ $HOSTS{$_}[0] }, $ip
+            for @aliases;
+      } elsif (my $ip = parse_ipv6 $addr) {
+         push @{ $HOSTS{$_}[1] }, $ip
+            for @aliases;
+      }
+   }
+   undef $HOSTS;
+}
 sub resolve_sockaddr($$$$$$) {
    my ($node, $service, $proto, $family, $type, $cb) = @_;
    if ($node eq "unix/") {
             if ($af == AF_INET6 && $family != 4) {
                push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
                            pack_sockaddr $port, $noden]]
             }
          } else {
-            # ipv4
+            $node =~ y/A-Z/a-z/;
+            my $hosts = $HOSTS{$node};
+            # a records
             if ($family != 6) {
                $cv->begin;
                AnyEvent::DNS::a $node, sub {
-                  push @res, [$idx, "ipv4", [AF_INET, $type, $proton,
+                  push @res, [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, parse_ipv4 $_]]
-                              pack_sockaddr $port, parse_ipv4 $_]]
                      for @_;
+                  # dns takes precedence over hosts
+                  push @res,
+                     map [$idx, "ipv4", [AF_INET , $type, $proton, pack_sockaddr $port, $_]],
+                        @{ $hosts->[0] }
+                     unless @_;
                   $cv->end;
                };
             }
-            # ipv6
+            # aaaa records
             if ($family != 4) {
                $cv->begin;
                AnyEvent::DNS::aaaa $node, sub {
-                  push @res, [$idx, "ipv6", [AF_INET6, $type, $proton,
+                  push @res, [$idx, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, parse_ipv6 $_]]
-                              pack_sockaddr $port, parse_ipv6 $_]]
                      for @_;
+                  push @res,
+                     map [$idx + 0.5, "ipv6", [AF_INET6, $type, $proton, pack_sockaddr $port, $_]],
+                        @{ $hosts->[1] }
+                     unless @_;
                   $cv->end;
                };
             }
          }
       }
       $cv->end;
    };
    $node = AnyEvent::Util::idn_to_ascii $node
       if $node =~ /[^\x00-\x7f]/;
+   # parse hosts
+   if (defined $HOSTS) {
+      _parse_hosts;
+      undef &_parse_hosts;
+   }
    # try srv records, if applicable
    if ($node eq "localhost") {
       $resolve->(["127.0.0.1", $port], ["::1", $port]);
    } elsif (defined $service && !parse_address $node) {
          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";
+               AE::log error => $_[2];
                $_[0]->destroy;
             },
             on_eof => sub {
                $handle->destroy; # destroy handle
-               warn "done.\n";
+               AE::log info => "Done.";
             };
          $handle->push_write ("GET / HTTP/1.0\015\012\015\012");
          $handle->push_read (line => "\015\012\015\012", sub {
       my @target = @_;
       $state{next} = sub {
          return unless exists $state{fh};
+         my $errno = $!;
          my $target = shift @target
-            or return _postpone sub {
+            or return AE::postpone {
                return unless exists $state{fh};
                %state = ();
+               $! = $errno;
                $connect->();
             };
          my ($domain, $type, $proto, $sockaddr) = @$target;
    defined wantarray && guard { %state = () }
 }
 =item $guard = tcp_server $host, $service, $accept_cb[, $prepare_cb]
-Create and bind a stream socket to the given host, and port, set the
+Create and bind a stream socket to the given host address and port, set
-SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
+the SO_REUSEADDR flag (if applicable) and call C<listen>. Unlike the name
 implies, this function can also bind on UNIX domain sockets.
 For internet sockets, C<$host> must be an IPv4 or IPv6 address (or
 C<undef>, in which case it binds either to C<0> or to C<::>, depending
 on whether IPv4 or IPv6 is the preferred protocol, and maybe to both in
 future versions, as applicable).
 To bind to the IPv4 wildcard address, use C<0>, to bind to the IPv6
 wildcard address, use C<::>.
-The port is specified by C<$service>, which must be either a service name or
+The port is specified by C<$service>, which must be either a service name
-a numeric port number (or C<0> or C<undef>, in which case an ephemeral
+or a numeric port number (or C<0> or C<undef>, in which case an ephemeral
 port will be used).
 For UNIX domain sockets, C<$host> must be C<unix/> and C<$service> must be
 the absolute pathname of the socket. This function will try to C<unlink>
-the socket before it tries to bind to it. See SECURITY CONSIDERATIONS,
+the socket before it tries to bind to it, and will try to unlink it after
-below.
+it stops using it. See SECURITY CONSIDERATIONS, below.
 For each new connection that could be C<accept>ed, call the C<<
 $accept_cb->($fh, $host, $port) >> with the file handle (in non-blocking
 mode) as first, and the peer host and port as second and third arguments
 (see C<tcp_connect> for details).
 If called in non-void context, then this function returns a guard object
 whose lifetime it tied to the TCP server: If the object gets destroyed,
 the server will be stopped (but existing accepted connections will
 not be affected).
+Regardless, when the function returns to the caller, the socket is bound
+and in listening state.
 If you need more control over the listening socket, you can provide a
 C<< $prepare_cb->($fh, $host, $port) >>, which is called just before the
 C<listen ()> call, with the listen file handle as first argument, and IP
 address and port number of the local socket endpoint as second and third
       my ($fh, $host, $port) = @_;
       syswrite $fh, "The internet is full, $host:$port. Go away!\015\012";
    }, sub {
       my ($fh, $thishost, $thisport) = @_;
-      warn "bound to $thishost, port $thisport\n";
+      AE::log info => "Bound to $thishost, port $thisport.";
    };
 Example: bind a server on a unix domain socket.
    tcp_server "unix/", "/tmp/mydir/mysocket", sub {
    }
    bind $state{fh}, pack_sockaddr $service, $ipn
       or Carp::croak "bind: $!";
+   if ($af == AF_UNIX) {
+      my $fh  = $state{fh};
+      my $ino = (stat $fh)[1];
+      $state{unlink} = guard {
+         # this is racy, but is not designed to be foolproof, just best-effort
+         unlink $service
+            if $ino == (stat $fh)[1];
+      };
+   }
    fh_nonblocking $state{fh}, 1;
    my $len;
    if ($prepare) {
 sub tcp_congestion($$) {
    defined TCP_CONGESTION
       ? setsockopt $_[0], Socket::IPPROTO_TCP (), TCP_CONGESTION, "$_[1]"
       : undef
 }
-1;
 =back
 =head1 SECURITY CONSIDERATIONS
  Marc Lehmann <schmorp@schmorp.de>
  http://home.schmorp.de/
 =cut
+1

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents): Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC vs. Revision 1.146 by root, Tue Mar 27 23:47:57 2012 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/Socket.pm (file contents):
Revision 1.130 by root, Fri Jan 14 17:43:11 2011 UTC vs.
Revision 1.146 by root, Tue Mar 27 23:47:57 2012 UTC