|
Packit |
e6c8bb |
package Net::DNS::Resolver::Recurse;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
#
|
|
Packit |
e6c8bb |
# $Id: Recurse.pm 1623 2018-01-26 14:23:54Z willem $
|
|
Packit |
e6c8bb |
#
|
|
Packit |
e6c8bb |
our $VERSION = (qw$LastChangedRevision: 1623 $)[1];
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 NAME
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
Net::DNS::Resolver::Recurse - DNS recursive resolver
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 SYNOPSIS
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use Net::DNS::Resolver::Recurse;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$resolver = new Net::DNS::Resolver::Recurse();
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$packet = $resolver->query ( 'www.example.com', 'A' );
|
|
Packit |
e6c8bb |
$packet = $resolver->search( 'www.example.com', 'A' );
|
|
Packit |
e6c8bb |
$packet = $resolver->send ( 'www.example.com', 'A' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 DESCRIPTION
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
This module is a subclass of Net::DNS::Resolver.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=cut
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
use strict;
|
|
Packit |
e6c8bb |
use warnings;
|
|
Packit |
e6c8bb |
use base qw(Net::DNS::Resolver);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 METHODS
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
This module inherits almost all the methods from Net::DNS::Resolver.
|
|
Packit |
e6c8bb |
Additional module-specific methods are described below.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head2 hints
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
This method specifies a list of the IP addresses of nameservers to
|
|
Packit |
e6c8bb |
be used to discover the addresses of the root nameservers.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$resolver->hints(@ip);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
If no hints are passed, the priming query is directed to nameservers
|
|
Packit |
e6c8bb |
drawn from a built-in list of IP addresses.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=cut
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @hints;
|
|
Packit |
e6c8bb |
my $root = [];
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub hints {
|
|
Packit |
e6c8bb |
my $self = shift;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
splice @hints, 0, 0, splice( @hints, int( rand scalar @hints ) ); # cut deck
|
|
Packit |
e6c8bb |
return @hints unless scalar @_;
|
|
Packit |
e6c8bb |
$root = [];
|
|
Packit |
e6c8bb |
@hints = @_;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head2 query, search, send
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
The query(), search() and send() methods produce the same result
|
|
Packit |
e6c8bb |
as their counterparts in Net::DNS::Resolver.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$packet = $resolver->send( 'www.example.com.', 'A' );
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
Server-side recursion is suppressed by clearing the recurse flag in
|
|
Packit |
e6c8bb |
query packets and recursive name resolution is performed explicitly.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
The query() and search() methods are inherited from Net::DNS::Resolver
|
|
Packit |
e6c8bb |
and invoke send() indirectly.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=cut
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub send {
|
|
Packit |
e6c8bb |
return &Net::DNS::Resolver::Base::send if ref $_[1]; # send Net::DNS::Packet
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $self = shift;
|
|
Packit |
e6c8bb |
my $res = bless {persistent => {'.' => $root}, %$self}, ref($self);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $question = new Net::DNS::Question(@_);
|
|
Packit |
e6c8bb |
my $original = pop(@_); # sneaky extra argument needed
|
|
Packit |
e6c8bb |
$original = $question unless ref($original); # to preserve original request
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my ( $head, @tail ) = $question->{qname}->label;
|
|
Packit |
e6c8bb |
my $domain = lc( join( '.', @tail ) || '.' );
|
|
Packit |
e6c8bb |
my $nslist = $res->{persistent}->{$domain} ||= [];
|
|
Packit |
e6c8bb |
unless ( defined $head ) {
|
|
Packit |
e6c8bb |
my $defres = new Net::DNS::Resolver();
|
|
Packit |
e6c8bb |
$defres->nameservers( $res->_hints ); # fall back to inbuilt list
|
|
Packit |
e6c8bb |
$defres->udppacketsize(1024); # RFC8109
|
|
Packit |
e6c8bb |
my @config = $defres->nameserver( $res->hints );
|
|
Packit |
e6c8bb |
return $defres->send(qw(. NS));
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
if ( scalar @$nslist ) {
|
|
Packit |
e6c8bb |
$self->_diag("using cached nameservers for $domain");
|
|
Packit |
e6c8bb |
} else {
|
|
Packit |
e6c8bb |
$domain = lc $question->qname if $question->qtype ne 'NULL';
|
|
Packit |
e6c8bb |
my $packet = $res->send( $domain, 'NULL', 'IN', $original );
|
|
Packit |
e6c8bb |
return unless $packet;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @answer = $packet->answer; # return authoritative answer
|
|
Packit |
e6c8bb |
return $packet if $packet->header->aa && grep $_->name eq $original->qname, @answer;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @auth = grep $_->type eq 'NS', $packet->answer, $packet->authority;
|
|
Packit |
e6c8bb |
my %auth = map { lc $_->nsdname => lc $_->name } @auth;
|
|
Packit |
e6c8bb |
my %glue;
|
|
Packit |
e6c8bb |
my @glue = grep $_->can('address'), $packet->additional;
|
|
Packit |
e6c8bb |
foreach ( grep $auth{lc $_->name}, @glue ) {
|
|
Packit |
e6c8bb |
push @{$glue{lc $_->name}}, $_->address;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my %zone = reverse %auth;
|
|
Packit |
e6c8bb |
foreach my $zone ( keys %zone ) {
|
|
Packit |
e6c8bb |
my @nsname = grep $auth{$_} eq $zone, keys %auth;
|
|
Packit |
e6c8bb |
my @list = map $glue{$_} ? $glue{$_} : $_, @nsname;
|
|
Packit |
e6c8bb |
@{$res->{persistent}->{$zone}} = @list;
|
|
Packit |
e6c8bb |
return $packet if length($zone) > length($domain);
|
|
Packit |
e6c8bb |
$self->_diag("cache nameservers for $zone");
|
|
Packit |
e6c8bb |
@$nslist = @list;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $query = new Net::DNS::Packet();
|
|
Packit |
e6c8bb |
$query->{question} = [$original];
|
|
Packit |
e6c8bb |
$res = bless {%$res}, qw(Net::DNS::Resolver) if $nslist eq $root;
|
|
Packit |
e6c8bb |
$res->udppacketsize(1024);
|
|
Packit |
e6c8bb |
$res->recurse(0);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
splice @$nslist, 0, 0, splice( @$nslist, int( rand scalar @$nslist ) ); # cut deck
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
foreach my $ns (@$nslist) {
|
|
Packit |
e6c8bb |
if ( ref $ns ) {
|
|
Packit |
e6c8bb |
my @ip = map @$_, grep ref($_), @$nslist;
|
|
Packit |
e6c8bb |
$res->nameservers(@ip); # cached IP list
|
|
Packit |
e6c8bb |
} else {
|
|
Packit |
e6c8bb |
$self->_diag("find missing glue for $ns");
|
|
Packit |
e6c8bb |
my $name = $ns; # suppress deep recursion by
|
|
Packit |
e6c8bb |
$ns = []; # inserting placeholder in cache
|
|
Packit |
e6c8bb |
$ns = [$res->nameservers($name)]; # substitute IP list in situ
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $reply = $res->send($query);
|
|
Packit |
e6c8bb |
next unless $reply;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$self->_callback($reply);
|
|
Packit |
e6c8bb |
return $reply;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub query_dorecursion { &sen;; } # uncoverable pod
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head2 callback
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
This method specifies a code reference to a subroutine,
|
|
Packit |
e6c8bb |
which is then invoked at each stage of the recursive lookup.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
For example to emulate dig's C<+trace> function:
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $coderef = sub {
|
|
Packit |
e6c8bb |
my $packet = shift;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
printf ";; Received %d bytes from %s\n\n",
|
|
Packit |
e6c8bb |
$packet->answersize, $packet->answerfrom;
|
|
Packit |
e6c8bb |
};
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
$resolver->callback($coderef);
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
The callback subroutine is not called
|
|
Packit |
e6c8bb |
for queries for missing glue records.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=cut
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub callback {
|
|
Packit |
e6c8bb |
my $self = shift;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
( $self->{callback} ) = grep ref($_) eq 'CODE', @_;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub _callback {
|
|
Packit |
e6c8bb |
my $callback = shift->{callback};
|
|
Packit |
e6c8bb |
$callback->(@_) if $callback;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub recursion_callback { &callback; } # uncoverable pod
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
########################################
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
{
|
|
Packit |
e6c8bb |
require Net::DNS::ZoneFile;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my $dug = new Net::DNS::ZoneFile( \*DATA );
|
|
Packit |
e6c8bb |
my @rr = $dug->read;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
my @auth = grep $_->type eq 'NS', @rr;
|
|
Packit |
e6c8bb |
my %auth = map { lc $_->nsdname => 1 } @auth;
|
|
Packit |
e6c8bb |
my %glue;
|
|
Packit |
e6c8bb |
my @glue = grep $auth{lc $_->name}, @rr;
|
|
Packit |
e6c8bb |
foreach ( grep $_->can('address'), @glue ) {
|
|
Packit |
e6c8bb |
push @{$glue{lc $_->name}}, $_->address;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
my @ip = map @$_, values %glue;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
sub _hints { ## default hints
|
|
Packit |
e6c8bb |
splice @ip, 0, 0, splice( @ip, int( rand scalar @ip ) ); # cut deck
|
|
Packit |
e6c8bb |
return @ip;
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
}
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
1;
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 ACKNOWLEDGEMENT
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
This package is an improved and compatible reimplementation of the
|
|
Packit |
e6c8bb |
Net::DNS::Resolver::Recurse.pm created by Rob Brown in 2002,
|
|
Packit |
e6c8bb |
whose contribution is gratefully acknowledged.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 COPYRIGHT
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
Copyright (c)2014 Dick Franks.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
Portions Copyright (c)2002 Rob Brown.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
All rights reserved.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 LICENSE
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
Permission to use, copy, modify, and distribute this software and its
|
|
Packit |
e6c8bb |
documentation for any purpose and without fee is hereby granted, provided
|
|
Packit |
e6c8bb |
that the above copyright notice appear in all copies and that both that
|
|
Packit |
e6c8bb |
copyright notice and this permission notice appear in supporting
|
|
Packit |
e6c8bb |
documentation, and that the name of the author not be used in advertising
|
|
Packit |
e6c8bb |
or publicity pertaining to distribution of the software without specific
|
|
Packit |
e6c8bb |
prior written permission.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
Packit |
e6c8bb |
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
|
Packit |
e6c8bb |
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
|
|
Packit |
e6c8bb |
THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
|
Packit |
e6c8bb |
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
Packit |
e6c8bb |
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
|
Packit |
e6c8bb |
DEALINGS IN THE SOFTWARE.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=head1 SEE ALSO
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
L<Net::DNS::Resolver>
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
=cut
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
__DATA__ ## DEFAULT HINTS
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
; <<>> DiG 9.9.4-P2-RedHat-9.9.4-18.P2.fc20 <<>> @b.root-servers.net . -t NS
|
|
Packit |
e6c8bb |
; (2 servers found)
|
|
Packit |
e6c8bb |
;; global options: +cmd
|
|
Packit |
e6c8bb |
;; Got answer:
|
|
Packit |
e6c8bb |
;; ->>HEADER<<- opcode: QUERY, status: NOERROR, id: 47020
|
|
Packit |
e6c8bb |
;; flags: qr aa rd; QUERY: 1, ANSWER: 13, AUTHORITY: 0, ADDITIONAL: 27
|
|
Packit |
e6c8bb |
;; WARNING: recursion requested but not available
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
;; OPT PSEUDOSECTION:
|
|
Packit |
e6c8bb |
; EDNS: version: 0, flags:; udp: 4096
|
|
Packit |
e6c8bb |
;; QUESTION SECTION:
|
|
Packit |
e6c8bb |
;. IN NS
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
;; ANSWER SECTION:
|
|
Packit |
e6c8bb |
. 518400 IN NS c.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS k.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS l.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS j.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS b.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS g.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS h.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS d.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS a.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS f.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS i.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS m.root-servers.net.
|
|
Packit |
e6c8bb |
. 518400 IN NS e.root-servers.net.
|
|
Packit |
e6c8bb |
|
|
Packit |
e6c8bb |
;; ADDITIONAL SECTION:
|
|
Packit |
e6c8bb |
a.root-servers.net. 3600000 IN A 198.41.0.4
|
|
Packit |
e6c8bb |
b.root-servers.net. 3600000 IN A 192.228.79.201
|
|
Packit |
e6c8bb |
c.root-servers.net. 3600000 IN A 192.33.4.12
|
|
Packit |
e6c8bb |
d.root-servers.net. 3600000 IN A 199.7.91.13
|
|
Packit |
e6c8bb |
e.root-servers.net. 3600000 IN A 192.203.230.10
|
|
Packit |
e6c8bb |
f.root-servers.net. 3600000 IN A 192.5.5.241
|
|
Packit |
e6c8bb |
g.root-servers.net. 3600000 IN A 192.112.36.4
|
|
Packit |
e6c8bb |
h.root-servers.net. 3600000 IN A 198.97.190.53
|
|
Packit |
e6c8bb |
i.root-servers.net. 3600000 IN A 192.36.148.17
|
|
Packit |
e6c8bb |
j.root-servers.net. 3600000 IN A 192.58.128.30
|
|
Packit |
e6c8bb |
k.root-servers.net. 3600000 IN A 193.0.14.129
|
|
Packit |
e6c8bb |
l.root-servers.net. 3600000 IN A 199.7.83.42
|
|
Packit |
e6c8bb |
m.root-servers.net. 3600000 IN A 202.12.27.33
|
|
Packit |
e6c8bb |
a.root-servers.net. 3600000 IN AAAA 2001:503:ba3e::2:30
|
|
Packit |
e6c8bb |
b.root-servers.net. 3600000 IN AAAA 2001:500:84::b
|
|
Packit |
e6c8bb |
c.root-servers.net. 3600000 IN AAAA 2001:500:2::c
|
|
Packit |
e6c8bb |
d.root-servers.net. 3600000 IN AAAA 2001:500:2d::d
|
|
Packit |
e6c8bb |
e.root-servers.net. 3600000 IN AAAA 2001:500:a8::e
|
|
Packit |
e6c8bb |
f.root-servers.net. 3600000 IN AAAA 2001:500:2f::f
|
|
Packit |
e6c8bb |
g.root-servers.net. 3600000 IN AAAA 2001:500:12::d0d
|
|
Packit |
e6c8bb |
h.root-servers.net. 3600000 IN AAAA 2001:500:1::53
|
|
Packit |
e6c8bb |
i.root-servers.net. 3600000 IN AAAA 2001:7fe::53
|
|
Packit |
e6c8bb |
j.root-servers.net. 3600000 IN AAAA 2001:503:c27::2:30
|
|
Packit |
e6c8bb |
k.root-servers.net. 3600000 IN AAAA 2001:7fd::1
|
|
Packit |
e6c8bb |
l.root-servers.net. 3600000 IN AAAA 2001:500:9f::42
|
|
Packit |
e6c8bb |
m.root-servers.net. 3600000 IN AAAA 2001:dc3::35
|
|
Packit |
e6c8bb |
|