AnyEvent::DNS - fully asynchronous DNS resolution

   use AnyEvent::DNS;

   my $cv = AnyEvent->condvar;
   AnyEvent::DNS::a "www.google.de", $cv;
   # ... later
   my @addrs = $cv->recv;

   Marc Lehmann <schmorp@schmorp.de>
   http://home.schmorp.de/

package AnyEvent::DNS;

use Carp ();
use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);

use AnyEvent (); BEGIN { AnyEvent::common_sense }
use AnyEvent::Util qw(AF_INET6);

our $VERSION = $AnyEvent::VERSION;

# some public dns servers
our @DNS_FALLBACK = (
   (v8.8.8.8, v8.8.4.4)[rand 2], # google public dns
   (v209.244.0.3, v209.244.0.4)[rand 2], # level3
   (v4.2.2.1, v4.2.2.3, v4.2.2.4, v4.2.2.5, v4.2.2.6)[rand 4], # vnsc-pri.sys.gtei.net
);
push @DNS_FALLBACK, splice @DNS_FALLBACK, rand $_, 1 for reverse 1..@DNS_FALLBACK;

sub MAX_PKT() { 4096 } # max packet size we advertise and accept

sub DOMAIN_PORT() { 53 } # if this changes drop me a note

sub resolver ();

sub a($$) {
   my ($domain, $cb) = @_;

   resolver->resolve ($domain => "a", sub {
      $cb->(map $_->[3], @_);
   });
}

sub aaaa($$) {
   my ($domain, $cb) = @_;

   resolver->resolve ($domain => "aaaa", sub {
      $cb->(map $_->[3], @_);
   });
}

sub mx($$) {
   my ($domain, $cb) = @_;

   resolver->resolve ($domain => "mx", sub {
      $cb->(map $_->[4], sort { $a->[3] <=> $b->[3] } @_);
   });
}

sub ns($$) {
   my ($domain, $cb) = @_;

   resolver->resolve ($domain => "ns", sub {
      $cb->(map $_->[3], @_);
   });
}

sub txt($$) {
   my ($domain, $cb) = @_;

   resolver->resolve ($domain => "txt", sub {
      $cb->(map $_->[3], @_);
   });
}

sub srv($$$$) {
   my ($service, $proto, $domain, $cb) = @_;

   # todo, ask for any and check glue records
   resolver->resolve ("_$service._$proto.$domain" => "srv", sub {
      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 = _munge_ptr AnyEvent::Socket::parse_address ($ip)
      or return $cb->();

   resolver->resolve ($ip => "ptr", sub {
      $cb->(map $_->[3], @_);
   });
}

sub reverse_verify($$) {
   my ($ip, $cb) = @_;
   
   my $ipn = AnyEvent::Socket::parse_address ($ip)
      or return $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;
   };
}

#################################################################################

our $EDNS0 = $ENV{PERL_ANYEVENT_EDNS0}*1; # set to 1 to enable (partial) edns0

our %opcode_id = (
   query  => 0,
   iquery => 1,
   status => 2,
   notify => 4,
   update => 5,
   map +($_ => $_), 3, 6..15
);

our %opcode_str = reverse %opcode_id;

our %rcode_id = (
   noerror  =>  0,
   formerr  =>  1,
   servfail =>  2,
   nxdomain =>  3,
   notimp   =>  4,
   refused  =>  5,
   yxdomain =>  6, # Name Exists when it should not     [RFC 2136]
   yxrrset  =>  7, # RR Set Exists when it should not   [RFC 2136]
   nxrrset  =>  8, # RR Set that should exist does not  [RFC 2136]
   notauth  =>  9, # Server Not Authoritative for zone  [RFC 2136]
   notzone  => 10, # Name not contained in zone         [RFC 2136]
# EDNS0  16    BADVERS   Bad OPT Version                    [RFC 2671]
# EDNS0  16    BADSIG    TSIG Signature Failure             [RFC 2845]
# EDNS0  17    BADKEY    Key not recognized                 [RFC 2845]
# EDNS0  18    BADTIME   Signature out of time window       [RFC 2845]
# EDNS0  19    BADMODE   Bad TKEY Mode                      [RFC 2930]
# EDNS0  20    BADNAME   Duplicate key name                 [RFC 2930]
# EDNS0  21    BADALG    Algorithm not supported            [RFC 2930]
   map +($_ => $_), 11..15
);

our %rcode_str = reverse %rcode_id;

our %type_id = (
   a     =>   1,
   ns    =>   2,
   md    =>   3,
   mf    =>   4,
   cname =>   5,
   soa   =>   6,
   mb    =>   7,
   mg    =>   8,
   mr    =>   9,
   null  =>  10,
   wks   =>  11,
   ptr   =>  12,
   hinfo =>  13,
   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,
   axfr  => 252,
   mailb => 253,
   "*"   => 255,
);

our %type_str = reverse %type_id;

our %class_id = (
   in   =>   1,
   ch   =>   3,
   hs   =>   4,
   none => 254,
   "*"  => 255,
);

our %class_str = reverse %class_id;

sub _enc_name($) {
   pack "(C/a*)*", (split /\./, shift), ""
}

if ($] < 5.008) {
   # special slower 5.6 version
   *_enc_name = sub ($) {
      join "", map +(pack "C/a*", $_), (split /\./, shift), ""
   };
}

sub _enc_qd() {
   (_enc_name $_->[0]) . pack "nn",
     ($_->[1] > 0 ? $_->[1] : $type_id {$_->[1]}),
     ($_->[2] > 0 ? $_->[2] : $class_id{$_->[2] || "in"})
}

sub _enc_rr() {
   die "encoding of resource records is not supported";
}

sub dns_pack($) {
   my ($req) = @_;

   pack "nn nnnn a* a* a* a* a*",
      $req->{id},

      ! !$req->{qr}   * 0x8000
      + $opcode_id{$req->{op}} * 0x0800
      + ! !$req->{aa} * 0x0400
      + ! !$req->{tc} * 0x0200
      + ! !$req->{rd} * 0x0100
      + ! !$req->{ra} * 0x0080
      + ! !$req->{ad} * 0x0020
      + ! !$req->{cd} * 0x0010
      + $rcode_id{$req->{rc}} * 0x0001,

      scalar @{ $req->{qd} || [] },
      scalar @{ $req->{an} || [] },
      scalar @{ $req->{ns} || [] },
      $EDNS0 + scalar @{ $req->{ar} || [] }, # EDNS0 option included here

      (join "", map _enc_qd, @{ $req->{qd} || [] }),
      (join "", map _enc_rr, @{ $req->{an} || [] }),
      (join "", map _enc_rr, @{ $req->{ns} || [] }),
      (join "", map _enc_rr, @{ $req->{ar} || [] }),

      ($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0 option
}

our $ofs;
our $pkt;

# bitches
sub _dec_name {
   my @res;
   my $redir;
   my $ptr = $ofs;
   my $cnt;

   while () {
      return undef if ++$cnt >= 256; # to avoid DoS attacks

      my $len = ord substr $pkt, $ptr++, 1;

      if ($len >= 0xc0) {
         $ptr++;
         $ofs = $ptr if $ptr > $ofs;
         $ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
      } elsif ($len) {
         push @res, substr $pkt, $ptr, $len;
         $ptr += $len;
      } else {
         $ofs = $ptr if $ptr > $ofs;
         return join ".", @res;
      }
   }
}

sub _dec_qd {
   my $qname = _dec_name;
   my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
   [$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
}

our %dec_rr = (
     1 => sub { join ".", unpack "C4", $_ }, # a
     2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
     5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
     6 => sub { 
             local $ofs = $ofs - length;
             my $mname = _dec_name;
             my $rname = _dec_name;
             ($mname, $rname, unpack "NNNNN", substr $pkt, $ofs)
          }, # soa
    11 => sub { ((join ".", unpack "C4", $_), unpack "C a*", substr $_, 4) }, # wks
    12 => sub { local $ofs = $ofs - length; _dec_name }, # ptr
    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_ipv6 ($_) }, # 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;

   my ($rt, $rc, $ttl, $rdlen) = unpack "nn N n", substr $pkt, $ofs; $ofs += 10;
   local $_ = substr $pkt, $ofs, $rdlen; $ofs += $rdlen;

   [
      $name,
      $type_str{$rt}  || $rt,
      $class_str{$rc} || $rc,
      ($dec_rr{$rt} || sub { $_ })->(),
   ]
}

sub dns_unpack($) {
   local $pkt = shift;
   my ($id, $flags, $qd, $an, $ns, $ar)
      = unpack "nn nnnn A*", $pkt;

   local $ofs = 6 * 2;

   {
      id => $id,
      qr => ! ! ($flags & 0x8000),
      aa => ! ! ($flags & 0x0400),
      tc => ! ! ($flags & 0x0200),
      rd => ! ! ($flags & 0x0100),
      ra => ! ! ($flags & 0x0080),
      ad => ! ! ($flags & 0x0020),
      cd => ! ! ($flags & 0x0010),
      op => $opcode_str{($flags & 0x001e) >> 11},
      rc => $rcode_str{($flags & 0x000f)},

      qd => [map _dec_qd, 1 .. $qd],
      an => [map _dec_rr, 1 .. $an],
      ns => [map _dec_rr, 1 .. $ns],
      ar => [map _dec_rr, 1 .. $ar],
   }
}

#############################################################################

use Carp ();
use Scalar::Util ();
use Socket ();

our $NOW;

our $RESOLVER;

sub resolver() {
   $RESOLVER || do {
      $RESOLVER = new AnyEvent::DNS
         untaint         => 1,
         exists $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}
            ? (max_outstanding => $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS}*1 || 1) : (),
      ;

      exists $ENV{PERL_ANYEVENT_RESOLV_CONF}
         ? length $ENV{PERL_ANYEVENT_RESOLV_CONF} && $RESOLVER->_parse_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF})
         : $RESOLVER->os_config;

      $RESOLVER
   }
}

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      server  => [],
      timeout => [2, 5, 5],
      search  => [],
      ndots   => 1,
      max_outstanding => 10,
      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 (socket my $fh4, AF_INET , Socket::SOCK_DGRAM(), 0) {
      ++$got_socket;

      AnyEvent::Util::fh_nonblocking $fh4, 1;
      $self->{fh4} = $fh4;
      $self->{rw4} = AE::io $fh4, 0, sub {
         if (my $peer = recv $fh4, my $pkt, MAX_PKT, 0) {
            $wself->_recv ($pkt, $peer);
         }
      };
   }

   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} = AE::io $fh6, 0, 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
}

sub parse_resolv_conf {
   my ($self, $resolvconf) = @_;

   $self->{server} = [];
   $self->{search} = [];

   my $attempts;

   for (split /\n/, $resolvconf) {
      s/\s*[;#].*$//; # not quite legal, but many people insist

      if (/^\s*nameserver\s+(\S+)\s*$/i) {
         my $ip = $1;
         if (my $ipn = AnyEvent::Socket::parse_address ($ip)) {
            push @{ $self->{server} }, $ipn;
         } else {
            warn "nameserver $ip invalid and ignored\n";
         }
      } elsif (/^\s*domain\s+(\S*)\s*$/i) {
         $self->{search} = [$1];
      } elsif (/^\s*search\s+(.*?)\s*$/i) {
         $self->{search} = [split /\s+/, $1];
      } elsif (/^\s*sortlist\s+(.*?)\s*$/i) {
         # ignored, NYI
      } elsif (/^\s*options\s+(.*?)\s*$/i) {
         for (split /\s+/, $1) {
            if (/^timeout:(\d+)$/) {
               $self->{timeout} = [$1];
            } elsif (/^attempts:(\d+)$/) {
               $attempts = $1;
            } elsif (/^ndots:(\d+)$/) {
               $self->{ndots} = $1;
            } else {
               # debug, rotate, no-check-names, inet6
            }
         }
      }
   }

   $self->{timeout} = [($self->{timeout}[0]) x $attempts]
      if $attempts;

   $self->_compile;
}

sub _parse_resolv_conf_file {
   my ($self, $resolv_conf) = @_;

   open my $fh, "<", $resolv_conf
      or Carp::croak "$resolv_conf: $!";

   local $/;
   $self->parse_resolv_conf (<$fh>);
}

sub os_config {
   my ($self) = @_;

   $self->{server} = [];
   $self->{search} = [];

   if ((AnyEvent::WIN32 || $^O =~ /cygwin/i)) {
      #no strict 'refs';

      # there are many options to find the current nameservers etc. on windows
      # all of them don't work consistently:
      # - 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 Net::DNS::Resolver first, and if it fails, will fall back to
      # ipconfig parsing.
      unless (eval {
         # Net::DNS::Resolver uses a LOT of ram (~10mb), but what can we do :/
         # (this seems mostly to be due to Win32::API).
         require Net::DNS::Resolver;
         my $r = Net::DNS::Resolver->new;

         $r->nameservers
            or die;

         for my $s ($r->nameservers) {
            if (my $ipn = AnyEvent::Socket::parse_address ($s)) {
               push @{ $self->{server} }, $ipn;
            }
         }
         $self->{search} = [$r->searchlist];

         1
      }) {
         # we use ipconfig parsing because, despite all its brokenness,
         # it seems most stable in practise.
         # unfortunately it wants a console window.
         # 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
            # :-lines with DNS in them. everything in those is regarded as
            # either a nameserver (if it parses as an ip address), or a suffix
            # (all else).

            my $dns;
            local $_;
            while (<$fh>) {
               if (s/^\s.*\bdns\b.*://i) {
                  $dns = 1;
               } elsif (/^\S/ || /^\s[^:]{16,}: /) {
                  $dns = 0;
               }
               if ($dns && /^\s*(\S+)\s*$/) {
                  my $s = $1;
                  $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;
                  }
               }
            }
         }
      }

      # always add the fallback servers
      push @{ $self->{server} }, @DNS_FALLBACK;

      $self->_compile;
   } else {
      # try resolv.conf everywhere else

      $self->_parse_resolv_conf_file ("/etc/resolv.conf")
         if -e "/etc/resolv.conf";
   }
}

sub timeout {
   my ($self, @timeout) = @_;

   $self->{timeout} = \@timeout;
   $self->_compile;
}

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} }];

   unless (@{ $self->{server} }) {
      # use 127.0.0.1 by default, and one opendns nameserver as fallback
      $self->{server} = [v127.0.0.1, $DNS_FALLBACK[rand @DNS_FALLBACK]];
   }

   my @retry;

   for my $timeout (@{ $self->{timeout} }) {
      for my $server (@{ $self->{server} }) {
         push @retry, [$server, $timeout];
      }
   }

   $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}};

   return unless ref $id;

   $NOW = time;
   $id->[1]->($res);
}

sub _recv {
   my ($self, $pkt, $peer) = @_;

   # we ignore errors (often one gets port unreachable, but there is
   # no good way to take advantage of that.

   my ($port, $host) = AnyEvent::Socket::unpack_sockaddr ($peer);

   return unless $port == 53 && grep $_ eq $host, @{ $self->{server} };

   $self->_feed ($pkt);
}

sub _free_id {
   my ($self, $id, $timeout) = @_;

   if ($timeout) {
      # we need to block the id for a while
      $self->{id}{$id} = 1;
      push @{ $self->{reuse_q} }, [$NOW + $self->{reuse}, $id];
   } else {
      # we can quickly recycle the id
      delete $self->{id}{$id};
   }

   --$self->{outstanding};
   $self->_scheduler;
}

# execute a single request, involves sending it with timeouts to multiple servers
sub _exec {
   my ($self, $req) = @_;

   my $retry; # of retries
   my $do_retry;

   $do_retry = sub {
      my $retry_cfg = $self->{retry}[$retry++]
         or do {
            # failure
            $self->_free_id ($req->[2], $retry > 1);
            undef $do_retry; return $req->[1]->();
         };

      my ($server, $timeout) = @$retry_cfg;
      
      $self->{id}{$req->[2]} = [(AE::timer $timeout, 0, sub {
         $NOW = time;

         # timeout, try next
         &$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;

               require 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]);
                  });
               });

            }, sub { $timeout });

         } else {
            # success
            $self->_free_id ($req->[2], $retry > 1);
            undef $do_retry; return $req->[1]->($res);
         }
      }];
      
      my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);

      my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
               ? $self->{fh4} : $self->{fh6}
         or return &$do_retry;

      send $fh, $req->[0], 0, $sa;
   };

   &$do_retry;
}

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;

   while ($self->{outstanding} < $self->{max_outstanding}) {

      if (@{ $self->{reuse_q} } >= 30000) {
         # we ran out of ID's, wait a bit
         $self->{reuse_to} ||= AE::timer $self->{reuse_q}[0][0] - $NOW, 0, sub {
            delete $self->{reuse_to};
            $self->_scheduler;
         };
         last;
      }

      if (my $req = shift @{ $self->{queue} }) {
         # found a request in the queue, execute it
         while () {
            $req->[2] = int rand 65536;
            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;
      }
   }
}

sub request($$) {
   my ($self, $req, $cb) = @_;

   push @{ $self->{queue} }, [dns_pack $req, $cb];
   $self->_scheduler;
}

sub resolve($%) {
   my $cb = pop;
   my ($self, $qname, $qtype, %opt) = @_;

   my @search = $qname =~ s/\.$//
      ? ""
      : $opt{search}
        ? @{ $opt{search} }
        : ($qname =~ y/.//) >= $self->{ndots}
          ? ("", @{ $self->{search} })
          : (@{ $self->{search} }, "");

   my $class = $opt{class} || "in";

   my %atype = $opt{accept}
      ? map +($_ => 1), @{ $opt{accept} }
      : ($qtype => 1);

   # advance in searchlist
   my ($do_search, $do_req);
   
   $do_search = sub {
      @search
         or (undef $do_search), (undef $do_req), return $cb->();

      (my $name = lc "$qname." . shift @search) =~ s/\.$//;
      my $depth = 10;

      # advance in cname-chain
      $do_req = sub {
         $self->request ({
            rd => 1,
            qd => [[$name, $qtype, $class]],
         }, sub {
            my ($res) = @_
               or return $do_search->();

            my $cname;

            while () {
               # results found?
               my @rr = grep $name eq lc $_->[0] && ($atype{"*"} || $atype{$_->[1]}), @{ $res->{an} };

               (undef $do_search), (undef $do_req), return $cb->(@rr)
                  if @rr;

               # see if there is a cname we can follow
               my @rr = grep $name eq lc $_->[0] && $_->[1] eq "cname", @{ $res->{an} };

               if (@rr) {
                  $depth--
                     or return $do_search->(); # cname chain too long

                  $cname = 1;
                  $name = lc $rr[0][3];

               } elsif ($cname) {
                  # follow the cname
                  return $do_req->();

               } else {
                  # no, not found anything
                  return $do_search->();
               }
             }
         });
      };

      $do_req->();
   };

   $do_search->();
}

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;