#!/usr/bin/perl
#
# ckdn - ChecK Domain Name
# Version 2.2.4
# Completely rewritten in Perl using Net::DNS module
#
# Version 1.0 by K. Leipold
# Version 2.2.3 by H. Wirtz / K. Leipold
# (c)1995-2002 DFN-Verein
#
# Changes:
# 19990831	wirtz@dfn.de		initial version
# 19990907	wirtz@dfn.de		wrong nameserver in delegation check
# 19990908	wirtz@dfn.de		DFN-routines installed
# 19990910	wirtz@dfn.de		Bug in using IP-Adr or name eleminated
# 19991011	wirtz@dfn.de		recognation made case-in-sense. for
#                                       $pri_ns
# 19991012      wirtz@dfn.de            output buffering disabled
# 20000111	wirtz@dfn.de		wrong variable at "No SOA Record for..."
# 20000112	wirtz@dfn.de		trouble with reg matching pattern for
#                                       finding primary disabled
# 20000120	wirtz@dfn.de		same serial check installed
# 20000203	wirtz@dfn.de		better error msg when no SOA found
# 20000306	wirtz@dfn.de		problem with primary fixed when domain
#                                       has no delegation
# 20010329	poldi@dfn.de		kleiner patch fuer ip6.int
# 20020207	poldi@dfn.de		Patches fuer reverse mapping
# 20020708	poldi@dfn.de		bugfix im find_delegating 
#					(wenn invalid NS im SOA z.B. info)
# 20020821	poldi@dfn.de		ein paar Patches von Heiko eingepflegt
# 20030702	wirtz@dfn.de		Bei CNAME Vertauschung entfernt
#
# Todo:
# 19990831:
#		- Translating error messages in German.
#	 	- Making ready for WWW.
#		- Writing license and installing description.
# 19991001	- printing secondary-line in /tmp/ckdn-db-entry
#

use Net::DNS;

# Globale Variablen
$RESOLV_DNS="deneb.dfn.de";
$ASK_DNS=$RESOLV_DNS;
$DNS_TIMEOUT=15;
$DNS_RETRANS=5;
$DNS_QUERY_RETRY=5;
$REFRESH_MIN=10000;
$REFRESH_MAX=86400;
$RETRY_MIN=1800;
$RETRY_MAX=28800;
$EXPIRE_MIN=604800;
$EXPIRE_MAX=3600000;
$TTL_MIN=180;
$TTL_MAX=345600;

# Ausgabepuffer abschalten:
$|=1;

if(-e "/usr/local/bin/nckdn.pl")
{
	require("/usr/local/bin/nckdn.pl");
}

# Kommandozeilen-Argumente auswerten
foreach(@ARGV)
{
	if(substr($_,0,1) eq "@")
	{
		$ASK_DNS=substr($_,1,length($_));
		$AT_FLAG=1;
	}
	else
	{
		if ($_=~/^([0-9]+)(?:\.([0-9]+)(?:\.([0-9]+)(?:\.([0-9]+))?)?)?$/)
		{
			if($1!=0 && $2==0 && $3==0 && $4==0)
			{
				$DOMAIN="$1.in-addr.arpa.";
			}
			elsif($1!=0 && $2!=0 && $3==0 && $4==0)
			{
				$DOMAIN="$2.$1.in-addr.arpa.";
			}
			elsif($1!=0 && $2!=0 && $3!=0 && $4==0)
			{
				$DOMAIN="$3.$2.$1.in-addr.arpa.";
			}
			elsif($1!=0 && $2!=0 && $3!=0 && $4!=0)
			{
				$DOMAIN="$4.$3.$2.$1.in-addr.arpa.";
			}
		}
		else
		{
			$DOMAIN=lc($_);
		}
	}
}

if (!$DOMAIN)
{
	print "Usage: ckdn [\@<nameserver>] <domain>\n";
	print "       <nameserver> = Nameserver to use\n";
	print "       <domain>     = Domain to query for\n";
	print "\n";
	print "Example: ckdn \@a.root-servers.net 10.0.0.0\n";
	exit(9);
}

# Wenn DFN-Routinen aktiv
if($DFN && $AT_FLAG==0)
{
	my ($ret);

	# primaeren Nameserver aus Datensatz holen
	$ret=dfn_pri_ns($DOMAIN);
	if($ret ne "")
	{
		$ASK_DNS=$ret;
	}
}

# Infos ausgeben
print "Nameserver: $ASK_DNS\n";
print "Domain:     $DOMAIN\n";
print "------------------------------------------------------------------------------\n";

	
# Resolver-Object anlegen
$res=new Net::DNS::Resolver;
$res->tcp_timeout($DNS_TIMEOUT);
$res->retrans($DNS_RETRANS);
$res->retry($DNS_QUERY_RETRY);
nochmal:
$res->nameservers($ASK_DNS);

# Infos holen
$ns=$res->search("$DOMAIN","ANY");
if(!$ns)
{
	print "\t=> Error: ",$res->errorstring,"\n";
	exit(11);
}

# Zuerst primary feststellen
foreach $rr ($ns->answer)
{
	next if($rr->type ne "SOA");
	$pri_ns=$rr->mname;
	last;
}

# Wenn kein SOA-Record vorhanden war (d.h. primary noch nicht bekannt)
if(!$pri_ns)
{
	foreach $rr ($ns->authority)
	{
		next if($rr->type ne "NS");
		$ASK_DNS=$rr->nsdname;
		next if(grep(/^$ASK_DNS/i,@seen));
		print "Trying $ASK_DNS for $DOMAIN\n";
		push(@seen,$ASK_DNS);
		goto nochmal;
	}
}

# Nameserversatz vom primary holen
if($AT_FLAG)
{
	$res->nameservers($ASK_DNS);
}
else
{
	$res->nameservers($pri_ns);
}
$ns_tmp=$res->search("$DOMAIN","ANY");
if(!$ns_tmp)
{
	#print "Getting nameserver list from primary: ",$res->errorstring,"\n";
	print "\t=> No answer from primary nameserver.\n";
}
else
{
	$ns=$ns_tmp;
}

# Nameserverliste aufbauen
foreach $rr ($ns->answer)
{
	next if($rr->type ne "NS");
	#push(@ns,$rr->nsdname) if($rr->nsdname =~ /$pri_ns/i);
	push(@ns,$rr->nsdname) if($rr->nsdname =~ /^$pri_ns$/i);
}
# Wenn kein primaerer Nameserver im Nameserversatz
if(scalar(@ns)==0 && $pri_ns ne "")
{
	print "\t=> SOA primary $pri_ns missing in NS list;  perhaps hidden primary\n";
	$hidden_pri=$pri_ns;
}
# Sekundaere Nameserver in Liste packen
foreach $rr ($ns->answer)
{
	next if($rr->type ne "NS");
	push(@ns,$rr->nsdname) if($rr->nsdname ne $pri_ns);
}

# Alle Adressen zu den Namen speichern
foreach $rr ($ns->additional)
{
	next if($rr->type ne "A");
	$adr{$rr->name}=$rr->address;
}

#
# Schleife ueber alle Nameserver mit Auswertung
#
foreach $nameserver (@ns)
{
	if($adr{$nameserver})
	{
		$res->nameservers($adr{$nameserver});
	}
	else
	{
		$res->nameservers($nameserver);
	}

	# Nameserver abfragen
	$ns=$res->search("$DOMAIN","ANY");
	if(!$ns)
	{
		if($nameserver eq $ns[0])
		{
			$out_nsname="Primary";
		}
		else
		{
			$out_nsname="Secondary";
		}
		print "$out_nsname:  Query failed: ",$res->errorstring,"\n";
		print "\t=> $nameserver does not answer\n";
	}
	else
	{
		# Nameservernamen ausgeben
		if(($nameserver eq $ns[0]) && !$hidden_pri)
		{
			$out_nsname="Primary:    $nameserver";
		}
		else
		{
			$out_nsname="Secondary:  $nameserver";
		}
	
		# Pruefen, ob authoritative Antwort
		if($ns->header->aa==1)
		{
			$out_auth="auth";
		}
		else
		{
			$out_auth="non-auth";
		}
	
		# SOA-Record auf Plausibilitaet pruefen
		$soa="";
		foreach $rr ($ns->answer)
		{
			next if($rr->type ne "SOA");

			# Flag fuer vorhandenen SOA-Record setzen
			$soa=$rr->type;

			# Seriennummer merken
			$out_serial=$rr->serial;
	
			# Statuszeile ausgeben
			printf("%-54s %-8s %s\n",$out_nsname,$out_auth,$out_serial);
			if($out_auth ne "auth")
			{
				print "\t=> $out_nsname answered non-authoritative!\n";
			}
		
			if($nameserver eq $ns[0])
			{
				# Serial-No des primary merken
				$pri_serial=$rr->serial;
	
				# Timer tests
				if($rr->refresh < $REFRESH_MIN || $rr->refresh > $REFRESH_MAX)
				{
					print "\t=> SOA value refresh=",$rr->refresh," doesn't fit in range [$REFRESH_MIN - $REFRESH_MAX ]\n";
				}
				if($rr->retry < $RETRY_MIN || $rr->retry > $RETRY_MAX)
				{
					print "\t=> SOA value retry=",$rr->retry," doesn't fit in range [$RETRY_MIN - $RETRY_MAX ]\n";
				}
				if($rr->expire < $EXPIRE_MIN || $rr->expire > $EXPIRE_MAX)
				{
					print "\t=> SOA value expire=",$rr->expire," doesn't fit in range [$EXPIRE_MIN - $EXPIRE_MAX ]\n";
				}
				if($rr->minimum < $TTL_MIN || $rr->minimum > $TTL_MAX)
				{
					print "\t=> SOA value min_ttl=",$rr->minimum," doesn't fit in range [$TTL_MIN - $TTL_MAX ]\n";
				}
			}
			else
			{
				if($rr->serial<$pri_serial)
				{
					print "\t=> Zone update in < ",$rr->refresh." seconds\n";
				}
				elsif(($rr->serial>$pri_serial)&&$pri_serial)
				{
					print "\t=> ",$rr->serial," > ",$pri_serial," ZONE WILL NEVER BE UPDATED\n";
				}
			}

			# Konsistenz des Nameserversatzes pruefen
			check_nameserver_set(answer);

			# Testen, Name ein CNAME ist
			$ns=$res->search($nameserver,"CNAME");
			if($ns)
			{
				foreach $rr ($ns->answer)
				{
			        	next if($rr->type ne "CNAME");
					#print "\t=> ",$rr->cname," is a CNAME for $nameserver.\n";
					print "\t=> $nameserver is a CNAME for ",$rr->cname,".\n";
				}
			}                                   
		}

		# Wenn kein SOA-Record vorhanden
		if(!$soa)
		{
			print "$out_nsname: $nameserver\n";
			print "\t=> No SOA found for zone $DOMAIN at $nameserver\n";
		}
	}
}

# Erstellen der Dateien zur Weiterverarbeitung per vi
if($DFN)
{
	print dfn_create_files();
}

# Delegation Check
$res->nameservers($RESOLV_DNS);

if($DOMAIN=~/\.$/)
{
	$_=$DOMAIN;
}
else
{
	$_=$DOMAIN.".";
}

# linken Teil des Domainnamens entfernen und nach SOA-Record suchen
while(s/^[^.]+\.//)
{
	next if (/^in-addr\.arpa\.$/);
	# Vereinfachung
	if (/^de\.$/)
	{
		$delegating="sss-de1.de.net.";
		last;
	}

	$_="." if /^$/;

	# Nach SOA-Record suchen
	$ns=$res->search($_,"SOA");
	if($ns)
	{
		foreach $rr ($ns->answer)
		{
	        	next if($rr->type ne "SOA");
			$delegating=$rr->mname;
			last;
		}
		($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($delegating);
		if (! $name) {
		  $ns=$res->search($_,"NS");
		  if($ns) {
                    foreach $rr ($ns->answer) {
                       next if($rr->type ne "NS");
                       $delegating=$rr->nsdname;
                       last;
                    }
                  }
                }
	}
	last if($delegating);
}

if($delegating)
{
	# Delegierenden Nameserver nach NS fragen
	$res->nameservers($delegating);
	$ns=$res->search($DOMAIN,"NS");
	if($ns)
	{
		print "Delegating: $delegating\n";
		check_nameserver_set(answer);
	}
	
	else
	{
		$ns=$res->send($DOMAIN,"NS");
		if($ns)
		{
			print "Delegating: $delegating\n";
			check_nameserver_set(authority);
		}
		else
		{
			print "No delegation.\n";
		}
	}
}
else
{
	print "No delegation.\n";
}

sub check_nameserver_set
{
	($method) = @_;
	# Konsistenz der Delegation pruefen
	@all_servers=@ns;
	@additionals=();
	@missings=();
	@tmp_ns=();
	if ($method eq "answer") {
		foreach $rr ($ns->answer)
		{
			next if($rr->type ne "NS");
			$t=$rr->nsdname;
			push(@tmp_ns,$t);
			if (!grep (/^$t$/i, @all_servers)) 
			{
				push(@all_servers,$t);
			}
		}
	}
	if ($method eq "authority") {
		foreach $rr ($ns->authority)
		{
			next if($rr->type ne "NS");
			$t=$rr->nsdname;
			push(@tmp_ns,$t);
			if (!grep (/^$t$/i, @all_servers)) 
			{
				push(@all_servers,$t);
			}
		}
        	if (@tmp_ns == ()) {
          	print "No delegation.\n";
          	return(); }
	}
	
	@all_servers=sort(@all_servers);

	foreach $ns1 (@all_servers)
	{
		if(!grep(/^$ns1$/i,@ns))
		{
			push(@additionals, $ns1);
		}
		if(!grep(/^$ns1$/i,@tmp_ns))
		{
			push(@missings, $ns1);
		}
	}
	
	# Zusaetzliche Server ausgeben
	if(scalar(@additionals)>0)
	{
		print "\t=> additional nameservers:\n";
		foreach(@additionals)
		{
			print "\t\t$_\n";
		}
		# Pruefen, ob Seriennummer gleich ist
		if($rr) # Prueft, ob ueberhaupt ein Objekt vorh. ist
		{
			if($pri_serial==$rr->serial)
			{
				print "\t=> Looks quite stable. Same serial as primary's!\n";
			}
		}
	}
	# Fehlende Server ausgeben
	if(scalar(@missings)>0)
	{
		print "\t=> missing nameservers:\n";
		foreach(@missings)
		{
			print "\t\t$_\n";
		}
		# Pruefen, ob Seriennummer gleich ist
		if($rr) # Prueft, ob ueberhaupt ein Objekt vorh. ist
		{
			if($pri_serial==$rr->serial)
			{
				print "\t=> Looks quite stable. Same serial as primary's!\n";
			}
		}
	}
}

