#!/usr/bin/perl -w
# (C) 2003-2007 Willem Jan Hengeveld <itsme@xs4all.nl>
# Web: http://www.xs4all.nl/~itsme/
#      http://wiki.xda-developers.com/
#
# $Id$
#
use strict;
use Getopt::Long;

my $verbose;
GetOptions(
	"v"=>\$verbose
);

my %g_answers;

for (@ARGV) {
	tracedomain($_);
}
sub splitdomain {
	my @split= grep { length($_) } split /\./, shift;
	push @split, "";
	return reverse @split;
}
sub sortuniqlc {
	my %uniq;
	$uniq{lc($_)}++ for (@_);

	return sort keys %uniq;
}
sub dig {
	my ($name, $server)= @_;

	if ($g_answers{lc($server)}{lc($name)}) {
		return $g_answers{lc($server)}{lc($name)};
	}
	my %dig;

	if ($server) {
		open FH, "dig $name any \@$server|"  or die "dig $name any \@$server";
	}
	else {
		open FH, "dig $name any|"  or die "dig $name any";
	}

	local $_;
	while (<FH>) {
		chomp;
		next if /^;/;
		next if /^$/;

		if (/(\S+)\s+(\d+)\s+IN\s+(\w+)\s+(.*)/) {
			my ($domain, $ttl, $type, $data)= ($1, $2, $3, $4);
			push @{$dig{lc($domain)}{uc($type)}}, {ttl=>$ttl, data=>$data};
		}
	}
	close FH;

	$g_answers{lc($server)}{lc($name)}= \%dig;
	return \%dig;
}

sub tracedomain {
	my $domain= shift;
	my @path = splitdomain($domain);

	# start with local server to find rootservers
	my @servertrace= ([]);
	my @pathtrace= ("");
	my $path= "";
	for (@path) {
		if ($path eq ".")  {
			$path = "$_$path";
		}
		else {
			$path = "$_.$path";
		}

		my %classify;
		my %servers;
		for my $svr (@{$servertrace[-1]}, "") {
			my $dig= dig($path, $svr);
#map { $_->{data} } map { @{$dig->{lc($_)}{A}} } grep { exists $dig->{lc($_)} && exists $dig->{lc($_)}{A} }
			my @nsservers = sortuniqlc map { $_->{data} } @{$dig->{lc($path)}{NS}};
			$servers{$svr}= \@nsservers;
			my $key= join(";",@nsservers);
			push @{$classify{$key}}, $svr;
		}
		# only warn if there are multiple non zero answers.
		if ((grep { @{$classify{$_}}>0 } keys %classify )> 1) {
			print "WARNING: not all servers gave same answer for $path\n";
			for (keys %classify) {
				printf("   %s : %s\n", join(", ", @{$classify{$_}}), $_);
			}
		}

		my @servers= sortuniqlc map {@{$servers{$_}}} keys %servers;
		push @servertrace, \@servers;
		push @pathtrace, $path;
	}

	if ($verbose) {
		for (1..$#pathtrace) {
			printf(" %s [ %s ]", $pathtrace[$_], join(",",@{$servertrace[$_]}));
		}
	}
	else {
		printf("%s [ %s ]\n", $pathtrace[-1], join(",",@{$servertrace[-1]}));
	}
	print "\n";
}