#! /usr/bin/perl
# Copyright 2014-2015 Uwe Kleine-König <uwe@kleine-koenig.org>
# You can use this program under the GNU Public License (GPL) version 2 as
# published by the Free Software Foundation.

use strict;
use warnings;

use CGI;
use JSON;
use Net::DNS;
use List::MoreUtils 'notall';

use Regexp::IPv6 qw($IPv6_re);
my $IPv4_re = '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}';

my $q = CGI->new;
my $json = JSON->new->allow_nonref;

my $key = $q->param('key');
# skip empty parameters to be able to use a single URL pattern for IPv4 and IPv4+6 hosts
my @ip4s = grep(!/^$/, $q->multi_param('ip4'));
my @ip6s = grep(!/^$/, $q->multi_param('ip6'));

# assert: each ip4 is a ipv4
if (notall { /$IPv4_re/ } @ip4s) {
	print $q->header(-type => 'application/json', -status => '400 Bad Request');
	print $json->pretty->encode ({ 'error' => 'malformed IP' });
	exit 0;
}

if (notall { /$IPv6_re/ } @ip6s) {
	print $q->header(-type => 'application/json', -status => '400 Bad Request');
	print $json->pretty->encode ({ 'error' => 'malformed IP' });
	exit 0;
}

my $server = $q->param('server');
# assert?: server is a hostname
my $hostname = $q->param('hostname');
# assert?: hostname is a hostname
if (not $hostname or not $hostname =~ /^([a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?\.)+[a-zA-Z0-9]([a-zA-Z0-9\-]*[a-zA-Z0-9])?$/) {
	print $q->header(-type => 'application/json', -status => '400 Bad Request');
	print $json->pretty->encode ({ 'error' => 'malformed hostname' });
	exit 0;
}

my ($defaultdomain) = $hostname =~ m/^[^.]*\.(.*)/;
my $domain = $q->param('domain') || $defaultdomain;

if (not $server) {
	my $res = Net::DNS::Resolver->new;
	my $query = $res->query($domain, "SOA");

	if ($query) {
		$server = ($query->answer)[0]->mname;
	}
}

my %request;
$request{'key'} = $key;
$request{'ip4'} = \@ip4s;
$request{'ip6'} = \@ip6s;
$request{'server'} = $server;
$request{'hostname'} = $hostname;
$request{'domain'} = $domain;

my %response;
$response{'request'} = \%request;

my $update = Net::DNS::Update->new($domain);

if (@ip4s) {
	# delete all existing A records for a name
	$update->push(update => rr_del($hostname . ". A"));

	foreach my $ip4 (@ip4s) {
		$update->push(update => rr_add($hostname . ". 3600 A " . $ip4));
	}
}

if (@ip6s) {
	# delete all existing AAAA records for a name
	$update->push(update => rr_del($hostname . ". AAAA"));

	foreach my $ip6 (@ip6s) {
		$update->push(update => rr_add($hostname . ". 3600 AAAA " . $ip6));
	}
}

if ($key) {
	#$update->sign_tsig($hostname . ".", $key);
	my $tsig = Net::DNS::RR->new(
		name => $hostname . ".",
		type => 'TSIG',
		algorithm => $q->param('algorithm') // 'HMAC-MD5',
		key => $key
	);
	$update->sign_tsig($tsig);

}

my $res = Net::DNS::Resolver->new;
$res->nameservers($server) if $server;

my $reply = $res->send($update);
my $status;

if ($reply) {
    my $rcode = $reply->header->rcode;
    if ($rcode eq 'NOERROR') {
        $status = "200 OK";
    } else {
        $status = "403 Forbidden";
    }
    $response{'replycode'} = $rcode;
} else {
    $status = '400 Bad Request';
    $response{'error'} = $res->errorstring;
};

print $q->header(-type => 'application/json', -status => $status, -charset => 'utf-8' );
print $json->pretty->encode( \%response );