view release on metacpan or  search on metacpan

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

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)
by storing it in this variable, causing all subsequent resolves done via
C<AnyEvent::DNS::resolver> to be done via the custom one.

=cut

our $RESOLVER;

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

      $ENV{PERL_ANYEVENT_RESOLV_CONF}
         ? $RESOLVER->_load_resolv_conf_file ($ENV{PERL_ANYEVENT_RESOLV_CONF})
         : $RESOLVER->os_config;

      $RESOLVER
   }
}

=item $resolver = new AnyEvent::DNS key => value...

Creates and returns a new resolver.

The following options are supported:

=over 4

=item server => [...]

A list of server addresses (default: C<v127.0.0.1> or C<::1>) in network
format (i.e. as returned by C<AnyEvent::Socket::parse_address> - both IPv4
and IPv6 are supported).

=item timeout => [...]

A list of timeouts to use (also determines the number of retries). To make
three retries with individual time-outs of 2, 5 and 5 seconds, use C<[2,
5, 5]>, which is also the default.

=item search => [...]

The default search list of suffixes to append to a domain name (default: none).

=item ndots => $integer

The number of dots (default: C<1>) that a name must have so that the resolver
tries to resolve the name without any suffixes first.

=item max_outstanding => $integer

Most name servers do not handle many parallel requests very well. This
option limits the number of outstanding requests to C<$integer>
(default: C<10>), that means if you request more than this many requests,
then the additional requests will be queued until some other requests have
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 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) = @_;

   my $self = bless {
      server  => [],
      timeout => [2, 5, 5],
      search  => [],
      ndots   => 1,
      max_outstanding => 10,
      reuse   => 300,
      %arg,
      inhibit => 0,
      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::fh_unblock $fh4;
      $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::fh_unblock $fh6;
      $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

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

   }
}

=item $resolver->timeout ($timeout, ...)

Sets the timeout values. See the C<timeout> constructor argument (and
note that this method expects the timeout values themselves, 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->_compile;
}

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/::1 by default, add public nameservers as fallback
      my $default = $AnyEvent::PROTOCOL{ipv6} > $AnyEvent::PROTOCOL{ipv4}
                    ? "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\1" : "\x7f\x00\x00\x01";
      $self->{server} = [$default, @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 == DOMAIN_PORT && 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;