#!/usr/bin/perl

use utf8;
use strict;
use warnings;

# Source: @RPM_PACKAGE_VERSION@-@RPM_PACKAGE_RELEASE@

BEGIN { unshift(@INC,($ENV{'POPHOME'}||'@POPHOME@').'/lib')
			unless $ENV{'KUNDE_NO_PERLPATH'};
      }

use Cf qw($NSI $NSI_KEY $NSI_KEY_NAME);
use Loader qw(get_rcode_info);
use Umlaut qw(textmodus);

sub Usage() {
	my $vers = '@RPM_PACKAGE_VERSION@-@RPM_PACKAGE_RELEASE@';

	textmodus(\*STDERR);
    die <<END;
Usage: $0
      -a/-d/-u/-du what to do: add / delete / update / selective-delete
      -z ZONE      access this zone (default: auto)
      -t TTL       Default 86400, one day
      -c CLASS     default IN
      -r           update a reverse zone (CNAME or PTR only)
      -x WHAT,...  used with -d/-u: which entries to delete
                   (Default: -d: ANY (= all); -u: those mentioned on stdin)
      -s SERVER    if not $NSI
      -k key       Secret key
      -K keyname   Secret key's name
      -v           call 'dig' afterwards
      -D           Debug-Mode (Net::DNS)
      NAME         the domain you want to update
Input for -a/-u:
A     Address              TXT   Comment etc.
MX    Pref Dest            PTR   Dest
CNAME destination

Normal use:
$0 -u bla.fasel.example
A 10.20.30.40
^D

"-u" and "-d" alone will try to delete all existing records of the given type.
(This does not work for NS records => the update fails.)
You can use "-du" to selectively delete the records you pass on stdin.
Version: $vers
END
  exit 1;
}

=head1 Name

nsset -- updatet Nameserver

=head1 Zusammenfassung

 nsset -a/-d/-u    add / delete / update
       -z ZONE     Default: alles ab dem ersten Punkt
       -t TTL      Default: 86400 = 1 Tag
       -c KLASSE   wenn nicht IN
       -r          der Name ist für Reverse-Lookup gedacht, nur CNAME oder PTR
       -x WAS,...  für -d/-u: welche Einträge gelöscht werden sollen
	      (Default: -d: alle vorhandenen; -u: alle angegebenen)
       -s SERVER   wenn nicht $Cf::NSI
       -v          rufe danach 'dig' auf

=head1 Beschreibung

C<nsset> updatet dynamische Zonen des Nameservers.

=head2 Optionen

=over 4

=item C<-a>

Neuen Record hinzufügen. Alte Records (eines Typs) bleiben erhalten.

=item C<-u>

Records updaten. Records des angegebenen Typs werden überschrieben.

=item C<-d>

Records löschen.

=item C<-z I<Zone>>

Updates für diese Zone vorbereiten. Normalfall: Alles ab dem ersten
Punkt im Namen.

=item C<-t I<TTL>>

=item C<-c I<Klasse>>

=item C<-r>

=item C<-x I<was[,...]>>

=item C<-s I<Server>>

=item C<-v>

=back

=head1 Daten

=head1 ToDo

=cut


use Net::DNS;
use Net::DNS::Update;
use Getopt::Std;
Usage unless @ARGV;
use vars qw(
  $opt_a
  $opt_c
  $opt_d
  $opt_D
  $opt_k
  $opt_K
  $opt_r
  $opt_s
  $opt_t
  $opt_u
  $opt_v
  $opt_x
  $opt_z
);
getopts('aduz:t:c:rx:s:vDk:K:') or Usage;

$opt_c ||= "IN";
$opt_t ||= 86400;
$opt_k = $NSI_KEY unless defined $opt_k;
$opt_K = $NSI_KEY_NAME unless defined $opt_K;

$opt_a=0 unless defined $opt_a;
$opt_d=0 unless defined $opt_d;
$opt_u=0 unless defined $opt_u;
Usage if $opt_a+($opt_u||$opt_d) != 1;
Usage if @ARGV != 1;

my ($was) = @ARGV;

if ($opt_r) {
	require Net::IP;
	my $ip = Net::IP->new($was)
	  or die "Bei -r musst Du eine IPv4- oder IPv6-Adressen angeben.\n";
	$was =

	  # Workaround für Bug in Net::IP, vgl.
	  # https://rt.cpan.org/Ticket/Display.html?id=42793
	  $ip->version == 4
	  ? join( '.', reverse( split /\./, $ip->ip ), 'in-addr', 'arpa', '' )
	  : $ip->reverse_ip;
}

my $res = new Net::DNS::Resolver;
$res->{debug} = $opt_D;

$res->nameservers( my $nameserver = defined $opt_s ? $opt_s : $NSI );

if(defined $opt_z) {
	my $loc = substr($was,0,-length($opt_z));
	my $rmt = substr($was,length($loc));
	# die "Die Zone ist nicht Teil des Namens!\n" unless $rmt eq $opt_z and chop $loc eq ".";
} else {
	die "Domainnamen haben Punkte!\n" unless $was =~ /\.(.*)/;

	$opt_z = $was . ( $was !~ /\.\z/ && '.' );
	{
		my $packet = $res->send( $opt_z, 'SOA' )
		  or die "Fehler bei der SOA-Abfrage für $opt_z: " . $res->errorstring;

		last if $packet->answer && ( $packet->answer )[0]->type eq 'SOA';

		die "Für $opt_z gibt es eine eigene Zone, allerdings nicht auf $NSI.\n"
		  if !$opt_d && grep $_->type eq 'NS' && lc $_->name . '.' eq lc $opt_z,
		  $packet->authority;

		$opt_z =~ s/^[^\.]+\.// or die "Dafür gibt es hier keine Zone.\n";

		redo;
	}
}

my $packet = new Net::DNS::Update($opt_z);

my $in = "";
# Step 0: Read
if($opt_a or $opt_u) {
	my $lines = 0;
	while(<STDIN>) {
		$lines++;
		$in .= $_;
	}
	die "Leere Eingabe. Is nich.\n" unless $lines;
	my %ty;
	unless(defined $opt_x) {
		foreach my $lin(split(/\n/,$in)) {
			my($ty,$ex) = split(/\s+/,$lin,2);
			$ty{$ty}++;
		}
		$opt_x = join(",",keys %ty);
	}

}
# Step 1: Delete
if($opt_u+$opt_d == 1){
	my $type;
	foreach $type(split(/,/, ($opt_x or "ANY"))) {
		$packet->push("update", new Net::DNS::RR(
        	Name => $was, Class => "ANY", Type  => $type, ttl => 0));
	}
}

sub as_string { join '', map $_->string . "\n", @_ }

# Step 2: Update
if($opt_a or $opt_u) {

    my $cnames = my $non_cnames = 0;
	foreach my $lin(split(/\n/,$in)) {
		my ( $ty, $ex ) = split( /\s+/, $lin, 2 );

		warn "Ich kenne den Datentyp '$ty' nicht!\n"
		  if $ty !~ /^(?:A|AAAA|CNAME|MX|NS|PTR|SOA|SRV|TXT)$/i;

		$ex = qq("$ex") if uc $ty eq 'TXT' && $ex !~ /"/;

		my $rr;
		if($opt_d) {
			$rr = rr_del("$was $opt_t $opt_c \U$ty\E $ex");
		} else { 
			$rr = rr_add("$was $opt_t $opt_c \U$ty\E $ex");
		}
		if ( $rr->type eq 'CNAME' ) { ++$cnames }
		else { ++$non_cnames }

		# Net::DNS::RR->new() verarbeitet im Gegensatz zum auch von
		# rr_add() verwendeten ->new_from_string() abgekürzte IPv6-
		# Adressen nicht richtig, vgl. RT#383036.
		$packet->push(update => $rr);
	}

	die <<_ if $cnames > 1;
Bei CNAMEs gilt: Es kann (pro FQDN) nur einen geben.
Bevor wir jetzt BIND interpretieren lassen, wie Du das gemeint haben könntest,
denk lieber nochmal scharf nach!
_
	my $current = $res->send( $was, 'ANY' )
	  or die "Fehler bei der ANY-Abfrage für $was " . $res->errorstring;

	if ( !$opt_u || !defined $opt_x || uc $opt_x ne 'ANY'
		and ( my @answer = $current->answer ) )
	{
		if ( $answer[0]->type eq 'CNAME' ) {
			die "Für diesen FQDN ist bislang ein CNAME eingetragen:\n"
			  . as_string(@answer)
			  . <<_
Wenn Du den ersetzen möchtest, verwende bitte "$0 -x ANY -u $was"!
_
			  if !$cnames || $cnames && $opt_a;
		}
		elsif ($cnames) {
			die "Dieser FQDN ist bislang eigenständig:\n"
			  . as_string(@answer)
			  . <<_
Wenn Du das durch einen CNAME ersetzen möchtest,
verwende bitte "$0 -x ANY -u $was"!
_
		}
	}
}

$packet->sign_tsig($opt_K, $opt_k) if $opt_k and $opt_K;
print <<1, $packet->string, <<2 if $opt_D;

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Das Update-Paket:
1
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

2
my $ans = $res->send($packet);

if (defined $ans) {
	print my $rcode = $ans->header->rcode, "\n";
	if ( defined( my $rcode_info = get_rcode_info $rcode ) ) {
		print "Will sagen: $rcode_info\n"
	}
	system dig => '@'.$nameserver, $was, 'any' if $opt_v;
} else {
	print $res->errorstring, "\n";
}
