File Coverage

blib/lib/Net/DNS/Resolver/Programmable.pm

Criterion	Covered	Total	%
statement	45	48	93.7
branch	11	16	68.7
condition	5	9	55.5
subroutine	8	8	100.0
pod	2	2	100.0
total	71	83	85.5

#
# 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
send|Net::DNS::Resolver/search> 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