#!/usr/bin/perl

use strict;

use Net::DNS;
use Paranoid::Network::IPv4 qw(:all);
use Paranoid::Network::IPv6 qw(:all);
use Data::Dumper;
use CGI;

my $zone = 'dyn.example.com';		# A zone reserved for this script.
my $dnsserver = '127.0.0.1';		# Assuming 'allow-updates {127.0.0.1;}' in localhost BIND.
my @validnames = ('myhost', 'myhost2'); # Only these are allowed.
my @validtypes = ('A', 'AAAA'); 	# Only these are allowed.

my $query = CGI->new;
my @params = $query->url_param('keywords');

my $qref = &qdecode($params[0]);

my ($name, $type, $ip, $rest) = @{ $qref };

if (not grep($name, @validnames)) {
	print STDERR "ERROR: Invalid name: $name\n";
	print $query->header('text/html','500 Internal Server Error');
	print $query->start_html(-title=>'');
	print $query->end_html();
	exit 1;
};

if (not grep($type, @validtypes)) {
	print STDERR "ERROR: Invalid type: $type\n";
	print $query->header('text/html','500 Internal Server Error');
	print $query->start_html(-title=>'');
	print $query->end_html();
	exit 1;
};

if (
	(($type eq 'A') and (not (($ip =~ /^@{[ IPV4REGEX ]}$/)))) or 
	(($type eq 'AAAA') and (not (($ip =~ /^@{[ IPV6REGEX ]}$/)))) 
) {
	print STDERR "ERROR: Invalid IP: $ip\n";
	print $query->header('text/html','500 Internal Server Error');
	print $query->start_html(-title=>'');
	print $query->end_html();
	exit 1;
};

my $fqn = $name . "." . $zone;
my $fqdn = $name . "." . $zone . ".";
my $resolver = new Net::DNS::Resolver;
$resolver->nameservers($dnsserver);

# Delete old record.
my $update = new Net::DNS::Update($zone);
$update->push( prereq => yxrrset("$fqn $type") );
$update->push( update => rr_del("$fqn $type") );
my $reply = $resolver->send($update);
if ($reply) {
        if ( $reply->header->rcode eq 'NOERROR' ) {
                print STDERR "Delete old records succeeded\n";
        } else {
                print STDERR 'Delete old records failed: ', $reply->header->rcode, "\n";
        }
} else {
        print STDERR 'Delete old records failed: ', $resolver->errorstring, "\n";
	print $query->header('text/html','500 Internal Server Error');
	print $query->start_html(-title=>'');
	print $query->end_html();
	exit 1;
};

undef $reply, $update;
# Add new record.
$update = new Net::DNS::Update($zone);
$update->push( prereq => yxdomain($zone) );
$update->push( update => rr_add("$fqdn 300 $type $ip") );
$reply = $resolver->send($update);
if ($reply) {
        if ( $reply->header->rcode eq 'NOERROR' ) {
                print STDERR "Update succeeded\n";
		print $query->header('text/html','204 No response');
        } else {
                print STDERR 'Update failed: ', $reply->header->rcode, "\n";
		print $query->header('text/html','500 Internal Server Error');
		print $query->start_html(-title=>'');
		print $query->end_html();
		exit 1;
        }
} else {
        print STDERR 'Update failed: ', $resolver->errorstring, "\n";
	print $query->header('text/html','500 Internal Server Error');
	print $query->start_html(-title=>'');
	print $query->end_html();
	exit 1;
}

exit 0;

sub qdecode {
        my ($dbrec, $rest) = @_;
        use Crypt::CBC;
        use MIME::Base64 qw(encode_base64url decode_base64url);
        my $cipher = Crypt::CBC->new(   -key    => 'a pass phrase',
                                        -cipher => 'Blowfish',
                                        -keysize => 56
                        );
	my $decoded = decode_base64url($dbrec);
	my $decrypted = $cipher->decrypt($decoded);
	my @result = split(/\|/, $decrypted, 3);
	return \@result;
};