Attached is a patch that moves the logic from Question.pm to Resolver/
Base.pm
I didn't re-do all the 03-question.t tests; but I did make sure the
other tests exercising this feature still pass.
Attached here and inline below for easier review.
Message body is not shown because sender requested not to inline it.
From 43cccf4dcce6e239f5133004c05afa46b2429562 Mon Sep 17 00:00:00 2001
From: Ask Bjoern Hansen <ask@develooper.com>
Date: Tue, 9 Oct 2007 21:40:01 -0700
Subject: [PATCH] move the "make PTR request if it looks like an IP
address" logic to
Net::DNS::Resolver::Base from Net::DNS::Question (basically keep the
lower-level code cleaner)
---
lib/Net/DNS/Question.pm | 39 ++
+------------------------------------
lib/Net/DNS/Resolver/Base.pm | 36 +++++++++++++++++++++++++++++++++++-
t/03-question.t | 36 +++++++++++++++++-------------------
3 files changed, 55 insertions(+), 56 deletions(-)
diff --git a/lib/Net/DNS/Question.pm b/lib/Net/DNS/Question.pm
index 290af08..186cd60 100644
--- a/lib/Net/DNS/Question.pm
+++ b/lib/Net/DNS/Question.pm
@@ -44,8 +44,9 @@ queries in in-addr.arpa and ip6.arpa subdomains.
sub new {
my $class = shift;
- my $qname = defined ($_ = shift) ? $_ : '';
- my $qtype = uc shift || 'A';
+ my $qname = shift;
+ $qname = '' unless defined $qname;
+ my $qtype = uc shift || 'A';
my $qclass = uc shift || 'IN';
$qname =~ s/\.+$//o; # strip gratuitous trailing dot
@@ -56,12 +57,6 @@ sub new {
if exists $Net::DNS::classesbyname{$qtype}
and exists $Net::DNS::typesbyname{$qclass};
- # if argument is an IP address, do appropriate reverse lookup
- if ( $qname =~ m/\d$|[:\/]/o ) {
- my $type = $qtype =~ m/^(A|AAAA)$/o ? 'PTR' : $qtype;
- ($qname, $qtype) = ($_, $type) if $_ = dns_addr($qname);
- }
-
my $self = { qname => $qname,
qtype => $qtype,
qclass => $qclass
@@ -71,34 +66,6 @@ sub new {
}
-sub dns_addr {
- my $arg = shift; # name or IP address
-
- # If arg looks like IP4 address then map to in-addr.arpa space
- if ( $arg =~ /((^|\d+\.)+\d+)($|\/(\d*))/o ) {
- my @parse = split /\./, $1;
- my $last = ($_ = ($4 || @parse<<3)) > 24 ? 3 : ($_-1)>>3;
- return join '.', reverse( (@parse,(0)x3)[0 .. $last] ), 'in-
addr.arpa';
- }
-
- # If arg looks like IP6 address then map to ip6.arpa space
- if ( $arg =~ /^((\w*:)+)(\w*)($|\/(\d*))/o ) {
- my @parse = split /:/, (reverse "0${1}0${3}"), 9;
- my @xpand = map{/^$/ ? ('0')x(9-@parse) : $_} @parse;
- my $hex = pack 'A4'x8, map{$_.'000'} ('0')x(8-@xpand), @xpand;
-
- # $5 is the bit in the argument that maps to the prefix length
- # When not available then the number of elements in the expand
- # array reflectst the prefix length (hex to bit conversion)
- my $len = ($_ = ($5 || @xpand<<4)) > 124 ? 32 : ($_+3)>>2;
- return join '.', split(//, substr($hex,-$len) ), 'ip6.arpa';
- }
-
- return undef;
-}
-
-
-
#
# Some people have reported that Net::DNS dies because AUTOLOAD picks up
diff --git a/lib/Net/DNS/Resolver/Base.pm b/lib/Net/DNS/Resolver/Base.pm
index d995d87..47148c8 100644
--- a/lib/Net/DNS/Resolver/Base.pm
+++ b/lib/Net/DNS/Resolver/Base.pm
@@ -1054,7 +1054,14 @@ sub make_query_packet {
if (ref($_[0]) and $_[0]->isa('Net::DNS::Packet')) {
$packet = shift;
} else {
- $packet = Net::DNS::Packet->new(@_);
+ my ($qname, $qtype) = (shift , shift);
+ $qtype ||= 'A';
+ # if argument is an IP address, do appropriate
reverse lookup
+ if ( $qname =~ m/\d$|[:\/]/o ) {
+ my $type = $qtype =~ m/^(A|AAAA)$/o ? 'PTR' :
$qtype;
+ ($qname, $qtype) = ($_, $type) if $_ = dns_addr
($qname);
+ }
+ $packet = Net::DNS::Packet->new($qname, $qtype, @_);
}
if ($packet->header->opcode eq 'QUERY') {
@@ -1100,6 +1107,33 @@ sub make_query_packet {
return $packet;
}
+sub dns_addr {
+ my $arg = shift; # name or IP address
+
+ # If arg looks like IP4 address then map to in-addr.arpa space
+ if ( $arg =~ /((^|\d+\.)+\d+)($|\/(\d*))/o ) {
+ my @parse = split /\./, $1;
+ my $last = ($_ = ($4 || @parse<<3)) > 24 ? 3 : ($_-1)>>3;
+ return join '.', reverse( (@parse,(0)x3)[0 .. $last] ), 'in-
addr.arpa';
+ }
+
+ # If arg looks like IP6 address then map to ip6.arpa space
+ if ( $arg =~ /^((\w*:)+)(\w*)($|\/(\d*))/o ) {
+ my @parse = split /:/, (reverse "0${1}0${3}"), 9;
+ my @xpand = map{/^$/ ? ('0')x(9-@parse) : $_} @parse;
+ my $hex = pack 'A4'x8, map{$_.'000'} ('0')x(8-@xpand), @xpand;
+
+ # $5 is the bit in the argument that maps to the prefix length
+ # When not available then the number of elements in the expand
+ # array reflectst the prefix length (hex to bit conversion)
+ my $len = ($_ = ($5 || @xpand<<4)) > 124 ? 32 : ($_+3)>>2;
+ return join '.', split(//, substr($hex,-$len) ), 'ip6.arpa';
+ }
+
+ return undef;
+}
+
+
sub axfr {
my $self = shift;
my @zone;
diff --git a/t/03-question.t b/t/03-question.t
index 01ad78f..bc5376f 100644
--- a/t/03-question.t
+++ b/t/03-question.t
@@ -1,6 +1,6 @@
# $Id$ -*-perl-*-
-use Test::More tests => 31;
+use Test::More tests => 14;
use strict;
BEGIN { use_ok('Net::DNS'); }
@@ -39,16 +39,15 @@ is($q->qclass, 'CH', 'qclass()' );
-my $q2= Net::DNS::Question->new("::1","IN","A");
-is ($q2->qname,
'1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arp
a','v6: qname()');
-is($q2->qtype, 'PTR', 'v6: qtype()' );
-is($q2->qclass, 'IN', 'v6: qclass()' );
+#my $q2= Net::DNS::Question->new("::1","IN","A");
+#is ($q2->qname,
'1.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arp
a','v6: qname()');
+#is($q2->qtype, 'PTR', 'v6: qtype()' );
+#is($q2->qclass, 'IN', 'v6: qclass()' );
-
-my $q3= Net::DNS::Question->new("192.168.1.16","IN","A");
-is($q3->qname, '16.1.168.192.in-addr.arpa','v4: qname()');
-is($q3->qtype, 'PTR', 'v4: qtype()' );
-is($q3->qclass, 'IN', 'v4: qclass()' );
+#my $q3= Net::DNS::Question->new("192.168.1.16","IN","A");
+#is($q3->qname, '16.1.168.192.in-addr.arpa','v4: qname()');
+#is($q3->qtype, 'PTR', 'v4: qtype()' );
+#is($q3->qclass, 'IN', 'v4: qclass()' );
@@ -64,12 +63,12 @@ my @prefixes=qw (
2001:0DB8:0:CD30:123:4567:89AB:CDEF/60
);
-foreach my $prefix (@prefixes ){
- my $q5= Net::DNS::Question->new($prefix,"IN","A");
- is($q5->qname, '3.D.C.0.0.0.0.8.B.D.0.1.0.0.2.ip6.arpa','v6:
prefix notation for '. $prefix);
- is($q5->qtype, 'PTR', 'v6: PTR for ' . $prefix );
-
-}
+#foreach my $prefix (@prefixes ){
+# my $q5= Net::DNS::Question->new($prefix,"IN","A");
+# is($q5->qname, '3.D.C.0.0.0.0.8.B.D.0.1.0.0.2.ip6.arpa','v6:
prefix notation for '. $prefix);
+# is($q5->qtype, 'PTR', 'v6: PTR for ' . $prefix );
+#
+#}
my $q6= Net::DNS::Question->new($prefixes[1],"IN","NS");
@@ -83,7 +82,6 @@ is($q7->qtype, 'SOA', 'v6: SOA done
correctly' );
my $q8= Net::DNS::Question->new("::1.de","IN","A");
is ($q8->qname, '::1.de',"No expantion under TLD ");
-my $q9= Net::DNS::Question->new('0');
-
-is ($q9->qname, "0.in-addr.arpa","Zero gets treated as IP address");
+#my $q9= Net::DNS::Question->new('0');
+#is ($q9->qname, "0.in-addr.arpa","Zero gets treated as IP address");
--
1.5.3.2
