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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.53 by root, Fri May 30 09:40:41 2008 UTC vs.
Revision 1.78 by root, Thu Oct 30 03:43:14 2008 UTC

 AnyEvent::DNS - fully asynchronous DNS resolution
 =head1 SYNOPSIS
- use AnyEvent::DNS;
+   use AnyEvent::DNS;
- my $cv = AnyEvent->condvar;
+   my $cv = AnyEvent->condvar;
- AnyEvent::DNS::a "www.google.de", $cv;
+   AnyEvent::DNS::a "www.google.de", $cv;
- # ... later
+   # ... later
- my @addrs = $cv->recv;
+   my @addrs = $cv->recv;
 =head1 DESCRIPTION
 This module offers both a number of DNS convenience functions as well
 as a fully asynchronous and high-performance pure-perl stub resolver.
 use AnyEvent ();
 use AnyEvent::Handle ();
 use AnyEvent::Util qw(AF_INET6);
-our $VERSION = '1.0';
+our $VERSION = 4.31;
 our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
 =item AnyEvent::DNS::a $domain, $cb->(@addrs)
 =item AnyEvent::DNS::srv $service, $proto, $domain, $cb->(@srv_rr)
 Tries to resolve the given service, protocol and domain name into a list
 of service records.
-Each srv_rr is an array reference with the following contents:
+Each C<$srv_rr> is an array reference with the following contents:
 C<[$priority, $weight, $transport, $target]>.
 They will be sorted with lowest priority first, then randomly
 distributed by weight as per RFC 2782.
       my %pri;
       push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
          for @_;
       # order by priority
-      for my $pri (sort { $a->[0] <=> $b->[0] } keys %pri) {
+      for my $pri (sort { $a <=> $b } keys %pri) {
          # order by weight
          my @rr = sort { $a->[1] <=> $b->[1] } @{ delete $pri{$pri} };
          my $sum; $sum += $_->[1] for @rr;
    ptr $ptr, sub {
       for my $name (@_) {
          ++$cnt;
          # () around AF_INET to work around bug in 5.8
-         resolver->resolve ($name => ($af == (AF_INET) ? "a" : "aaaa"), sub {
+         resolver->resolve ("$name." => ($af == (AF_INET) ? "a" : "aaaa"), sub {
             for (@_) {
                push @res, $name
                   if $_->[3] eq $ip;
             }
             $cb->(@res) unless --$cnt;
 Resource records are not yet encodable.
 Examples:
-  # very simple request, using lots of default values:
+   # very simple request, using lots of default values:
-  { rd => 1, qd => [ [ "host.domain", "a"] ] }
+   { rd => 1, qd => [ [ "host.domain", "a"] ] }
-  # more complex example, showing how flags etc. are named:
+   # more complex example, showing how flags etc. are named:
-  {
+   {
-     id => 10000,
+      id => 10000,
-     op => "query",
+      op => "query",
-     rc => "nxdomain",
+      rc => "nxdomain",
-     # flags
+      # flags
-     qr => 1,
+      qr => 1,
-     aa => 0,
+      aa => 0,
-     tc => 0,
+      tc => 0,
-     rd => 0,
+      rd => 0,
-     ra => 0,
+      ra => 0,
-     ad => 0,
+      ad => 0,
-     cd => 0,
+      cd => 0,
-     qd => [@rr], # query section
+      qd => [@rr], # query section
-     an => [@rr], # answer section
+      an => [@rr], # answer section
-     ns => [@rr], # authority section
+      ns => [@rr], # authority section
-     ar => [@rr], # additional records section
+      ar => [@rr], # additional records section
-  }
+   }
 =cut
 sub dns_pack($) {
    my ($req) = @_;
     15 => sub { local $ofs = $ofs + 2 - length; ((unpack "n", $_), _dec_name) }, # mx
     16 => sub { unpack "(C/a*)*", $_ }, # txt
     28 => sub { AnyEvent::Socket::format_address ($_) }, # aaaa
     33 => sub { local $ofs = $ofs + 6 - length; ((unpack "nnn", $_), _dec_name) }, # srv
     35 => sub { # naptr
+       # requires perl 5.10, sorry
        my ($order, $preference, $flags, $service, $regexp, $offset) = unpack "nn C/a* C/a* C/a* .", $_;
        local $ofs = $ofs + $offset - length;
        ($order, $preference, $flags, $service, $regexp, _dec_name)
     },
     99 => sub { unpack "(C/a*)*", $_ }, # spf
 Unpacks a DNS packet into a perl data structure.
 Examples:
-  # an unsuccessful reply
+   # an unsuccessful reply
-  {
+   {
-    'qd' => [
+     'qd' => [
-              [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
+               [ 'ruth.plan9.de.mach.uni-karlsruhe.de', '*', 'in' ]
-            ],
+             ],
-    'rc' => 'nxdomain',
+     'rc' => 'nxdomain',
-    'ar' => [],
+     'ar' => [],
-    'ns' => [
+     'ns' => [
-              [
+               [
-                'uni-karlsruhe.de',
+                 'uni-karlsruhe.de',
-                'soa',
+                 'soa',
-                'in',
+                 'in',
-                'netserv.rz.uni-karlsruhe.de',
+                 'netserv.rz.uni-karlsruhe.de',
-                'hostmaster.rz.uni-karlsruhe.de',
+                 'hostmaster.rz.uni-karlsruhe.de',
-                2008052201, 10800, 1800, 2592000, 86400
+                 2008052201, 10800, 1800, 2592000, 86400
-              ]
+               ]
-            ],
+             ],
-    'tc' => '',
+     'tc' => '',
-    'ra' => 1,
+     'ra' => 1,
-    'qr' => 1,
+     'qr' => 1,
-    'id' => 45915,
+     'id' => 45915,
-    'aa' => '',
+     'aa' => '',
-    'an' => [],
+     'an' => [],
-    'rd' => 1,
+     'rd' => 1,
-    'op' => 'query'
+     'op' => 'query'
-  }
+   }
-  # a successful reply
+   # a successful reply
-  {
+   {
-    'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
+     'qd' => [ [ 'www.google.de', 'a', 'in' ] ],
-    'rc' => 0,
+     'rc' => 0,
-    'ar' => [
+     'ar' => [
-              [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
+               [ 'a.l.google.com', 'a', 'in', '209.85.139.9' ],
-              [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
+               [ 'b.l.google.com', 'a', 'in', '64.233.179.9' ],
-              [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
+               [ 'c.l.google.com', 'a', 'in', '64.233.161.9' ],
-            ],
+             ],
-    'ns' => [
+     'ns' => [
-              [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
+               [ 'l.google.com', 'ns', 'in', 'a.l.google.com' ],
-              [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
+               [ 'l.google.com', 'ns', 'in', 'b.l.google.com' ],
-            ],
+             ],
-    'tc' => '',
+     'tc' => '',
-    'ra' => 1,
+     'ra' => 1,
-    'qr' => 1,
+     'qr' => 1,
-    'id' => 64265,
+     'id' => 64265,
-    'aa' => '',
+     'aa' => '',
-    'an' => [
+     'an' => [
-              [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
+               [ 'www.google.de', 'cname', 'in', 'www.google.com' ],
-              [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
+               [ 'www.google.com', 'cname', 'in', 'www.l.google.com' ],
-              [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
+               [ 'www.l.google.com', 'a', 'in', '66.249.93.104' ],
-              [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
+               [ 'www.l.google.com', 'a', 'in', '66.249.93.147' ],
-            ],
+             ],
-    'rd' => 1,
+     'rd' => 1,
-    'op' => 0
+     'op' => 0
-  }
+   }
 =cut
 sub dns_unpack($) {
    local $pkt = shift;
 been resolved.
 =item reuse => $seconds
 The number of seconds (default: C<300>) that a query id cannot be re-used
-after a timeout. If there as no time-out then query id's can be reused
+after a timeout. If there was no time-out then query ids can be reused
 immediately.
 =back
 =cut
 sub new {
    my ($class, %arg) = @_;
-   # try to create a ipv4 and an ipv6 socket
-   # only fail when we cnanot create either
-   socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0;
-   socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0;
-   $fh4 || $fh6
-      or Carp::croak "unable to create either an IPv6 or an IPv4 socket";
    my $self = bless {
       server  => [],
       timeout => [2, 5, 5],
       search  => [],
       ndots   => 1,
       max_outstanding => 10,
-      reuse   => 300, # reuse id's after 5 minutes only, if possible
+      reuse   => 300,
       %arg,
       reuse_q => [],
    }, $class;
    # search should default to gethostname's domain
    # but perl lacks a good posix module
+   # try to create an ipv4 and an ipv6 socket
+   # only fail when we cannot create either
+   my $got_socket;
    Scalar::Util::weaken (my $wself = $self);
-   if ($fh4) {
+   if (socket my $fh4, AF_INET , &Socket::SOCK_DGRAM, 0) {
+      ++$got_socket;
       AnyEvent::Util::fh_nonblocking $fh4, 1;
       $self->{fh4} = $fh4;
       $self->{rw4} = AnyEvent->io (fh => $fh4, poll => "r", cb => sub {
          if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
             $wself->_recv ($pkt, $peer);
          }
       });
    }
-   if ($fh6) {
+   if (AF_INET6 && socket my $fh6, AF_INET6, &Socket::SOCK_DGRAM, 0) {
+      ++$got_socket;
       $self->{fh6} = $fh6;
       AnyEvent::Util::fh_nonblocking $fh6, 1;
       $self->{rw6} = AnyEvent->io (fh => $fh6, poll => "r", cb => sub {
          if (my $peer = recv $fh6, my $pkt, MAX_PKT, 0) {
             $wself->_recv ($pkt, $peer);
          }
       });
    }
+   $got_socket
+      or Carp::croak "unable to create either an IPv4 or an IPv6 socket";
    $self->_compile;
    $self
 }
       # - the registry thing needs separate code on win32 native vs. cygwin
       # - the registry layout differs between windows versions
       # - calling windows api functions doesn't work on cygwin
       # - ipconfig uses locale-specific messages
-      # we use ipconfig parsing because, despite all it's brokenness,
+      # we use ipconfig parsing because, despite all its brokenness,
       # it seems most stable in practise.
       # for good measure, we append a fallback nameserver to our list.
       if (open my $fh, "ipconfig /all |") {
          # parsing strategy: we go through the output and look for
             } elsif (/^\S/ || /^\s[^:]{16,}: /) {
                $dns = 0;
             }
             if ($dns && /^\s*(\S+)\s*$/) {
                my $s = $1;
-               $s =~ s/%\d+(?!\S)//; # get rid of scope id
+               $s =~ s/%\d+(?!\S)//; # get rid of ipv6 scope id
                if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
                   push @{ $self->{server} }, $ipn;
                } else {
                   push @{ $self->{search} }, $s;
                }
 }
 =item $resolver->timeout ($timeout, ...)
 Sets the timeout values. See the C<timeout> constructor argument (and note
-that this method uses the values itselt, not an array-reference).
+that this method uses the values itself, not an array-reference).
 =cut
 sub timeout {
    my ($self, @timeout) = @_;
       $self->{id}{$req->[2]} = [AnyEvent->timer (after => $timeout, cb => sub {
          $NOW = time;
          # timeout, try next
-         &$do_retry;
+         &$do_retry if $do_retry;
       }), sub {
          my ($res) = @_;
          if ($res->{tc}) {
             # success, but truncated, so use tcp
    }
 }
 =item $resolver->request ($req, $cb->($res))
+This is the main low-level workhorse for sending DNS requests.
-Sends a single request (a hash-ref formated as specified for
+This function sends a single request (a hash-ref formated as specified
-C<dns_pack>) to the configured nameservers including
+for C<dns_pack>) to the configured nameservers in turn until it gets a
+response. It handles timeouts, retries and automatically falls back to
+virtual circuit mode (TCP) when it receives a truncated reply.
-retries. Calls the callback with the decoded response packet if a reply
+Calls the callback with the decoded response packet if a reply was
-was received, or no arguments on timeout.
+received, or no arguments in case none of the servers answered.
 =cut
 sub request($$) {
    my ($self, $req, $cb) = @_;
 =item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))
 Queries the DNS for the given domain name C<$qname> of type C<$qtype>.
-A C<$qtype> is either a numerical query type (e.g. C<1> for A recods) or
+A C<$qtype> is either a numerical query type (e.g. C<1> for A records) or
 a lowercase name (you have to look at the source to see which aliases are
 supported, but all types from RFC 1035, C<aaaa>, C<srv>, C<spf> and a few
-more are known to this module). A qtype of "*" is supported and means
+more are known to this module). A C<$qtype> of "*" is supported and means
 "any" record type.
 The callback will be invoked with a list of matching result records or
 none on any error or if the name could not be found.
-CNAME chains (although illegal) are followed up to a length of 8.
+CNAME chains (although illegal) are followed up to a length of 10.
 The callback will be invoked with an result code in string form (noerror,
 formerr, servfail, nxdomain, notimp, refused and so on), or numerical
 form if the result code is not supported. The remaining arguments are
 arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
 the domain name, C<$type> a type string or number, C<$class> a class name
 and @data is resource-record-dependent data. For C<a> records, this will
 be the textual IPv4 addresses, for C<ns> or C<cname> records this will be
 a domain name, for C<txt> records these are all the strings and so on.
-All types mentioned in RFC 1035, C<aaaa>, C<srv> and C<spf> are
+All types mentioned in RFC 1035, C<aaaa>, C<srv>, C<naptr> and C<spf> are
-decoded. All resource records not known to this module will just return
+decoded. All resource records not known to this module will have
 the raw C<rdata> field as fourth entry.
 Note that this resolver is just a stub resolver: it requires a name server
 supporting recursive queries, will not do any recursive queries itself and
 is not secure when used against an untrusted name server.
 =item search => [$suffix...]
 Use the given search list (which might be empty), by appending each one
 in turn to the C<$qname>. If this option is missing then the configured
-C<ndots> and C<search> define its value. If the C<$qname> ends in a dot,
+C<ndots> and C<search> values define its value (depending on C<ndots>, the
-then the searchlist will be ignored.
+empty suffix will be prepended or appended to that C<search> value). If
+the C<$qname> ends in a dot, then the searchlist will be ignored.
 =item accept => [$type...]
 Lists the acceptable result types: only result types in this set will be
 accepted and returned. The default includes the C<$qtype> and nothing
    $do_search = sub {
       @search
          or (undef $do_search), (undef $do_req), return $cb->();
       (my $name = lc "$qname." . shift @search) =~ s/\.$//;
-      my $depth = 2;
+      my $depth = 10;
       # advance in cname-chain
       $do_req = sub {
          $self->request ({
             rd => 1,
 =back
 =head1 AUTHOR
- Marc Lehmann <schmorp@schmorp.de>
+   Marc Lehmann <schmorp@schmorp.de>
- http://home.schmorp.de/
+   http://home.schmorp.de/
 =cut

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents): Revision 1.53 by root, Fri May 30 09:40:41 2008 UTC vs. Revision 1.78 by root, Thu Oct 30 03:43:14 2008 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.53 by root, Fri May 30 09:40:41 2008 UTC vs.
Revision 1.78 by root, Thu Oct 30 03:43:14 2008 UTC