On Wed Jul 19 11:49:15 2017, BIGPRESH wrote:
Show quoted text> I ran into a problem in RT #109266 where a change to
> Net::DNS::Resolver::Programmable led to pre-prepared Net::DNS::Packet
> objects getting passed to Net::DNS::Question->new().
>
> In that case, Net::DNS::Question->new() accepts them:
>
> $ my $q1 = Net::DNS::Question->new('www.google.com', 'A');
> $Net_DNS_Question1 = Net::DNS::Question=HASH(0x4100360);
>
> $ my $q2 = Net::DNS::Question->new( Net::DNS::Packet-
> >new('www.google.com', 'A') );
> $Net_DNS_Question1 = Net::DNS::Question=HASH(0x41f6f10);
>
> $ $q1->string;
> www.google.com. IN A
> $ $q2->string;
> Net::DNS::Packet=HASH\(0x41f6e08). IN A
>
> That's not too helpful; it's the caller's fault, but I think it would
> be nice if Net::DNS::Question->new would:
>
> * complain if passed a reference to something it can't meaningfully
> handle
> * if passed a Net::DNS::Packet object, just return $packet-
> >question,as that's ultimately the info the caller was looking for
If you are trying to emulate Net::DNS resolver behaviour, then it it not unreasonable to make it "send" the pre-prepared query and return the appropriate response.
There is no need to hack Net::DNS to achieve that.
Much pain and suffering can be avoided by leveraging published Net::DNS methods wherever possible. $query->reply was introduced in Net::DNS 0.69.
--- /tmp/Net-DNS-Resolver-Programmable-0.007/Makefile.PL 2017-07-16 23:46:46.000000000 +0100
+++ Makefile.PL 2017-07-19 22:44:07.281416476 +0100
@@ -18,7 +18,7 @@
'Test::More' => 0,
},
PREREQ_PM => {
- 'Net::DNS' => 0,
+ 'Net::DNS' => 0.69,
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
clean => { FILES => 'Net-DNS-Resolver-Programmable-*' },
--- /tmp/Net-DNS-Resolver-Programmable-0.007/lib/Net/DNS/Resolver/Programmable.pm 2017-07-19 16:32:12.000000000 +0100
+++ Programmable.pm 2017-07-19 22:37:36.838374287 +0100
@@ -196,17 +196,12 @@
sub send {
my $self = shift;
- # We could be passed a Net::DNS::Packet object, or a set of strings; handle
- # both
- my ($packet, $question);
- if (Scalar::Util::blessed($_[0]) && $_[0]->isa('Net::DNS::Packet')) {
- $packet = $_[0];
- # TODO: is it a safe assumption that a packet we're passed will only
- # contain one Question object?
- ($question) = $packet->question;
- } else {
- $question = Net::DNS::Question->new(@_);
- }
+ # We could be passed a Net::DNS::Packet object, or an array of strings
+ my ($query) = @_;
+ $query = Net::DNS::Packet->new(@_) unless ref($query);
+
+ my ($question) = $query->question;
+
my $domain = lc($question->qname);
my $rr_type = $question->qtype;
my $class = $question->qclass;
@@ -236,8 +231,7 @@
}
}
- my $response_packet = Net::DNS::Packet->new($domain, $rr_type, $class);
- $response_packet->header->qr(TRUE);
+ my $response_packet = $query->reply;
$response_packet->header->rcode($result);
$response_packet->header->aa($aa);
$response_packet->push(answer => @answer_rrs);
