r41030 - in /branches/upstream/libpoe-component-client-dns-perl/current: CHANGES DNS.pm META.yml Makefile.PL t/06_hosts.t

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Thu Jul 30 20:59:45 UTC 2009


Author: jawnsy-guest
Date: Thu Jul 30 20:59:39 2009
New Revision: 41030

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=41030
Log:
[svn-upgrade] Integrating new upstream version, libpoe-component-client-dns-perl (1.04)

Modified:
    branches/upstream/libpoe-component-client-dns-perl/current/CHANGES
    branches/upstream/libpoe-component-client-dns-perl/current/DNS.pm
    branches/upstream/libpoe-component-client-dns-perl/current/META.yml
    branches/upstream/libpoe-component-client-dns-perl/current/Makefile.PL
    branches/upstream/libpoe-component-client-dns-perl/current/t/06_hosts.t

Modified: branches/upstream/libpoe-component-client-dns-perl/current/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-client-dns-perl/current/CHANGES?rev=41030&op=diff
==============================================================================
--- branches/upstream/libpoe-component-client-dns-perl/current/CHANGES (original)
+++ branches/upstream/libpoe-component-client-dns-perl/current/CHANGES Thu Jul 30 20:59:39 2009
@@ -1,3 +1,37 @@
+=================================
+2009-07-28T06:01:31.124742Z v1_04
+=================================
+
+  2009-07-28 06:01:07 (r79) by rcaputo; DNS.pm M; Makefile.PL M
+
+    Use latest POE, and prepare for a new release.
+
+  2009-07-27 04:51:28 (r78) by rcaputo; DNS.pm M; Makefile.PL M
+
+    Added a machine-readable repository directory to the distribution.
+    Documented the bug tracker, repository, and other resource URLs. 
+
+  2009-07-26 06:30:34 (r77) by rcaputo; DNS.pm M; t/06_hosts.t M
+
+    Resolve (heh) rt.cpan.org ticket #13899. AAAA requests will check for
+    IPv6 addresses in /etc/hosts or your favorite operating system's
+    equivalent. 
+
+  2009-07-26 05:59:34 (r76) by rcaputo; DNS.pm M
+
+    Resolve rt.cpan.org ticket #13492 by Sébastien Aperghis-Tramoni,
+    #14723 by Branislav Gerzo, and umbrella ticket #15009 by cycling
+    through the list of resolvers known to Net::DNS if the top one times
+    out. 
+
+  2009-02-18 05:41:14 (r75) by rcaputo; t/06_hosts.t M
+
+    Applied a patch by René Mayorga, resolving rt.cpan.org ticket 41313.
+    René's patch uses Net::DNS to find poe.perl.org's address and use
+    that instead of hardcoded values. Thanks also go to René for
+    submitting the patch through rt.cpan.org. I may never have discovered
+    ticket 506915 on bugs.debian.org. 
+
 =================================
 2009-02-18T04:48:37.232115Z v1_03
 =================================

Modified: branches/upstream/libpoe-component-client-dns-perl/current/DNS.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-client-dns-perl/current/DNS.pm?rev=41030&op=diff
==============================================================================
--- branches/upstream/libpoe-component-client-dns-perl/current/DNS.pm (original)
+++ branches/upstream/libpoe-component-client-dns-perl/current/DNS.pm Thu Jul 30 20:59:39 2009
@@ -1,12 +1,13 @@
-# $Id: DNS.pm 73 2009-02-18 04:48:06Z rcaputo $
+# $Id: DNS.pm 79 2009-07-28 06:01:07Z rcaputo $
 # License and documentation are after __END__.
+# vim: ts=2 sw=2 expandtab
 
 package POE::Component::Client::DNS;
 
 use strict;
 
 use vars qw($VERSION);
-$VERSION = '1.03';
+$VERSION = '1.04';
 
 use Carp qw(croak);
 
@@ -51,6 +52,8 @@
   $timeout = 90 unless $timeout;
 
   my $nameservers = delete $params{Nameservers};
+  my $resolver = Net::DNS::Resolver->new();
+  $nameservers ||= [ $resolver->nameservers() ];
 
   my $hosts = delete $params{HostsFile};
 
@@ -62,7 +65,7 @@
     $alias,                     # SF_ALIAS
     $timeout,                   # SF_TIMEOUT
     $nameservers,               # SF_NAMESERVERS
-    Net::DNS::Resolver->new(),  # SF_RESOLVER
+    $resolver,                  # SF_RESOLVER
     $hosts,                     # SF_HOSTS_FILE
     0,                          # SF_HOSTS_MTIME
     0,                          # SF_HOSTS_CTIME
@@ -73,9 +76,8 @@
   ], $type;
 
   # Set the list of nameservers, if one was supplied.
-  if (defined($nameservers) and ref($nameservers) eq 'ARRAY') {
-    $self->[SF_RESOLVER]->nameservers(@$nameservers);
-  }
+  # May redundantly reset itself.
+  $self->[SF_RESOLVER]->nameservers(@$nameservers);
 
   POE::Session->create(
     object_states => [
@@ -191,13 +193,13 @@
   # -><- This is not always the right thing to do, but it's more right
   # more often than never checking at all.
 
-  if ($type eq "A" and $class eq "IN") {
-    my $address = $self->check_hosts_file($host);
+  if (($type eq "A" or $type eq "AAAA") and $class eq "IN") {
+    my $address = $self->check_hosts_file($host, $type);
 
     if (defined $address) {
       # Pretend the request went through a name server.
 
-      my $packet = Net::DNS::Packet->new($address, "A", "IN");
+      my $packet = Net::DNS::Packet->new($address, $type, "IN");
       $packet->push(
         "answer",
         Net::DNS::RR->new(
@@ -244,6 +246,7 @@
       started   => $now,
       ends      => $now + $timeout,
       api_ver   => $api_version,
+      nameservers => [ $self->[SF_RESOLVER]->nameservers() ],
     }
   );
 }
@@ -284,14 +287,16 @@
 
   $self->[SF_REQ_BY_SOCK]->{$resolver_socket} = $req;
 
-  $kernel->delay($resolver_socket, $remaining, $resolver_socket);
+  $kernel->delay($resolver_socket, $remaining / 2, $resolver_socket);
   $kernel->select_read($resolver_socket, 'got_dns_response');
 
   # Save the socket for pre-emptive shutdown.
   $req->{resolver_socket} = $resolver_socket;
 }
 
-# A resolver query timed out.  Post an error back.
+# A resolver query timed out.  Keep trying until we run out of time.
+# Also, if the top nameserver is the one we tried, then cycle the
+# nameservers.
 
 sub _dns_default {
   my ($self, $kernel, $event, $args) = @_[OBJECT, KERNEL, ARG0, ARG1];
@@ -305,12 +310,31 @@
   # Stop watching the socket.
   $kernel->select_read($socket);
 
-  # Post back an undefined response, indicating we timed out.
-  _send_response(
-    %$req,
-    response => undef,
-    error    => "timeout",
-  );
+  # No more time remaining?  We must time out.
+  my $remaining = $req->{ends} - time();
+  if ($remaining <= 0) {
+    _send_response(
+      %$req,
+      response => undef,
+      error    => "timeout",
+    );
+    return;
+  }
+
+  # There remains time.  Let's try again.
+
+  # The nameserver we tried has failed us.  If it's the top
+  # nameserver in Net::DNS's list, then send it to the back and retry.
+
+  my @nameservers = $self->[SF_RESOLVER]->nameservers();
+  if ($nameservers[0] eq $req->{nameservers}[0]) {
+    push @nameservers, shift(@nameservers);
+    $self->[SF_RESOLVER]->nameservers(@nameservers);
+    $req->{nameservers} = \@nameservers;
+  }
+
+  # Retry.
+  $kernel->yield(send_request => $req);
 
   # Don't accidentally handle signals.
   return;
@@ -420,7 +444,7 @@
 ### NOT A POE EVENT HANDLER
 
 sub check_hosts_file {
-  my ($self, $host) = @_;
+  my ($self, $host, $type) = @_;
 
   # Use the hosts file that was specified, or find one.
   my $use_hosts_file;
@@ -487,22 +511,18 @@
       s/^\s*//;
       chomp;
       my ($address, @aliases) = split;
-
+      my $type = ($address =~ /:/) ? "AAAA" : "A";
       foreach my $alias (@aliases) {
-        $cached_hosts{$alias}{$address} = 1;
+        $cached_hosts{$alias}{$type}{$address} = 1;
       }
     }
     close HOST;
 
     # Normalize our cached hosts.
-    foreach my $alias (keys %cached_hosts) {
-      my @addresses = keys %{$cached_hosts{$alias}};
-      my @ipv4 = grep /\./, @addresses;
-      if (@ipv4) {
-        $cached_hosts{$alias} = $ipv4[0];
-        next;
+    while (my ($alias, $type_rec) = each %cached_hosts) {
+      while (my ($type, $address_rec) = each %$type_rec) {
+        $cached_hosts{$alias}{$type} = (keys %$address_rec)[0];
       }
-      $cached_hosts{$alias} = $addresses[0];
     }
 
     $self->[SF_HOSTS_CACHE] = \%cached_hosts;
@@ -513,7 +533,11 @@
   }
 
   # Return whatever match we have.
-  return $self->[SF_HOSTS_CACHE]{$host};
+  return unless (
+    (exists $self->[SF_HOSTS_CACHE]{$host}) and
+    (exists $self->[SF_HOSTS_CACHE]{$host}{$type})
+  );
+  return $self->[SF_HOSTS_CACHE]{$host}{$type};
 }
 
 ### NOT A POE EVENT HANDLER
@@ -721,13 +745,6 @@
 L<Net::DNS::Packet> - Responses are returned as Net::DNS::Packet
 objects.
 
-=head1 BUGS
-
-This component does not yet expose the full power of Net::DNS.
-
-Timeouts have not been tested extensively.  Please contact the author
-if you know of a reliable way to test DNS timeouts.
-
 =head1 DEPRECATIONS
 
 The older, list-based interfaces are no longer documented as of
@@ -746,15 +763,25 @@
 errors.  Support for the deprecated interfaces will be removed
 entirely.
 
+=head1 BUG TRACKER
+
+https://rt.cpan.org/Dist/Display.html?Status=Active&Queue=POE-Component-Client-DNS
+
+=head1 REPOSITORY
+
+http://thirdlobe.com/svn/poco-client-dns/
+
+=head1 OTHER RESOURCES
+
+http://search.cpan.org/dist/POE-Component-Client-DNS/
+
 =head1 AUTHOR & COPYRIGHTS
 
-POE::Component::Client::DNS is Copyright 1999-2004 by Rocco Caputo.
+POE::Component::Client::DNS is Copyright 1999-2009 by Rocco Caputo.
 All rights are reserved.  POE::Component::Client::DNS is free
 software; you may redistribute it and/or modify it under the same
 terms as Perl itself.
 
 Postback arguments were contributed by tag.
 
-Rocco may be contacted by e-mail via rcaputo at cpan.org.
-
 =cut

Modified: branches/upstream/libpoe-component-client-dns-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-client-dns-perl/current/META.yml?rev=41030&op=diff
==============================================================================
--- branches/upstream/libpoe-component-client-dns-perl/current/META.yml (original)
+++ branches/upstream/libpoe-component-client-dns-perl/current/META.yml Thu Jul 30 20:59:39 2009
@@ -1,16 +1,27 @@
 --- #YAML:1.0
-name:                POE-Component-Client-DNS
-version:             1.03
-abstract:            Non-blocking/concurrent DNS queries using Net::DNS and POE
-license:             perl
-author:              
+name:               POE-Component-Client-DNS
+version:            1.04
+abstract:           Non-blocking/concurrent DNS queries using Net::DNS and POE
+author:
     - Rocco Caputo <rcaputo at cpan.org>
-generated_by:        ExtUtils::MakeMaker version 6.42
-distribution_type:   module
-requires:     
-    Net::DNS:                      0.59
-    POE:                           0.31
-    Test::More:                    0
+license:            perl
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    Net::DNS:    0.59
+    POE:         1.007
+    Test::More:  0
+resources:
+    license:     http://dev.perl.org/licenses/
+    repository:  http://thirdlobe.com/svn/poco-client-dns/trunk
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.54
 meta-spec:
-    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
-    version: 1.3
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4

Modified: branches/upstream/libpoe-component-client-dns-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-client-dns-perl/current/Makefile.PL?rev=41030&op=diff
==============================================================================
--- branches/upstream/libpoe-component-client-dns-perl/current/Makefile.PL (original)
+++ branches/upstream/libpoe-component-client-dns-perl/current/Makefile.PL Thu Jul 30 20:59:39 2009
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: Makefile.PL 62 2006-11-06 19:23:35Z rcaputo $
+# $Id: Makefile.PL 79 2009-07-28 06:01:07Z rcaputo $
 
 use ExtUtils::MakeMaker;
 
@@ -14,9 +14,15 @@
   VERSION_FROM => 'DNS.pm',
   PM           => { 'DNS.pm' => '$(INST_LIBDIR)/DNS.pm' },
   PREREQ_PM    => {
-    'POE'        => 0.31,
+    'POE'        => 1.007,
     'Net::DNS'   => 0.59,
     'Test::More' => 0,
+  },
+  META_ADD     => {
+    resources  => {
+      license    => 'http://dev.perl.org/licenses/',
+      repository => 'http://thirdlobe.com/svn/poco-client-dns/trunk'
+    },
   },
   dist         => {
     COMPRESS   => 'gzip -9f',

Modified: branches/upstream/libpoe-component-client-dns-perl/current/t/06_hosts.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libpoe-component-client-dns-perl/current/t/06_hosts.t?rev=41030&op=diff
==============================================================================
--- branches/upstream/libpoe-component-client-dns-perl/current/t/06_hosts.t (original)
+++ branches/upstream/libpoe-component-client-dns-perl/current/t/06_hosts.t Thu Jul 30 20:59:39 2009
@@ -1,5 +1,5 @@
 #!/usr/bin/perl
-# $Id: 06_hosts.t 70 2009-01-13 20:08:27Z rcaputo $
+# $Id: 06_hosts.t 77 2009-07-26 06:30:34Z rcaputo $
 # vim: filetype=perl
 
 # Test the hosts file stuff.
@@ -8,10 +8,17 @@
 use strict;
 sub POE::Kernel::ASSERT_DEFAULT () { 1 }
 use POE qw(Component::Client::DNS);
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 require Net::DNS;
 my $can_resolve = Net::DNS::Resolver->new->search("poe.perl.org");
+
+my %target_address;
+if ($can_resolve) {
+  foreach ($can_resolve->answer()) {
+    $target_address{$_->address} = 1 if $_->type eq "A";
+  }
+}
 
 use constant HOSTS_FILE => "./test-hosts";
 
@@ -23,11 +30,12 @@
 
 POE::Session->create(
   inline_states  => {
-    _start                 => \&start_tests,
-    _stop                  => sub { }, # avoid assert problems
-    response_no_hosts      => \&response_no_hosts,
-    response_hosts_match   => \&response_hosts_match,
-    response_hosts_nomatch => \&response_hosts_nomatch,
+    _start                  => \&start_tests,
+    _stop                   => sub { }, # avoid assert problems
+    response_no_hosts       => \&response_no_hosts,
+    response_hosts_match_v4 => \&response_hosts_match_v4,
+    response_hosts_match_v6 => \&response_hosts_match_v6,
+    response_hosts_nomatch  => \&response_hosts_nomatch,
   }
 );
 
@@ -52,7 +60,7 @@
     skip "Can't resolve with Net::DNS, network probably not available", 1
       unless($can_resolve);
     ok(
-      ($address eq "67.207.145.70") || ($address eq "208.97.190.64"),
+      exists $target_address{$address},
       "lookup with no hosts file ($address)"
     );
   }
@@ -61,21 +69,39 @@
   unlink HOSTS_FILE;  # Changes inode!
   open(HF, ">" . HOSTS_FILE) or die "couldn't write hosts file: $!";
   print HF "123.45.67.89 poe.perl.org\n";
+  print HF "::1 hocallost\n";
   close HF;
 
   $resolver->resolve(
-    event   => "response_hosts_match",
+    event   => "response_hosts_match_v4",
     host    => "poe.perl.org",
     context => "whatever",
   );
 }
 
-sub response_hosts_match {
+sub response_hosts_match_v4 {
   my $response = $_[ARG0];
   my $address = a_data($response);
+
   ok(
     $address eq "123.45.67.89",
     "lookup when hosts file matches ($address)"
+  );
+
+  $resolver->resolve(
+    event   => "response_hosts_match_v6",
+    host    => "hocallost",
+    context => "whatever",
+    type    => "AAAA",
+  );
+}
+
+sub response_hosts_match_v6 {
+  my $response = $_[ARG0];
+  my $address = aaaa_data($response);
+  ok(
+    $address eq "0:0:0:0:0:0:0:1",
+    "ipv6 lookup when hosts file matches ($address)"
   );
 
   # 3. Test against a hosts file without a host match.
@@ -98,7 +124,7 @@
     skip "Can't resolve with Net::DNS, network probably not available", 1
       unless($can_resolve);
     ok(
-      ($address eq "67.207.145.70") || ($address eq "208.97.190.64"),
+      exists $target_address{$address},
       "lookup with hosts file but no match ($address)"
     );
   }
@@ -106,7 +132,7 @@
   unlink HOSTS_FILE;
 }
 
-### Not a POE event handler.
+### Not POE event handlers.
 
 sub a_data {
   my $response = shift;
@@ -116,3 +142,14 @@
     grep { ref() eq "Net::DNS::RR::A" } $response->{response}->answer()
   )[0]->rdatastr();
 }
+
+
+sub aaaa_data {
+  my $response = shift;
+  return "" unless defined $response->{response};
+  return (
+    grep { ref() eq "Net::DNS::RR::AAAA" } $response->{response}->answer()
+  )[0]->rdatastr();
+}
+
+




More information about the Pkg-perl-cvs-commits mailing list