use utf8;
use strict;
use warnings; no warnings qw(redefine);
use Dbase::Help qw(DoFn quote);
use Dbase::IP;
use Net::DNS;
use Cf qw($NSE $NSI);

my $res = new Net::DNS::Resolver;

sub nslist($$\$$) {
	my($zone,$adr,$ret,$igns) = @_;

	$res->nameservers($adr);
	my $pack = new Net::DNS::Packet($zone, "NS");
	my $query = $res->send($pack);
	if ($query and $query->header->ancount) {
		my @res = grep { exists $_->{'nsdname'} } @{$query->{'answer'}};
		unless(@res) {
			$$ret .= "Kein vernünftiger NS-Antwort-Typ für $zone\n";
			return ();
		}
		@res = map { $_->{'nsdname'} } @res;
		@res =  grep { not exists $igns->{$_} } @res;
		return ($query, @res);
	} else {
		$$ret .= "Keine vernünftige NS-Antwort für $zone\n";
		return ();
	}
}

sub serok($$$) {
	my($ret,$ser,$se)=@_;
	if($$ser) {
		$$ser == $se;
	} else {
		$$ser = $se;
		1;
	}
}

sub nscheck(\%$$$\$\$;$) {
	my($checked,$zone,$name,$adr,$ret,$ser,$flag) = @_;
	$flag=0 unless $flag;
	$res->nameservers($adr || $name);
	return 1 if defined $name && $checked->{lc($name)}++;
	my $x = "(??? Fehler!)";

	my $pack = new Net::DNS::Packet($zone, "SOA");
	# $pack->header->aa(1);
	my $query = $res->send($pack);
	if ($query and $query->header->ancount and ( $query->header->aa or $flag&2 )) {
		if(UNIVERSAL::isa(($query->answer)[0],"Net::DNS::RR::SOA")) {
			$$ret .= sprintf "DNS-Check : %-20s %-15s %-5s serial %d\n",$name||$x,$adr||"??","OK",($query->answer)[0]->serial;
			serok($ret,$ser,($query->answer)[0]->serial) or return 0;
		} else {
			$$ret .= sprintf "DNS-Check : %-20s %-15s %-5s Bad RR %s\n",$name||$x,$adr||"??","OK",ref(($query->answer)[0]);
			0;
		}
	} elsif ($query and $query->header->ancount) { ## no AA
		if(UNIVERSAL::isa(($query->answer)[0],"Net::DNS::RR::SOA")) {
			$$ret .= sprintf "DNS-Check : %-20s %-15s %-5s serial %d\n",$name||$x,$adr||"??","-AUTH", ($query->answer)[0]->serial;
		} else {
			$$ret .= sprintf "DNS-Check : %-20s %-15s %-5s Bad RR %s\n",$name||$x,$adr||"??","-AUTH",ref(($query->answer)[0]);
		}
		0;
	} else {
		$name = $adr unless defined $name;
		$$ret .= sprintf "DNS-Check : %-20s %-15s %-5s %s\n",$name,$adr||"??","FAIL", $res->errorstring;
		0;
	}
}

# flag&1: Text im Erfolgsfall zurückliefern; sonst 0
# flag&2: auch externen Server (de-nic?) testen
# flag&4: DNS-Debugging

sub domain_check($;$$$) {
	my($dom,$flag,$nse,$igns)=@_;
	$flag = 0 unless defined $flag;
	if($igns) {
		$igns = { map { $_,1 } @$igns };
	} else {
		$igns = {};
	}
	$igns=[] unless $igns;
	my $ser;
	my $ok = 1;
	my %checked;

	$res->debug(($flag&4)?1:0);

	my $ret = "";
	$flag=0 unless $flag;
	unless(UNIVERSAL::isa($nse,"HASH")) {
		if(ref $nse) {
			$nse = { map { ($_,1) } @$nse };
		} elsif(defined $nse) {
			$nse = {$nse => 1};
		} else {
			$nse = {};
		}
	}

	if($dom !~ /^\d+$/) {
		my $d = DoFn("select id from domainkunde where domain = '${\quote $dom}' and (ende is NULL or ende > UNIX_TIMESTAMP(NOW()))");
		return "Domain '$dom' unbekannt!\n" unless $d;
		$dom = $d;
	}
	my($ns,$doma) = DoFn("select nserver,domain from domainkunde where id = $dom");
	{
		my $nsn;
		if($ns) {
			my($ip,$bit,$nam)=DoFn("select ip6,bits from ipkunde where id = $ns");
			$nsn = Dbase::IP->new_db($ip,0)->str unless $bit;
		} else {
			$nsn = ($flag&2) ? $NSE : $NSI;
		}
		my $did = 0;
		if($nsn) {
			my ($q,@nsl) = nslist($doma,$nsn,$ret,$igns);
			foreach my $n(@nsl) {
				$nse->{$n}=1;
				$did++;
			}
			unless($did) {
				$ret .= "*** $nsn hat keine NS-Records geliefert ***\n";
				$ok = 0;
			}
		}
	}
	if($ns) {
		my($ip,$bit,$nam)=DoFn("select ip6,bits,name from ipkunde where id = $ns");
		$ip = Dbase::IP->new_db($ip,$bit);
		if($bit) {
			$ok=0;
			$ret .= "Netzadresse (".$ip->str.") als Nameserver?\n";
		} else {
			$ns = "#$ns:".$ip->str;
			$ok &= nscheck(%checked,$doma,$nam,$ip->str,$ret,$ser);
			if(defined $nam) {
				delete $nse->{$nam};
				$ns .= " ($nam)";
			} else {
				$ns .= " (kein Name!FEHLER)";
				$ok=0;
			}
			my ($q,@nsl) = nslist($doma,$ip->str,$ret,$igns);
			$ok = 0 unless @nsl;
			foreach my $n(@nsl) {
				my $nsa;
				qal: foreach my $qa(@{$q->{'additional'}}) {
					if($qa->name eq $n) {
						next if $qa->type ne 'A'; # IPv6.koennen.wir.noch.net, vgl. RT#210460
						$nsa = $qa->address;
						last qal;
					}
				}
				if(defined $nam && $n eq $nam) {
					$nam = "";
				} else {
					$ok &= nscheck(%checked,$doma,$n,$nsa,$ret,$ser);
					delete $nse->{$n};
				}
			}
			if(defined $nam && $nam ne "") {
				$ret .= <<END;
Warnung   : $nam ist nicht in der Serverliste. Ist das Absicht?
END
			}
		}
	}
	foreach my $ns(keys %$nse) {
		$ok &= nscheck(%checked,$doma,$ns,undef,$ret,$ser,$flag&~2);
	}
	$ok &= nscheck(%checked,$doma,$NSE,undef,$ret,$ser,$flag|2) if $flag & 2;
	return ($ok,$ret) if wantarray;
	return 0 if $ok and not $flag&1;
	$ret;
}

sub DESTROY {} ## Duh??

1;
