use utf8;
use warnings; no warnings "redefine";
use strict;
use Loader qw(walk_ip show_reverse line_ja_nein get_rcode_info);
use Dbase::Globals qw(get_ipnum);
use Dbase::Help qw(DoFn);
use Fehler qw(warnung);
use Cf qw($NSI $NSI_KEY_NAME $NSI_KEY);
use Dbase::IP;
use Net::DNS;
use Net::DNS::Update;

my $res = new Net::DNS::Resolver;
$res->nameservers($NSI) unless $ENV{'TESTING3'};
$res->udp_timeout(2);
$res->tcp_timeout(2);
$res->retry(1);
$res->retrans(1);

##
# ipnr_free_range($adr) prüft für alle Adressen im Netzbereich $adr, die
# nicht durch einen Datenbankeintrag abgedeckt sind, ob es dafür einen
# PTR- oder CNAME-Eintrag gibt. Wenn ja, werden diese Einträge angezeigt
# und ggf. gelöscht.
#
# Ist ein Kunde als zweiter Parameter angegeben, so geht ipnr_free_range()
# davon aus, dass der in $adr angegebene Bereich diesem Kunden gehört bzw.
# gehört hat. Ist nun der direkt übergeordnete Bereich demselben Kunden
# zugeordnet, so wird der beschriebene Test nicht ausgeführt.

sub serve_ipnr_free_range($;$) {
	my($adr,$kunde) = @_;
	my @adrs = ();
	my @warn;

	if(defined $kunde) {
		my $kid = get_ipnum($adr->bitmask($adr->db_bits+1,1));
		$kid = DoFn("select kunde from ipkunde where id=$kid") if $kid;
		$kid = 0 unless defined $kid;
		return if $kunde == $kid;
	}

	if ( ( my $number_of_addresses = $adr->num ) > 4096 ) {
		return warnung(<<_);
Da dieser Netzbereich $number_of_addresses Adressen enthält, werde ich jetzt _keine_
Überprüfung auf noch vorhandene DNS-Reverse-Einträge durchführen.
_
	}

	walk_ip($adr, sub {
		my(undef,$iadr) = @_;

		show_reverse($iadr,undef, sub {
			my($iadr,$ans) = @_;
			push(@warn,$iadr->str() ." ". join("\n              -> ",
				map { sprintf( "%-6s %s", $_->type . ':', $_->rdatastr ) } $ans->answer));

			push(@adrs,$iadr);
		});
	}, 1);
	if(@warn) {
		warnung("Die folgenden IP-Adressen haben noch Einträge im DNS:",@warn);
		return if $ENV{"TESTING2"};
		if(line_ja_nein('Sollen diese Einträge gelöscht werden',undef,undef,'ja')) {
			ipnr: foreach my $ipnr(@adrs) {
				print "Lösche $ipnr ... ";

				my $rptr = $ipnr->revstr;
				# my $rzone = $res->query($rptr, "CNAME");
				# $rptr = ($rzone->answer)[0]->cname if $rzone;
				
				my $rzone = $rptr;
				while(1) {
						my $query = $res->query($rzone, "SOA");
						last if $query and ($query->answer)[0]->type eq 'SOA';
						next if $rzone =~ s/^[^\.]+\.//;
						warn "Kein SOA für $ipnr gefunden!\n";
						next ipnr;
				}
				my $packet = new Net::DNS::Update($rzone);

				$packet->push("pre", new Net::DNS::RR(
						Name  => $rptr, Class => "ANY", Type  => "ANY", TTL => 0));
				$packet->push("update", new Net::DNS::RR(
						Name  => $rptr, Class => "ANY", Type  => "ANY", TTL => 0));

				$packet->sign_tsig($NSI_KEY_NAME, $NSI_KEY) if $NSI_KEY_NAME && $NSI_KEY;

				print $packet->string if $ENV{DEBUG};
				my $ans = $res->send($packet);

				if (defined $ans) {
						my $rcode_info = get_rcode_info( my $rcode = $ans->header->rcode );
						print "NS Addr->Name: $rcode",
							defined $rcode_info && " ($rcode_info)",
							"\n";
				} else {
						print "Nameserver Addr->Name: FEHLER: ",$res->errorstring, "\n";
				}
			}
		}
	}
}
