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