use utf8;
use warnings; no warnings "redefine";
use strict;
use utf8;

use Net::DNS;
use Net::DNS::Update;
use Cf qw($NSI $NSI_KEY_NAME $NSI_KEY);
use Fehler qw(problem warnung);
use Dbase::Help qw(DoFn);
use Loader qw(domain_whois get_rcode_info);
use Dbase::IP;

my $res = new Net::DNS::Resolver;
$res->nameservers($NSI) unless $ENV{'TESTING3'};

sub serve_ipnr($$;$) {
	return if $ENV{'TESTING3'};
	my($idi,$set,$kn) = @_;

	my ($text,$ipnr,$bits) = DoFn("select name,ip6,bits from ipkunde where id=$idi");
	$ipnr = Dbase::IP->new_db($ipnr,$bits);

	if ( !$set && $bits ) { # Beendigung eines IP-Adressbereichs

		my $whois = join '',
		  domain_whois( $ipnr->str,
			    'whois.ripe.net -B -r -T inet'
			  . ( !$ipnr->is_v4 && '6' )
			  . 'num <domain-ace>' )
		  or return;

		if ( $whois =~ /^status:\s+ASSIGNED\b/mi ) {
			$whois =~ y/\cM//d;
			$whois =~ /^(inet6?num:.*?)\n\n/msi
			  or return problem "whois-Ausgabe von RIPE hat unerwartetes Format:\n$whois";
			warnung "Bereich ist laut RIPE-DB noch assigned:\n\n$1";
		}
	}

	my $type;
	if(defined $bits and $bits == 0) {
		$type = $ipnr->is_v4 ? "A" : "AAAA";
	} else {
		return undef; ## XXX TODO: INFO/PTR-Record o.ä. anlegen
	}

	return undef if not defined $text;
	my $xs = $set ? "+" : "-";
	my $addr = $ipnr->addr;

# Set/clear name->ip
	name: {
		my $zone = $text;
		while(1) {
			my $query = $res->query($zone, "SOA");
			last if $query and $query->{'answer'}[0]{'type'} eq "SOA";
			next if $zone =~ s/^.+?\.//;
			warn "Kein SOA für $text gefunden!\n"
				unless $ENV{'TESTING2'};
			last name;
		}
		my $packet = new Net::DNS::Update($zone);

		$packet->push("pre", new Net::DNS::RR(
			Name  => $text, Class => "IN", Type  => $type,
			Address => $addr, TTL => 0)) if not $set;
		$packet->push("pre", new Net::DNS::RR(
			Name  => $text, Class => "NONE",
			Type  => $type, TTL => 0)) if $set;

		$packet->push("update", new Net::DNS::RR(
			Name  => $text, Class => "ANY", Type  => $type));
		$packet->push("update", new Net::DNS::RR(
			Name  => $text, Class => "IN", Type  => $type,
			Address => $addr, TTL => 24*3600)) if $set;

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

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

		if($ipnr->is_v4rf > 1) {
			my $vrf = $ipnr->str4;
			$packet = new Net::DNS::Update($zone);

			$packet->push("pre", new Net::DNS::RR(
				Name  => $text, Class => "IN", Type  => "A",
				Address => $vrf, TTL => 0)) if not $set;
			$packet->push("pre", new Net::DNS::RR(
				Name  => $text, Class => "NONE",
				Type  => "A", TTL => 0)) if $set;

			$packet->push("update", new Net::DNS::RR(
				Name  => $text, Class => "ANY", Type  => "A"));
			$packet->push("update", new Net::DNS::RR(
				Name  => $text, Class => "IN", Type  => "A",
				Address => $vrf, TTL => 24*3600)) if $set;

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

			my $ans = $res->send($packet);
			if (defined $ans) {
				my $rcode_info = get_rcode_info( my $rcode = $ans->header->rcode );
				print "${xs}NS Name->Addr (VRF): $rcode",
					defined $rcode_info && " ($rcode_info)",
					"\n";
			} else {
				print $xs,"Nameserver Name->Addr (VRF): FEHLER: ",$res->errorstring, "\n";
			}
		}
	}
	
	addr: {
		my $rptr = $ipnr->revstr;
		my $rzone = $res->query($rptr, "CNAME");
		$rptr = $rzone->{'answer'}[0]{'cname'} if $rzone;
		
		$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 $addr gefunden!\n"
				unless $ENV{'TESTING2'};
			last addr;
		}
		my $packet = new Net::DNS::Update($rzone);

		$packet->push("pre", new Net::DNS::RR(
			Name  => $rptr, Class => "IN", Type  => "PTR",
			PTRdname => $text, TTL => 0)) if not $set;
		$packet->push("pre", new Net::DNS::RR(
			Name  => $rptr, Class => "NONE", Type  => "PTR",
			TTL => 0)) if $set;

		$packet->push("update", new Net::DNS::RR(
			Name  => $rptr, Class => "ANY", Type  => "PTR"));
		$packet->push("update", new Net::DNS::RR(
			Name  => $rptr, Class => "IN", Type  => "PTR",
			PTRdname => $text, TTL => 24*3600)) if $set;

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

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

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

}

1;
