Static perl based backend for PDNS

static_backend.pl

#!/usr/bin/perl

# Restrict unsafe constructs
use strict;

# Config bits
my $hostmaster = 'hostmaster.uk-noc.com';
my $auth_server = 'dns.uk-noc.com';
my $serial = '2012071800';
my @target_ips = (
    '127.0.0.1',
);
my @nameservers = (
    'dns.uk-noc.com',
    'dns.us-noc.com',
);

# Disable buffering
$| = 1;

# Read a line from STDIN
my $hello_line = <STDIN>;

# Strip whitespace
$hello_line =~ s/^\s*//;
$hello_line =~ s/\s*$//;

# Check we can speak the protocol
if($hello_line !~ /^HELO\s+([0-9])$/ || $1 ne "3") {
    # Return a fail to pdns
    print "FAIL\n";

    # Send some debugging info out
    print STDERR $$ . " PDNS wanted to talk an un-known protocol\n";

    # Wait for a new line before exiting
    <STDIN>;

    # Exit cleanly
    exit 0;
}

# Send our header back to PDNS
print "OK\tReady.\n";

# Read all the input from STDIN
while (my $line = <STDIN>) {
    # Strip out the line
    $line =~ s/^\s*//;
    $line =~ s/\s*$//;

    # Send some debugging info out    
    print STDERR $$ . "  Received: " . $line . "\n";

    # Split the line by \t
    my @parts = split(/\t/, $line);

    # Check we have enough parts
    if(@parts < 8) {
        # Return a fail to pdns
        print "FAIL\n";

        # Send some debugging info out
        print STDERR $$ . " Couldn't parse " . $line . "\n";

        # Skip to the end
        last;
    }

    # Assign the array to local vars
    my ($type,$name,$class,$type,$id,$ip,$local_ip,$edns_subnet) = @parts;

    # Base template for responses
    my $record_template = "DATA\t21\t1\t%s\tIN\t%s\t3600\t-1\t%s\n";

    # Respond to each type as needed
    if($type eq "SOA" || $type eq "ANY") {
        # Send some debugging info out
        print STDERR $$ . " Responding with SOA data for " . $name . "\n";

        # SOA record
        my $soa_data = $auth_server . ". " . $hostmaster . ". " . $serial;
        $soa_data .= " 1800 3600 604800 3600";
        printf($record_template, $name, $class, $soa_data);

    } elsif($type eq "A" || $type eq "ANY") {
        # Send some debugging info out
        print STDERR $$ . " Responding with A data for " . $name . "\n";

        # A records
        foreach(@target_ips) {
            printf($record_template, $name, $class, $_);
        }

    } elsif($type eq "NS" || $type eq "ANY") {
        # Send some debugging info out
        print STDERR $$ . " Responding with NS data for " . $name . "\n";

        # NS records
        foreach(@nameservers) {
            printf($record_template, $name, $class, $_ . ".");
        }

    } else {
        # Send some debugging info out
        print STDERR $$ . " Recieved unknown type (" . $type . ")\n";
    }
}