dlz_perl_example.pm revision 3b9ba6bd74e2cbbc0f821e5483ebf46fa8c4d8de
#
# Copyright (C) 2009-2012 John Eaglesham
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND JOHN EAGLESHAM
# DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
# JOHN EAGLESHAM BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
# FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
# NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
# WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
package dlz_perl_example;
use warnings;
use strict;
# Constructor. Everything after the class name can be folded into a hash of
# various options and settings. Right now only log_context and argv are
# available.
sub new {
my $self = {};
$self->{log} = sub {
};
'example.com' => {
'@' => [
{
type => 'SOA',
ttl => 86400,
data =>
'ns1.example.com. hostmaster.example.com. 12345 172800 900 1209600 3600',
}
],
perlrr => [
{
type => 'A',
ttl => 444,
data => '1.1.1.1',
},
{
type => 'A',
ttl => 444,
data => '1.1.1.2',
}
],
perltime => [
{
code => sub {
return ['TXT', '1', time()];
},
},
],
sourceip => [
{
code => sub {
my ( $opaque ) = @_;
# Passing anything other than the proper opaque value,
# 0, or undef to this function will cause a crash (at
# best!).
},
},
],
},
};
$self->{log}->(
'DLZ Perl Script: Called init. Loaded zone data: '
);
return $self;
}
# Do we have data for this zone? Expects a simple true or false return value.
sub findzone {
$self->{log}->(
"DLZ Perl Script: Called findzone, looking for zone $zone"
);
}
# Return the data for a given record in a given zone. The final parameter is
# an opaque value that can be passed to DLZ_Perl::clientinfo::sourceip to
# retrieve the client source IP and port. Expected return value is an array
# of array refs, with each array ref representing one record and containing
# the type, ttl, and data in that order. Data is as it appears in a zone file.
sub lookup {
$self->{log}->(
"DLZ Perl Script: Called lookup, looking for record $name in zone $zone"
);
my @results;
if ( $rr->{'code'} ) {
if ( @r ) {
push @results, @r;
}
} else {
}
}
return @results;
}
# Will we allow zone transfer for this client? Expects a simple true or false
# return value.
sub allowzonexfr {
$self->{log}->(
"DLZ Perl Script: Called allowzonexfr, looking for zone $zone for " .
"client $client"
);
return 0;
}
# Note the return AoA for this method differs from lookup in that it must
# return the name of the record as well as the other data.
sub allnodes {
my @results;
$self->{log}->(
"DLZ Perl Script: Called allnodes, looking for zone $zone"
);
if ( $rr->{'code'} ) {
my @r = $rr->{'code'}->();
# The code returns an array of array refs without the name.
# This makes things easy for lookup but hard here. We must
# iterate over each array ref and inject the name into it.
foreach my $a ( @r ) {
unshift @{$a}, $name;
}
push @results, @r;
} else {
push @results,
}
}
}
return @results;
}
1;