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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.46 by root, Thu May 29 06:53:00 2008 UTC vs.
Revision 1.96 by root, Mon Jun 29 21:00:32 2009 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.45;
 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, highest weight first (TODO:
+They will be sorted with lowest priority first, then randomly
-should use the RFC algorithm to reorder same-priority records for weight).
+distributed by weight as per RFC 2782.
 Example:
    AnyEvent::DNS::srv "sip", "udp", "schmorp.de", sub { ...
    # @_ = ( [10, 10, 5060, "sip1.schmorp.de" ] )
-=item AnyEvent::DNS::ptr $ipv4_or_6, $cb->(@hostnames)
+=item AnyEvent::DNS::ptr $domain, $cb->(@hostnames)
+Tries to make a PTR lookup on the given domain. See C<reverse_lookup>
+and C<reverse_verify> if you want to resolve an IP address to a hostname
+instead.
+=item AnyEvent::DNS::any $domain, $cb->(@rrs)
+Tries to resolve the given domain and passes all resource records found to
+the callback.
+=item AnyEvent::DNS::reverse_lookup $ipv4_or_6, $cb->(@hostnames)
 Tries to reverse-resolve the given IPv4 or IPv6 address (in textual form)
-into it's hostname(s).
+into it's hostname(s). Handles V4MAPPED and V4COMPAT IPv6 addresses
+transparently.
+=item AnyEvent::DNS::reverse_verify $ipv4_or_6, $cb->(@hostnames)
+The same as C<reverse_lookup>, but does forward-lookups to verify that
+the resolved hostnames indeed point to the address, which makes spoofing
+harder.
+If you want to resolve an address into a hostname, this is the preferred
+method: The DNS records could still change, but at least this function
+verified that the hostname, at one point in the past, pointed at the IP
+address you originally resolved.
 Example:
    AnyEvent::DNS::ptr "2001:500:2f::f", sub { print shift };
    # => f.root-servers.net
-=item AnyEvent::DNS::any $domain, $cb->(@rrs)
-Tries to resolve the given domain and passes all resource records found to
-the callback.
 =cut
 sub MAX_PKT() { 4096 } # max packet size we advertise and accept
 sub srv($$$$) {
    my ($service, $proto, $domain, $cb) = @_;
    # todo, ask for any and check glue records
    resolver->resolve ("_$service._$proto.$domain" => "srv", sub {
-      $cb->(map [@$_[3,4,5,6]], sort { $a->[3] <=> $b->[3] || $b->[4] <=> $a->[4] } @_);
+      my @res;
+      # classify by priority
+      my %pri;
+      push @{ $pri{$_->[3]} }, [ @$_[3,4,5,6] ]
+         for @_;
+      # order by priority
+      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;
+         while (@rr) {
+            my $w = int rand $sum + 1;
+            for (0 .. $#rr) {
+               if (($w -= $rr[$_][1]) <= 0) {
+                  $sum -= $rr[$_][1];
+                  push @res, splice @rr, $_, 1, ();
+                  last;
+               }
+            }
+         }
+      }
+      $cb->(@res);
    });
 }
 sub ptr($$) {
+   my ($domain, $cb) = @_;
+   resolver->resolve ($domain => "ptr", sub {
+      $cb->(map $_->[3], @_);
+   });
+}
+sub any($$) {
+   my ($domain, $cb) = @_;
+   resolver->resolve ($domain => "*", $cb);
+}
+# convert textual ip address into reverse lookup form
+sub _munge_ptr($) {
+   my $ipn = $_[0]
+      or return;
+   my $ptr;
+   my $af = AnyEvent::Socket::address_family ($ipn);
+   if ($af == AF_INET6) {
+      $ipn = substr $ipn, 0, 16; # anticipate future expansion
+      # handle v4mapped and v4compat
+      if ($ipn =~ s/^\x00{10}(?:\xff\xff|\x00\x00)//) {
+         $af = AF_INET;
+      } else {
+         $ptr = join ".", (reverse split //, unpack "H32", $ipn), "ip6.arpa.";
+      }
+   }
+   if ($af == AF_INET) {
+      $ptr = join ".", (reverse unpack "C4", $ipn), "in-addr.arpa.";
+   }
+   $ptr
+}
+sub reverse_lookup($$) {
    my ($ip, $cb) = @_;
-   $ip = AnyEvent::Socket::parse_address ($ip)
+   $ip = _munge_ptr AnyEvent::Socket::parse_address ($ip)
       or return $cb->();
-   my $af = AnyEvent::Socket::address_family ($ip);
-   if ($af == AF_INET) {
-      $ip = join ".", (reverse split /\./, $ip), "in-addr.arpa.";
-   } elsif ($af == AF_INET6) {
-      $ip = join ".", (reverse split //, unpack "H*", $ip), "ip6.arpa.";
-   } else {
-      return $cb->();
-   }
    resolver->resolve ($ip => "ptr", sub {
       $cb->(map $_->[3], @_);
    });
 }
-sub any($$) {
+sub reverse_verify($$) {
-   my ($domain, $cb) = @_;
+   my ($ip, $cb) = @_;
+   my $ipn = AnyEvent::Socket::parse_address ($ip)
+      or return $cb->();
-   resolver->resolve ($domain => "*", $cb);
+   my $af = AnyEvent::Socket::address_family ($ipn);
+   my @res;
+   my $cnt;
+   my $ptr = _munge_ptr $ipn
+      or return $cb->();
+   $ip = AnyEvent::Socket::format_address ($ipn); # normalise into the same form
+   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 {
+            for (@_) {
+               push @res, $name
+                  if $_->[3] eq $ip;
+            }
+            $cb->(@res) unless --$cnt;
+         });
+      }
+      $cb->() unless $cnt;
+   };
 }
 #################################################################################
 =back
 C<$ENV{PERL_ANYEVENT_EDNS0}>, but when set to C<1>, AnyEvent::DNS will use
 EDNS0 in all requests.
 =cut
-our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0} * 1; # set to 1 to enable (partial) edns0
+our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0
 our %opcode_id = (
    query  => 0,
    iquery => 1,
    status => 2,
    minfo =>  14,
    mx    =>  15,
    txt   =>  16,
    aaaa  =>  28,
    srv   =>  33,
+   naptr =>  35, # rfc2915
+   dname =>  39, # rfc2672
    opt   =>  41,
    spf   =>  99,
    tkey  => 249,
    tsig  => 250,
    ixfr  => 251,
    die "encoding of resource records is not supported";
 }
 =item $pkt = AnyEvent::DNS::dns_pack $dns
-Packs a perl data structure into a DNS packet. Reading RFC1034 is strongly
+Packs a perl data structure into a DNS packet. Reading RFC 1035 is strongly
 recommended, then everything will be totally clear. Or maybe not.
 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) = @_;
     13 => sub { unpack "C/a* C/a*", $_ }, # hinfo
     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)
+    },
+    39 => sub { local $ofs = $ofs - length; _dec_name }, # dname
     99 => sub { unpack "(C/a*)*", $_ }, # spf
 );
 sub _dec_rr {
    my $name = _dec_name;
 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;
 our $RESOLVER;
 sub resolver() {
    $RESOLVER || do {
-      $RESOLVER = new AnyEvent::DNS;
+      $RESOLVER = new AnyEvent::DNS untaint => 1;
       $RESOLVER->os_config;
       $RESOLVER
    }
 }
 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.
+=item untaint => $boolean
+When true, then the resolver will automatically untaint results, and might
+also ignore certain environment variables.
 =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
 }
    $self->_compile;
 }
 =item $resolver->os_config
-Tries so load and parse F</etc/resolv.conf> on portable operating systems. Tries various
+Tries so load and parse F</etc/resolv.conf> on portable operating
-egregious hacks on windows to force the DNS servers and searchlist out of the system.
+systems. Tries various egregious hacks on windows to force the DNS servers
+and searchlist out of the system.
 =cut
 sub os_config {
    my ($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;
                }
          $self->parse_resolv_conf (<$fh>);
       }
    }
 }
+=item $resolver->timeout ($timeout, ...)
+Sets the timeout values. See the C<timeout> constructor argument (and note
+that this method uses the values itself, not an array-reference).
+=cut
+sub timeout {
+   my ($self, @timeout) = @_;
+   $self->{timeout} = \@timeout;
+   $self->_compile;
+}
+=item $resolver->max_outstanding ($nrequests)
+Sets the maximum number of outstanding requests to C<$nrequests>. See the
+C<max_outstanding> constructor argument.
+=cut
+sub max_outstanding {
+   my ($self, $max) = @_;
+   $self->{max_outstanding} = $max;
+   $self->_scheduler;
+}
 sub _compile {
    my $self = shift;
    my %search; $self->{search} = [grep 0 < length, grep !$search{$_}++, @{ $self->{search} }];
    my %server; $self->{server} = [grep 0 < length, grep !$server{$_}++, @{ $self->{server} }];
    $self->{retry} = \@retry;
 }
 sub _feed {
    my ($self, $res) = @_;
+   ($res) = $res =~ /^(.*)$/s
+      if AnyEvent::TAINT && $self->{untaint};
    $res = dns_unpack $res
       or return;
    my $id = $self->{id}{$res->{id}};
       $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
             AnyEvent::Socket::tcp_connect (AnyEvent::Socket::format_address ($server), DOMAIN_PORT, sub {
+               return unless $do_retry; # some other request could have invalidated us already
                my ($fh) = @_
                   or return &$do_retry;
-               my $handle = new AnyEvent::Handle
+               my $handle; $handle = new AnyEvent::Handle
                   fh       => $fh,
+                  timeout  => $timeout,
                   on_error => sub {
+                     undef $handle;
+                     return unless $do_retry; # some other request could have invalidated us already
                      # failure, try next
                      &$do_retry;
                   };
                $handle->push_write (pack "n/a", $req->[0]);
                $handle->push_read (chunk => 2, sub {
                   $handle->unshift_read (chunk => (unpack "n", $_[1]), sub {
+                     undef $handle;
                      $self->_feed ($_[1]);
                   });
                });
-               shutdown $fh, 1;
             }, sub { $timeout });
          } else {
             # success
 }
 sub _scheduler {
    my ($self) = @_;
+   no strict 'refs';
    $NOW = time;
    # first clear id reuse queue
    delete $self->{id}{ (shift @{ $self->{reuse_q} })->[1] }
       while @{ $self->{reuse_q} } && $self->{reuse_q}[0][0] <= $NOW;
             $self->_scheduler;
          });
          last;
       }
-      my $req = shift @{ $self->{queue} }
+      if (my $req = shift @{ $self->{queue} }) {
-         or last;
+         # found a request in the queue, execute it
-      while () {
+         while () {
-         $req->[2] = int rand 65536;
+            $req->[2] = int rand 65536;
-         last unless exists $self->{id}{$req->[2]};
+            last unless exists $self->{id}{$req->[2]};
+         }
+         ++$self->{outstanding};
+         $self->{id}{$req->[2]} = 1;
+         substr $req->[0], 0, 2, pack "n", $req->[2];
+         $self->_exec ($req);
+      } elsif (my $cb = shift @{ $self->{wait} }) {
+         # found a wait_for_slot callback, call that one first
+         $cb->($self);
+      } else {
+         # nothing to do, just exit
+         last;
       }
-      ++$self->{outstanding};
-      $self->{id}{$req->[2]} = 1;
-      substr $req->[0], 0, 2, pack "n", $req->[2];
-      $self->_exec ($req);
    }
 }
 =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) = @_;
    push @{ $self->{queue} }, [dns_pack $req, $cb];
    $self->_scheduler;
 }
-=item $resolver->resolve ($qname, $qtype, %options, $cb->($rcode, @rr))
+=item $resolver->resolve ($qname, $qtype, %options, $cb->(@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 1034, C<aaaa>, C<srv>, C<spf> and a few
+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,
+The callback will be invoked with arraryefs of the form C<[$name, $type,
-formerr, servfail, nxdomain, notimp, refused and so on), or numerical
+$class, @data>], where C<$name> is the domain name, C<$type> a type string
-form if the result code is not supported. The remaining arguments are
+or number, C<$class> a class name and @data is resource-record-dependent
-arraryefs of the form C<[$name, $type, $class, @data>], where C<$name> is
+data. For C<a> records, this will be the textual IPv4 addresses, for C<ns>
-the domain name, C<$type> a type string or number, C<$class> a class name
+or C<cname> records this will be a domain name, for C<txt> records these
-and @data is resource-record-dependent data. For C<a> records, this will
+are all the strings and so on.
-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 1034, 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,
    };
    $do_search->();
 }
+=item $resolver->wait_for_slot ($cb->($resolver))
+Wait until a free request slot is available and call the callback with the
+resolver object.
+A request slot is used each time a request is actually sent to the
+nameservers: There are never more than C<max_outstanding> of them.
+Although you can submit more requests (they will simply be queued until
+a request slot becomes available), sometimes, usually for rate-limiting
+purposes, it is useful to instead wait for a slot before generating the
+request (or simply to know when the request load is low enough so one can
+submit requests again).
+This is what this method does: The callback will be called when submitting
+a DNS request will not result in that request being queued. The callback
+may or may not generate any requests in response.
+Note that the callback will only be invoked when the request queue is
+empty, so this does not play well if somebody else keeps the request queue
+full at all times.
+=cut
+sub wait_for_slot {
+   my ($self, $cb) = @_;
+   push @{ $self->{wait} }, $cb;
+   $self->_scheduler;
+}
 use AnyEvent::Socket (); # circular dependency, so do not import anything and do it at the end
 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.46 by root, Thu May 29 06:53:00 2008 UTC vs. Revision 1.96 by root, Mon Jun 29 21:00:32 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.46 by root, Thu May 29 06:53:00 2008 UTC vs.
Revision 1.96 by root, Mon Jun 29 21:00:32 2009 UTC