FILE: C:\Program Files (x86)\Plesk\perl\lib\Net\DNS\Resolver\Programmable.pm
--
#
# Net::DNS::Resolver::Programmable
# A Net::DNS::Resolver descendant class for offline emulation of DNS
#
# (C) 2006-2007 Julian Mehnle
# Maintained from 2017 by David Precious (BIGPRESH)
#
##############################################################################
package Net::DNS::Resolver::Programmable;
=head1 NAME
Net::DNS::Resolver::Programmable - programmable DNS resolver class for offline
emulation of DNS
=cut
our $VERSION;
$VERSION = '0.009';
use warnings;
use strict;
use Net::DNS;
use base 'Net::DNS::Resolver';
use constant TRUE => (0 == 0);
use constant FALSE => not TRUE;
my %rcode = map { $_ => 1 } qw(NOERROR FORMERR SERVFAIL NXDOMAIN NOTIMP
REFUSED YXDOMAIN YXRRSET NXRRSET NOTAUTH NOTZONE BADVERS
BADSIG BADKEY BADTIME BADMODE BADNAME BADALG BADTRUNC);
# Interface:
##############################################################################
=head1 SYNOPSIS
use Net::DNS::Resolver::Programmable;
use Net::DNS::RR;
my $resolver = Net::DNS::Resolver::Programmable->new(
records => {
'example.com' => [
Net::DNS::RR->new('example.com. NS ns.example.org.'),
Net::DNS::RR->new('example.com. A 192.168.0.1')
],
'ns.example.org' => [
Net::DNS::RR->new('ns.example.org. A 192.168.1.1')
]
},
resolver_code => sub {
my ($domain, $rr_type, $class) = @_;
...
return ($result, $aa, @rrs);
}
);
=cut
# Implementation:
##############################################################################
=head1 DESCRIPTION
B is a B descendant
class that allows a virtual DNS to be emulated instead of querying the real
DNS. A set of static DNS records may be supplied, or arbitrary code may be
specified as a means for retrieving DNS records, or even generating them on the
fly.
=head2 Constructor
The following constructor is provided:
=over
=item B: returns I
Creates a new programmed DNS resolver object.
%options is a list of key/value pairs representing any of the following
options:
=over
=item B
A reference to a hash of arrays containing a static set of I
objects. The hash entries must be indexed by fully qualified domain names
(lower-case, without any trailing dots), and the entries themselves must be
arrays of the RR objects pertaining to these domain names. For example:
records => {
'example.com' => [
Net::DNS::RR->new('example.com. NS ns.example.org.'),
Net::DNS::RR->new('example.com. A 192.168.0.1')
],
'www.example.com' => [
Net::DNS::RR->new('www.example.com. A 192.168.0.2')
],
'ns.example.org' => [
Net::DNS::RR->new('ns.example.org. A 192.168.1.1')
]
}
If this option is specified, the resolver retrieves requested RRs from this
data structure.
=item B
A code reference used as a call-back for dynamically retrieving requested RRs.
The code must take the following query parameters as arguments: the I,
I, and I.
It must return a list composed of: the response's I (by name, as
returned by L<< Net::DNS::Header->rcode|Net::DNS::Header/rcode >>), the
I<< C (authoritative answer) flag >> (I, use B if you don't
care), and the I. If an error string is returned
instead of a valid RCODE, a I object is not constructed but
an error condition for the resolver is signaled instead.
For example:
resolver_code => sub {
my ($domain, $rr_type, $class) = @_;
...
return ($result, $aa, @rrs);
}
If both this and the C option are specified, then statically
programmed records are used in addition to any that are returned by the
configured resolver code.
=item B
=item B
=item B
=item B
=item B
These Net::DNS::Resolver options are also meaningful with
Net::DNS::Resolver::Programmable. See L for their
descriptions.
=back
=cut
sub new {
my ($class, %options) = @_;
# Create new object:
my $self = $class->SUPER::new(%options);
$self->{records} = $options{records};
$self->{resolver_code} = $options{resolver_code};
return $self;
}
=back
=head2 Instance methods
The following instance methods of I are also supported by
I:
=over
=item B: returns I
=item B: returns I
=item B: returns I
Performs an offline DNS query, using the statically programmed DNS RRs and/or
the configured dynamic resolver code. See the L constructor's C
and C options. See the descriptions of L for details about the calling syntax of these
methods.
=cut
sub send {
my $self = shift;
# 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;
$self->_reset_errorstring;
my ($result, $aa, @answer_rrs);
if (defined(my $resolver_code = $self->{resolver_code})) {
($result, $aa, @answer_rrs) = $resolver_code->($domain, $rr_type, $class);
}
if ( not defined($result) or defined($rcode{$result}) ) {
# Valid RCODE, return a packet:
$aa = TRUE if not defined($aa);
$result = 'NOERROR' if not defined($result);
if (defined(my $records = $self->{records})) {
if (ref(my $rrs_for_domain = $records->{$domain}) eq 'ARRAY') {
foreach my $rr (@$rrs_for_domain) {
push(@answer_rrs, $rr)
if $rr->name eq $domain
and $rr->type eq $rr_type
and $rr->class eq $class;
}
}
}
my $response_packet = $query->reply;
$response_packet->header->rcode($result);
$response_packet->header->aa($aa);
$response_packet->push(answer => @answer_rrs);
return $response_packet;
}
else {
# Invalid RCODE, signal error condition by not returning a packet:
$self->errorstring($result);
return undef;
}
}
=item B
=item B: returns I
=item B: returns I of I
=item B: returns I
=item B: returns I
=item B: returns I
=item B: returns I
=item B: returns I
=item B: returns I
See L.
=back
Currently the following methods of I are B supported:
B, B, B, B, B, B,
B, B, B, B, B, B, B,
B, B, B, B, B,
B, B, B, B, B.
The effects of using these on I objects are
undefined.
=head1 SEE ALSO
L
For availability, support, and license information, see the README file
included with Net::DNS::Resolver::Programmable.
=head1 AUTHORS
David Precious (BIGPRESH) C<< >> took on maintainership
in July 2017
Original author Julian Mehnle C<< >>
=head1 ACKNOWLEDGEMENTS
Dick Franks (rwfranks)
(This section was added by BIGPRESH in July 2017, so currently omits
acknowledgements for those who contributed things in the past; I may
retrospectively add them in future.)
=cut
TRUE;
# vim:sts=4 sw=4 et
--