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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.61 by root, Wed Jun 4 09:55:16 2008 UTC vs.
Revision 1.106 by root, Fri Jul 17 18:08:35 2009 UTC

 package AnyEvent::DNS;
 no warnings;
 use strict;
+use Carp ();
 use Socket qw(AF_INET SOCK_DGRAM SOCK_STREAM);
 use AnyEvent ();
-use AnyEvent::Handle ();
 use AnyEvent::Util qw(AF_INET6);
-our $VERSION = 4.12;
+our $VERSION = 4.83;
 our @DNS_FALLBACK = (v208.67.220.220, v208.67.222.222);
 =item AnyEvent::DNS::a $domain, $cb->(@addrs)
       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;
 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,
    mx    =>  15,
    txt   =>  16,
    aaaa  =>  28,
    srv   =>  33,
    naptr =>  35, # rfc2915
+   dname =>  39, # rfc2672
    opt   =>  41,
    spf   =>  99,
    tkey  => 249,
    tsig  => 250,
    ixfr  => 251,
 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]}),
     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_address ($_) }, # aaaa
+    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;
 calls.
 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}
+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.
 =cut
 our $RESOLVER;
 sub resolver() {
    $RESOLVER || do {
-      $RESOLVER = new AnyEvent::DNS;
+      $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->os_config;
       $RESOLVER
    }
 }
 =item $resolver = new AnyEvent::DNS key => value...
 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) = @_;
-   # 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  => [],
    }, $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
 }
-=item $resolver->parse_resolv_conv ($string)
+=item $resolver->parse_resolv_conf ($string)
 Parses the given string as if it were a F<resolv.conf> file. The following
 directives are supported (but not necessarily implemented).
 C<#>-style comments, C<nameserver>, C<domain>, C<search>, C<sortlist>,
       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>);
+}
 =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) = @_;
    $self->{server} = [];
    $self->{search} = [];
-   if (AnyEvent::WIN32 || $^O =~ /cygwin/i) {
+   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
          push @{ $self->{server} }, $DNS_FALLBACK[rand @DNS_FALLBACK];
          $self->_compile;
       }
    } else {
-      # try resolv.conf everywhere
+      # try resolv.conf everywhere else
-      if (open my $fh, "</etc/resolv.conf") {
+      $self->_parse_resolv_conf_file ("/etc/resolv.conf")
-         local $/;
+         if -e "/etc/resolv.conf";
-         $self->parse_resolv_conf (<$fh>);
-      }
    }
 }
 =item $resolver->timeout ($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}};
       $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;
+               require AnyEvent::Handle;
                my $handle; $handle = new AnyEvent::Handle
                   fh       => $fh,
                   timeout  => $timeout,
                   on_error => sub {
          }
       }];
       my $sa = AnyEvent::Socket::pack_sockaddr (DOMAIN_PORT, $server);
-      my $fh = AF_INET == Socket::sockaddr_family ($sa)
+      my $fh = AF_INET == AnyEvent::Socket::sockaddr_family ($sa)
                ? $self->{fh4} : $self->{fh6}
          or return &$do_retry;
       send $fh, $req->[0], 0, $sa;
    };
    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 records) or
 a lowercase name (you have to look at the source to see which aliases are
 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 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 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 fourth entry.
                if (@rr) {
                   $depth--
                      or return $do_search->(); # cname chain too long
                   $cname = 1;
-                  $name = $rr[0][3];
+                  $name = lc $rr[0][3];
                } elsif ($cname) {
                   # follow the cname
                   return $do_req->();

Diff Legend

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

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents): Revision 1.61 by root, Wed Jun 4 09:55:16 2008 UTC vs. Revision 1.106 by root, Fri Jul 17 18:08:35 2009 UTC

Diff Legend

Comparing AnyEvent/lib/AnyEvent/DNS.pm (file contents):
Revision 1.61 by root, Wed Jun 4 09:55:16 2008 UTC vs.
Revision 1.106 by root, Fri Jul 17 18:08:35 2009 UTC