#!/usr/bin/perl

# Copyright (c) 2014-2019 Christoph Berg <myon@debian.org>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

use strict;
use warnings;
use File::Temp qw(tempfile);
use Getopt::Long;
use Sort::Naturally;

## option parsing

sub usage {
	my $exit = shift;
	print "Usage: $0 [-l] [-k keyfile] [-g] [-p port] [\@nameserver] [-i] <zone>\n";
	exit $exit;
}

my $keyfile = '';
my $local;
my $gssapi;
my $nameserver;
my $port;
my $noidnout;

Getopt::Long::config('bundling');
if (!GetOptions (
		'-h'              =>  sub { usage(0) },
		'--help'          =>  sub { usage(0) },
		'-k=s'            =>  \$keyfile,
		'--key-file=s'    =>  \$keyfile,
		'-l'              =>  \$local,
		'-g'              =>  \$gssapi,
		'--gssapi'        =>  \$gssapi,
		'-p=i',           =>  \$port,
		'--port=i',       =>  \$port,
		'-i',             =>  \$noidnout,
		'--noidnout',     =>  \$noidnout,
	)) {
	usage(1);
};

if (@ARGV > 0 and $ARGV[0] =~ /^@(.+)/) {
	$nameserver = $1;
	shift;
}
if (@ARGV != 1) {
	usage(1);
}
my $zone = shift;
$zone =~ s/\.$//; # remove trailing dot

my @dig = ("dig", "-t", "AXFR", "+nostats", $zone);
push @dig, "\@$nameserver" if ($nameserver);
push @dig, "\@localhost" if ($local);
push @dig, "-k", $keyfile if ($keyfile);
push @dig, "-p", $port if ($port);
push @dig, "+noidnout" if ($noidnout);

my @nsupdate = qw(nsupdate);
push @nsupdate, "-l" if ($local);
push @nsupdate, "-k", $keyfile if ($keyfile);
push @nsupdate, "-g" if ($gssapi);

## functions

# remove all $keys from d
sub prune ($$)
{
	my ($d, $key) = @_;
	foreach my $name (keys %$d) {
		foreach my $class (keys %{$d->{$name}}) {
			foreach my $type (keys %{$d->{$name}->{$class}}) {
				my $rrset = $d->{$name}->{$class}->{$type};
				foreach my $data (keys %$rrset) {
					delete $rrset->{$data}->{$key};
				}
			}
		}
	}
}

# parse one AXFR output line, return interesting lines (or undef)
sub parse ($$)
{
	my ($zone, $line) = @_;
	my ($name, $ttl, $class, $type, $data) = split /\s+/, $line, 5;
	if (not defined $data) {
		print STDERR "Couldn't parse line $.: $line\n";
		return undef;
	}
	if ($type =~ /^(RRSIG|NSEC|NSEC3|TSIG|TYPE65534)$/) {
		# ignore signatures that are generated automatically anyway
		return undef;
	}
	if ($name eq "$zone.") {
		$name = '@';
		$line =~ s/^\Q$zone\E\.\s/@\t/;
	} else {
		$name =~ s/\.\Q$zone\E\.$//;
		$line =~ s/\.\Q$zone\E\.\s/\t/;
	}
	return ($line, $name, $ttl, $class, $type, $data);
}

# load AXFR output
sub load_file ($$$$)
{
	my ($zone, $d, $key, $fh) = @_;
	my $rrs = 0;
	while (my $line = <$fh>) {
		chomp $line;
		# dirac.df7cb.de. 7200 IN CNAME dirac.dyn.df7cb.de.
		next if ($line =~ /^(;|$)/);
		my ($line2, $name, $ttl, $class, $type, $data) = parse ($zone, $line);
		next unless (defined $data);
		$d->{$name}->{$class}->{$type}->{$data}->{$key} = $ttl;
		$rrs++;
	}
	close $fh;
	return $rrs;
}

sub write_file ($$$)
{
	my ($d, $key, $fh_out) = @_;
	my ($name_w, $class_w, $type_w, $ttl_w) = (1, 1, 1, 1);

	print $fh_out "; $zone - vim:ft=bindzone:\n";

	# calculate lengths of output columns
	foreach my $name (keys %$d) {
		$name_w = length $name if (length $name > $name_w);
		foreach my $class (keys %{$d->{$name}}) {
			$class_w = length $class if (length $class > $class_w);
			foreach my $type (keys %{$d->{$name}->{$class}}) {
				$type_w = length $type if (length $type > $type_w);
				foreach my $data (keys %{$d->{$name}->{$class}->{$type}}) {
					next unless (exists $d->{$name}->{$class}->{$type}->{$data}->{$key});
					my $ttl = $d->{$name}->{$class}->{$type}->{$data}->{$key};
					$ttl_w = length $ttl if (length $ttl > $ttl_w);
				}
			}
		}
	}

	foreach my $name (nsort keys %$d) {
		foreach my $class (nsort keys %{$d->{$name}}) {
			foreach my $type (nsort keys %{$d->{$name}->{$class}}) {
				foreach my $data (nsort keys %{$d->{$name}->{$class}->{$type}}) {
					next unless (exists $d->{$name}->{$class}->{$type}->{$data}->{$key});
					my $ttl = $d->{$name}->{$class}->{$type}->{$data}->{$key};
					printf $fh_out "%-${name_w}s %-${ttl_w}s %-${class_w}s %-${type_w}s %s\n",
						$name, $ttl, $class, $type, $data;
				}
			}
		}
	}

	close $fh_out;
}

sub compare ($$$$)
{
	my ($zone, $d, $key1, $key2) = @_;
	my @cmds;
	foreach my $name (nsort keys %$d) {
		my $fqdn = $name;
		$fqdn = "$zone." if ($fqdn eq '@');
		$fqdn .= ".$zone." unless ($fqdn =~ /\.$/);
		foreach my $class (nsort keys %{$d->{$name}}) {
			foreach my $type (nsort keys %{$d->{$name}->{$class}}) {
				my $rrset = $d->{$name}->{$class}->{$type};
				foreach my $data (nsort keys %$rrset) {
					my $rr = $rrset->{$data};
					if (exists $rr->{$key1} and exists $rr->{$key2} and $rr->{$key1} == $rr->{$key2}) {
						# nothing to do
						next;
					}
					if (exists $rr->{$key1}) { # removed (or changed)
						push @cmds, "update delete $fqdn $class $type $data\n";
					}
					if (exists $rr->{$key2}) { # added (or changed)
						push @cmds, "update add    $fqdn $rr->{$key2} $class $type $data\n";
					}
				}
			}
		}
	}
	return \@cmds;
}

## main

my ($fh, $filename) = tempfile( "$zone.XXXXXX", TMPDIR => 1, UNLINK => 1 );
my $d = {};
my ($key1, $key2) = (1, 2);

open F, "-|", @dig;
my $rrs = load_file ($zone, $d, $key1, *F);
my $rc = $? >> 8;
if ($rrs == 0 or $rc > 0) {
	open F, $filename;
	print STDERR <F>;
	close F;
	exit ($rc || 1);
}
write_file ($d, $key1, $fh);

do {
	my $mtime = (stat $filename)[9];
	my $editor = $ENV{EDITOR} || 'sensible-editor';
	system $editor, $filename;

	if ((stat $filename)[9] == $mtime) {
		print "No change.\n";
		exit 0;
	}

	open F, $filename or die "$filename: $!";
	load_file ($zone, $d, $key2, *F);

	my $cmds = compare ($zone, $d, $key1, $key2);

	unless (@$cmds) {
		print "No change.\n";
		exit 0;
	}
	unshift @$cmds, "zone $zone\n";
	if ($port) {
		unshift @$cmds, "server $nameserver $port\n" if ($nameserver);
	} else {
		unshift @$cmds, "server $nameserver\n" if ($nameserver);
	}
	push @$cmds, "send\nanswer\n\n";
	print "nsupdate commands queued:\n";
	print @$cmds;

	print "[S]end, [e]dit, send and edit [a]gain, [q]uit: [s] ";
	my $response = <STDIN>;
	print "\n";

	if ($response =~ /^(s|y|$)/i) {
		open F, "|-", @nsupdate;
		print F @$cmds;
		close F;
		my $rc = $? >> 8;
		exit 0 if ($rc == 0);
		print "nsupdate returned $rc, press enter to edit again ";
		<STDIN>;
		print "\n";
	} elsif ($response =~ /^e/i) {
	} elsif ($response =~ /^a/i) {
		open F, "|-", @nsupdate;
		print F @$cmds;
		close F;
		my $rc = $? >> 8;
		print "nsupdate returned $rc, press enter to edit again ";
		<STDIN>;
		print "\n";
		if ($rc == 0) {
			$key1++;
			$key2++;
		}
	} elsif ($response =~ /^q/i) {
		exit 0;
	}
	prune ($d, $key2);
} while (1);

__END__

=head1 NAME

dnsvi - Edit dynamic DNS zones using vi

=head1 SYNOPSIS

B<dnsvi> [B<-igl>] [B<-k> I<keyfile>] [B<-p> I<port>] [B<@>I<nameserver>] I<zone>

=head1 DESCRIPTION

B<dnsvi> is a frontend for B<nsupdate>. Given a DNS zone name, it uses
B<dig -t AXFR> to get all the records in a zone. It then spawns your favorite
editor, and upon completion, builds a list of "B<update add>" and
"B<update delete>" statements to feed to nsupdate.

=head1 OPTIONS

=over 4

=item B<-i> B<--noidnout>

If you are updating a punycode domain and you are using bind9 >= 9.14.0, you
need to specify B<-i> to be able to update the zone, otherwise there will be a
mix of punycode and non-punycode domains which nsupdate will refuse.

=item B<-l>

Use B<localhost> as nameserver and pass B<-l> (local) to B<nsupdate>.

=item B<-k> I<keyfile>

Use I<keyfile> for B<AXFR> and B<nsupdate>.

=item B<-g>

Use B<Kerberos> credentials for B<nsupdate>. See B<-g> in B<nsupdate>(1) for details.

=item B<-p> I<port>

Use I<port> for B<AXFR> and B<nsupdate> (default: 53).

=item B<@>I<nameserver>

Query I<nameserver> for zone data and send updates there.

=back

=head1 ENVIRONMENT

=over 4

=item B<EDITOR>

Editor to use instead of B<sensible-editor>.

=back

=head1 EXAMPLE

 $ dnsvi -k dyn.df7cb.de.key @ns.df7cb.de dyn.df7cb.de
 [...vi...]
 nsupdate commands queued:
 server ns.df7cb.de
 zone dyn.df7cb.de
 update delete fermi.dyn.df7cb.de. IN A 127.0.0.1
 update add    lehmann.dyn.df7cb.de. 600 IN A 127.0.0.1
 update add    volta.dyn.df7cb.de. 2419200 IN SSHFP 3 1 DC66C1C5E9ED611FBDF0A9E1F701B1F8C38A6C1D
 send
 answer

 [S]end, [e]dit, send and edit [a]gain, [q]uit: [s]

=head1 SEE ALSO

L<dig(1)>, L<nsupdate(1)>.

=head1 AUTHOR

Christoph Berg L<E<lt>myon@debian.orgE<gt>>
