#!/usr/bin/perl -w
#
# lookup.pl
#
# Copyright (c) 2012 by Peter_Siegrist(SystemLoesungen)  (PSS@ZweierNet.ch)
# www.IPv6Tech.ch
#
# All Rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#

use strict;
use Net::DNS;
use Net::IP;
eval { require Data::Dumper; } and import Data::Dumper;
$Data::Dumper::Indent = 3;
$Data::Dumper::Useqq = 1;

my %RR = map { $_ => 1 } qw(
	A
	AAAA
	AFSDB
	CNAME
	CERT
	DHCID
	DNAME
	EID
	HINFO
	ISDN
	KX
	LOC
	MB
	MG
	MINFO
	MR
	MX
	NAPTR
	NIMLOC
	NS
	NSAP
	NULL
	PTR
	PX
	RP
	RT
	SOA
	SRV
	TKEY
	TSIG
	TXT
	X25
	OPT
	APL
	SSHFP
	HIP
	SPF
	IPSECKEY

);

my @results = ();
my $hostname = shift() or print "Usage: $0 <hostname>\n" and exit;
chomp($hostname);

my $hostsave = $hostname;

my $res = Net::DNS::Resolver->new(dnsrch => 0, defnames => 0);
$res->debug(0);
$res->retrans(3);
$res->udp_timeout(3);
my @nssave = $res->nameservers();

END { print "\nNet::DNS Error status: ", $res->errorstring, "\n" if $res->errorstring ne "NOERROR"; }
	
	
sub get_name {
	my $hostname = shift;
	my @ret = ();
	my $have_name = 0;
	my $answer = $res->send($hostname);
	#print Dumper(\$answer);
	foreach my $rr ($answer->answer ) {
		next unless($rr->type eq "PTR");
		#print Dumper(\$rr);
		push @ret, $rr->ptrdname;
		$have_name = 1;
	}
	$have_name ? return @ret : return "Can't resolve address";
}

sub get_addr {
	my @ret = ();
	my $have_name = 0;
	my $hostname = shift;
	my $answer;
	
	return $hostname if ($hostname =~ /^[0-9a-fA-F]{4}\:+[0-9a-fA-F]{1,4}\:+.+/ or $hostname =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/);
	
	$answer = $res->send($hostname, 'AAAA');
	#print Dumper(\$answer);
	foreach my $rr ($answer->answer ) {
		next unless($rr->type eq "AAAA");
		#print Dumper(\$rr);
		push @ret, $rr->address;
		$have_name = 1;
	}
	
	$answer = $res->send($hostname, 'A');
	#print Dumper(\$answer);
	foreach my $rr ($answer->answer ) {
		next unless($rr->type eq "A");
		#print Dumper(\$rr);
		push @ret, $rr->address;
		$have_name = 1;
	}

	$have_name ? return @ret : return "Can't resolve name";
}


sub rev_resolv {
	
	my $rhostname = shift; 
	my $r1 = "";
	my $aw = $res->send('.', 'NS');
	foreach my $rr ($aw->answer ) {
		#next unless($rr->type eq "NS");
		#print Dumper(\$rr);
		print "0: zone: . ,type: ", $rr->type, ", server: ", $rr->nsdname, "\n";
		$r1 = $rr->nsdname;
		last;
	}
	#print Dumper(\$r1); 
	#print ". -> ", $r1, "\n";
	print "=================================================================================================\n";
	
	$r1 = "a.root-servers.net" if $r1 eq "";
	
	$res->debug(0);
	$res->nameservers( "$r1" );
	print "Using Nameserver: \"$r1\"\n";
	$r1=""; 
	my $aw1 = $res->send("$rhostname", 'PTR');
	foreach my $rr ($aw1->authority ) {
		next unless($rr->type eq "NS");
		#print "DDDD: ",Dumper(\$rr);
		print "1: zone: ", $rr->name, " ,type: ", $rr->type, ", server: ", $rr->nsdname, "\n";
		$r1 = $rr->nsdname;
		last;
	}
	#print Dumper($aw1); 
	#print "1: $rhostname -> ", $r1, "\n";
	print "=================================================================================================\n";
	
	
	$res->nameservers( "$r1" );
	print "Using Nameserver: \"$r1\"\n";
	my $aw2 = $res->send($rhostname, 'PTR');
	foreach my $rr ($aw2->authority ) {
		next unless($rr->type eq "NS");
		#print "DDDD22: ",Dumper(\$rr);
		print "2: zone: ", $rr->name, " ,type: ", $rr->type, ", server: ", $rr->nsdname, "\n";
		$r1 = $rr->nsdname;
		last;
	}
	#print Dumper($aw2); 
	#print "2: $rhostname -> ", $r1, "\n";
	print "=================================================================================================\n";
	
	
	$res->nameservers( "$r1" );
	print "Using Nameserver: \"$r1\"\n";
	my $aw3 = $res->send($rhostname, 'PTR');
	foreach my $rr ($aw3->authority ) {
		next unless($rr->type eq "NS");
		#print "DDDD33: ",Dumper(\$rr);
		print "3: zone: ", $rr->name, " ,type: ", $rr->type, ", server: ", $rr->nsdname, "\n";
		$r1 = $rr->nsdname;
		last;
	}

	
	#print Dumper($aw3); 
	#print "3: $rhostname -> ", $r1, "\n";
	print "=================================================================================================\n";
	
	$res->nameservers( "$r1" );
	print "Using Nameserver: \"$r1\"\n";
	my $aw4 = $res->send($rhostname, 'PTR');
	if ( $aw4->header->ancount > 0 ) {
		foreach my $rr ($aw4->answer ) {
			next unless($rr->type eq "PTR");
			#print "DDDD44: ",Dumper(\$rr);
			print "4: zone: ", $rr->name, " ,type: ", $rr->type, ", resolves to: ", $rr->ptrdname, "\n";
			#$r1 = $rr->ptrdname;
			#last;
		}
		
		#print Dumper($aw4); 
	} else {
		foreach my $rr ($aw4->authority ) {
			next unless($rr->type eq "NS");
			#print "DDDD441: ",Dumper(\$rr);
			print "4: zone: ", $rr->name, " ,type: ", $rr->type, ", server: ", $rr->nsdname, "\n";
			$r1 = $rr->nsdname;
			last;
		}
		
		print "=================================================================================================\n";
		
		$res->nameservers( "$r1" );
		print "Using Nameserver: \"$r1\"\n";
		my $aw4 = $res->send($rhostname, 'PTR');
		foreach my $rr ($aw4->answer ) {
			next unless($rr->type eq "PTR");
			#print "DDDD442: ",Dumper(\$rr);
			print "5: zone: ", $rr->name, " ,type: ", $rr->type, ", resolves to: ", $rr->ptrdname, "\n";
			#$r1 = $rr->ptrdname;
			#last;
		}
		#print Dumper($aw4);
	}
	print "=================================================================================================\n";
	
}





print "\n\n--------- DNS Reverse Lookup and Traversal(s) of $hostsave ------------------------------------\n";

foreach my $nip( get_addr($hostname) ) { 
	my $ip = new Net::IP ($nip) or print (Net::IP::Error());
	print "\nResolve ", $ip->reverse_ip(), " ($hostname)\n\n";
	rev_resolv( $ip->reverse_ip() );
}



#-- addrs and names ---------------
$res->debug(0);

$res->nameservers( @nssave );

my $answer = $res->send($hostname, 'A');
#print Dumper(\$answer);
foreach my $rr ($answer->answer ) {
	next unless($rr->type eq "A");
	#print Dumper(\$rr);
	push @results, "A     " . $rr->address . "   ( " . join( ", ", &get_name($rr->address) ) . " )";
}
push @results, "";
	
$answer = $res->send($hostname, 'AAAA');
#print Dumper(\$answer);
foreach my $rr ( $answer->answer ) {
	next unless($rr->type eq "AAAA");
	#print Dumper(\$rr);
	push @results, "AAAA  " . $rr->address. "   ( " . join( ", ", &get_name($rr->address) ) . " )";
}
push @results, "";

$answer = $res->send($hostname, 'CNAME');
#print Dumper(\$answer);
foreach my $rr ( $answer->answer ) {
	next unless($rr->type eq "CNAME");
	#print Dumper(\$rr);
	push @results, "CNAME " . $rr->cname . "   ( " . join(", ", &get_addr($rr->cname) ) . " )";
}
push @results, "";

# strip hostname part
$hostname =~ /^[^.]+\.(.*)$/;
$hostname = $1;

$answer = $res->send($hostname, "NS");
#print Dumper(\$answer);
foreach my $rr ( grep { $_->type eq 'NS' } $answer->answer ) {
	next unless($rr->type eq "NS");
	#print Dumper(\$rr);
	push @results, "NS    " . $rr->nsdname . "   ( " . join(", ", &get_addr($rr->nsdname) ) . " )";
}
push @results, "";

my @xanswer = $res->mx($hostname);
#print Dumper(\@xanswer);
foreach my $rr ( @xanswer ) {
	next unless($rr->type eq "MX");
	#print Dumper(\$rr);
	push @results, "MX    " . $rr->preference  . " " . $rr->exchange . "   ( " . join(", ", &get_addr($rr->exchange) ) . " )";
}

print "\n\n--------- Found following addresses and names for $hostsave ------------------------------------\n";
map { print "$_\n" } @results;



print "\n\n---------- trying all ressource records on $hostsave -------------------------------------------\n";
foreach my $rrr ( sort keys %RR ) {
	print "== $rrr ===============================================================================================\n";
	my $awr = $res->send($hostsave, "$rrr" );
	print "nscount:", $awr->header->nscount, "\n";
	print "ancount:", $awr->header->ancount, "\n";
	print "arcount:", $awr->header->arcount, "\n";
	print "rcode:", $awr->header->rcode, "\n";
	print "answerfrom:", $awr->answerfrom, "\n";
	foreach my $rr ($awr->authority ) {
		print "Authority.type: ",$rr->type, "\n";
		print "Authority.mname: ",$rr->mname, "\n" if ! $rr->type eq "NS";
		print "Authority.mname: ",$rr->nsdname, "\n" if $rr->type eq "NS";
		print "Authority.name: ",$rr->name, "\n\n";
		
		#print $rr->type ,Dumper(\$rr);
	}
	foreach my $rr ($awr->answer ) {
		print "Answer.type: ",$rr->type, "\n";
		print "Answer.mname: ",$rr->mname, "\n" if ! $rr->type eq "NS";
		print "Answer.mname: ",$rr->nsdname, "\n" if $rr->type eq "NS";
		print "Answer.name: ",$rr->name, "\n";
		print "Answer.address: ",$rr->address, "\n" if $rr->type eq "A";
		print "Answer.address: ",$rr->address, "\n" if $rr->type eq "AAAA";
		print "Answer.cname: ",$rr->cname, "\n" if $rr->type eq "CNAME";
		print "Answer.mname: ",$rr->nsdname, "\n" if $rr->type eq "NS";
		print "\n";
		#print $rr->type ,Dumper(\$rr);
	}
	#print Dumper($awr);
}
