view release on metacpan or  search on metacpan

lib/AnyEvent/DNS.pm  view on Meta::CPAN

     'id' => 64265,
     'aa' => '',
     'an' => [
               [ 'www.google.de', 'cname', 'in', 3600, 'www.google.com' ],
               [ 'www.google.com', 'cname', 'in', 3600, 'www.l.google.com' ],
               [ 'www.l.google.com', 'a', 'in', 3600, '66.249.93.104' ],
               [ 'www.l.google.com', 'a', 'in', 3600, '66.249.93.147' ],
             ],
     'rd' => 1,
     'op' => 0,
     '__' => '<original dns packet>',
   }

=cut

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

   local $ofs = 6 * 2;

   {
      __ => $pkt,
      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],
   }
}

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

=back

=head3 Extending DNS Encoder and Decoder

This section describes an I<experimental> method to extend the DNS encoder
and decoder with new opcode, rcode, class and type strings, as well as
resource record decoders.

Since this is experimental, it can change, as anything can change, but
this interface is expe ctedc to be relatively stable and was stable during
the whole existance of C<AnyEvent::DNS> so far.

Note that, since changing the decoder or encoder might break existing
code, you should either be sure to control for this, or only temporarily
change these values, e.g. like so:

   my $decoded = do {
      local $AnyEvent::DNS::opcode_str{7} = "yxrrset";
      AnyEvent::DNS::dns_unpack $mypkt
   };

=over 4

=item %AnyEvent::DNS::opcode_id, %AnyEvent::DNS::opcode_str

Two hashes that map lowercase opcode strings to numerical id's (For the
encoder), or vice versa (for the decoder). Example: add a new opcode
string C<notzone>.

   $AnyEvent::DNS::opcode_id{notzone} = 10;
   $AnyEvent::DNS::opcode_str{10} = 'notzone';

=item %AnyEvent::DNS::rcode_id, %AnyEvent::DNS::rcode_str

Same as above, for for rcode values.

=item %AnyEvent::DNS::class_id, %AnyEvent::DNS::class_str

Same as above, but for resource record class names/values.

=item %AnyEvent::DNS::type_id, %AnyEvent::DNS::type_str

Same as above, but for resource record type names/values.

=item %AnyEvent::DNS::dec_rr

This hash maps resource record type values to code references. When
decoding, they are called with C<$_> set to the undecoded data portion and
C<$ofs> being the current byte offset. of the record. You should have a
look at the existing implementations to understand how it works in detail,
but here are two examples:

Decode an A record. A records are simply four bytes with one byte per
address component, so the decoder simply unpacks them and joins them with
dots in between:

   $AnyEvent::DNS::dec_rr{1} = sub { join ".", unpack "C4", $_ };

Decode a CNAME record, which contains a potentially compressed domain
name.

   package AnyEvent::DNS; # for %dec_rr, $ofsd and &_dec_name
   $dec_rr{5} = sub { local $ofs = $ofs - length; _dec_name };

=back

=head2 THE AnyEvent::DNS RESOLVER CLASS

This is the class which does the actual protocol work.

=over 4

=cut

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

our $NOW;

=item AnyEvent::DNS::resolver

This function creates and returns a resolver that is ready to use and
should mimic the default resolver for your system as good as possible. It
is used by AnyEvent itself as well.

It only ever creates one resolver and returns this one on subsequent calls
- see C<$AnyEvent::DNS::RESOLVER>, below, for details.

Unless you have special needs, prefer this function over creating your own
resolver object.

The resolver is created with the following parameters:

   untaint          enabled
   max_outstanding  $ENV{PERL_ANYEVENT_MAX_OUTSTANDING_DNS} (default 10)

C<os_config> will be used for OS-specific configuration, unless
C<$ENV{PERL_ANYEVENT_RESOLV_CONF}> is specified, in which case that file
gets parsed.

=item $AnyEvent::DNS::RESOLVER

This variable stores the default resolver returned by
C<AnyEvent::DNS::resolver>, or C<undef> when the default resolver hasn't
been instantiated yet.

One can provide a custom resolver (e.g. one with caching functionality)

lib/AnyEvent/DNS.pm  view on Meta::CPAN

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

   return if $self->{inhibit};

   #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
         $cb->($self);

      } else {
         # nothing to do, just exit
         last;
      }
   }
}

=item $resolver->request ($req, $cb->($res))

This is the main low-level workhorse for sending DNS requests.

This function sends a single request (a hash-ref formated as specified
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. It does not
handle anything else, such as the domain searchlist or relative names -
use C<< ->resolve >> for that.

Calls the callback with the decoded response packet if a reply was
received, or no arguments in case none of the servers answered.

=cut

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

   # _enc_name barfs on names that are too long, which is often outside
   # program control, so check for too long names here.
   for (@{ $req->{qd} }) {
      return AE::postpone sub { $cb->(undef) }
         if 255 < length $_->[0];
   }

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

=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 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 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 10.

The callback will be invoked with arraryefs of the form C<[$name,
$type, $class, $ttl, @data>], where C<$name> is the domain name,
C<$type> a type string or number, C<$class> a class name, C<$ttl> is the
remaining time-to-live and C<@data> is resource-record-dependent data, in
seconds. 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>, C<naptr> and C<spf> are
decoded. All resource records not known to this module will have the raw
C<rdata> field as fifth array element.

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.

The following options are supported:

=over 4

=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> values define its value (depending on C<ndots>, the
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
else. If this list includes C<cname>, then CNAME-chains will not be
followed (because you asked for the CNAME record).

=item class => "class"

Specify the query class ("in" for internet, "ch" for chaosnet and "hs" for
hesiod are the only ones making sense). The default is "in", of course.

=back

Examples:

   # full example, you can paste this into perl:
   use Data::Dumper;
   use AnyEvent::DNS;
   AnyEvent::DNS::resolver->resolve (
      "google.com", "*", my $cv = AnyEvent->condvar);
   warn Dumper [$cv->recv];

   # shortened result:
   # [
   #   [ 'google.com', 'soa', 'in', 3600, 'ns1.google.com', 'dns-admin.google.com',
   #     2008052701, 7200, 1800, 1209600, 300 ],
   #   [
   #     'google.com', 'txt', 'in', 3600,
   #     'v=spf1 include:_netblocks.google.com ~all'
   #   ],
   #   [ 'google.com', 'a', 'in', 3600, '64.233.187.99' ],
   #   [ 'google.com', 'mx', 'in', 3600, 10, 'smtp2.google.com' ],
   #   [ 'google.com', 'ns', 'in', 3600, 'ns2.google.com' ],
   # ]

   # resolve a records:
   $res->resolve ("ruth.plan9.de", "a", sub { warn Dumper [@_] });

   # result:
   # [
   #   [ 'ruth.schmorp.de', 'a', 'in', 86400, '129.13.162.95' ]