#!/usr/bin/perl
use Net::DNS;
use IO::Select;
use strict;
$|=1;
my $q;
my $domain = $ARGV[0] || "nic";
my $i = 0;
my $registered = 0;
my $verbosity = 0;
my $tldcache = "TLDs";
my $max_sel = 32;
my $max_resend = 3;
my $glob_expire = 21*86400;
my $sock_resend = 4;
my @RootServers = qw(198.41.0.4 128.9.0.107 192.33.4.12
128.8.10.90 192.203.230.10 192.5.5.241
192.112.36.4 128.63.2.53 198.41.0.10
193.0.14.129 198.32.64.12);
my $cache_updated = 0;
print "Content-type: text/html\r\n\r\n";
$domain = $1 if ($ENV{QUERY_STRING} =~ /domain=([\w-]+)/);
my (%TLD_NAME, %TLD_NS, %TLD_CACHED, %TLD_RESULT);
load_tld_table();
print "Checking '$domain' against ", scalar keys %TLD_NAME, " TLDs...\n";
print "\r\n";
my $sel = IO::Select->new();
my $res = Net::DNS::Resolver->new();
$res->usevc(0); # be quick
$res->debug(0); # be silent
$res->recurse(1); # be recursive...why not?
$res->retry(1);
$res->retrans(3);
my @tlds = keys %TLD_NAME;
my @ready;
my (%SOCK_TLD, %SOCK_AGE, %SOCK_FILENO);
my $i = 0;
my $stdom = 0;
TLD: while ((@tlds and $sel->count < $max_sel) or $sel->count) {
@ready = $sel->can_read(0.1);
# print scalar @tlds, ", cnt: ", $sel->count, ", ", scalar keys %SOCK_TLD, " keys, ", $#ready+1, " ready\n";
# resend timed out queries
if (!@ready and $sel->count >= $max_sel or !@tlds) {
print "Sanitizing overflowed queue..." if $sel->count >= $max_sel and $verbosity;
sleep(1);
my $sock;
foreach $sock(keys %SOCK_AGE) {
my $ctime = time();
if ($ctime - $SOCK_AGE{$sock} > $sock_resend) {
# return domain to queue
unshift @tlds, $SOCK_TLD{$sock};
print "Request for $SOCK_TLD{$sock} timed out.\n" if $verbosity;
$sel->remove($SOCK_FILENO{$sock});
delete $SOCK_AGE{$sock};
delete $SOCK_TLD{$sock};
delete $SOCK_FILENO{$sock};
undef $sock;
}
}
# print "cleaned: ", scalar @tlds, ", cnt: ", $sel->count, ", ", scalar keys %SOCK_TLD, " keys, ", $#ready+1, " ready\n";
}
if (@tlds and $sel->count < $max_sel) {
my $tld = pop @tlds;
if ($TLD_RESULT{$tld} > 0) {
$TLD_RESULT{$tld}--;
} else {
next TLD if (defined $TLD_RESULT{$tld});
$TLD_RESULT{$tld} = $max_resend;
}
my $ns = get_ns($tld);
print "Could not get NS for $domain$tld, skipped.\n" and next TLD unless $ns;
$res->nameservers($ns);
my $sock = $res->bgsend($domain.$tld, "NS", "IN");
print "Could not queue request: ", $res->errorstring, "\n" and next TLD unless $sock;
$sel->add($sock);
$SOCK_TLD{$sock} = $tld;
$SOCK_AGE{$sock} = time();
$SOCK_FILENO{$sock} = fileno($sock);
print "Sent request for $domain$tld to $ns\n" if $verbosity;
}
SOCK: foreach my $sock(@ready) {
next SOCK unless $sock; #???
my $rep;
my $tld = $SOCK_TLD{$sock};
$rep = handle_response($res->bgread($sock));
$sel->remove($sock);
delete $SOCK_TLD{$sock};
delete $SOCK_AGE{$sock};
undef $sock;
unless ($rep) {
print "Could not read reply for $domain$tld: ", $res->errorstring, "\n";
push @tlds, $tld;
next TLD;
}
# print "Read reply for $domain$tld: ";
if ($rep == 1) {
# print "exists.\n";
$TLD_RESULT{$tld} = 'reg';
print "$tld ";
if ($stdom++ > 15) {
print "\r\n";
$stdom = 0;
}
} elsif ($rep == -1) {
# print "FREE.\n";
print "$tld ";
if ($stdom++ > 15) {
print "\r\n";
$stdom = 0;
}
$TLD_RESULT{$tld} = 'free';
} else {
$rep = $$rep[rand(100) % (scalar @$rep)];
# print "-> $rep\n";
$res->nameservers($rep);
my $sock = $res->bgsend($domain.$tld, "NS", "IN");
unless ($sock) {
print "Could not queue request for $domain$tld: ", $res->errorstring, "\n";
push @tlds, $tld;
next TLD;
}
print "Sent request for $domain$tld to $rep\n" if $verbosity;
$sel->add($sock);
$SOCK_TLD{$sock} = $tld;
$SOCK_AGE{$sock} = time();
$SOCK_FILENO{$sock} = fileno($sock);
$TLD_RESULT{$tld} = $max_resend;
}
}
}
store_tld_table() if $cache_updated;
print "Stored $cache_updated new records in TLD NS cache.\n" if $cache_updated;
print "\r\n\r\nReport for '$domain'
\n";
print "\r\n";
my $cellcount = 0;
my $tld;
@tlds = sort keys %TLD_NAME;
while ($tld = shift @tlds or $cellcount % 16 != 0) {
print "" if ($cellcount % 16 == 0 and $cellcount > 0);
print "\r\n" if ($cellcount % 16 == 0);
print " ", ($tld ? $tld : ' '), "\r\n";
$cellcount++;
}
print "
\r\n\r\n";
print '
TotalResolve by Rojer.';
print "
running Perl v$] on $^O.";
#------------------------------------------------
sub handle_response {
my $q = shift;
return undef unless $q;
if ($q->header->ancount > 0) {
print("ancount: ", $q->header->ancount, "\n") if $verbosity;
foreach my $rr ($q->answer) {
print ' 'x$i, $rr->nsdname, "\n" if $rr->type eq 'NS' and $verbosity > 1;
}
return 1;
} elsif ($q->header->nscount > 0) {
print("nscount: ", $q->header->nscount, "\n") if $verbosity;
my @nses = ();
foreach my $rr ($q->authority) {
if ($rr->type eq 'NS') {
print ' 'x$i, $rr->nsdname, "\n" if $verbosity > 1;
push @nses, $rr->nsdname;
}
}
return -1 unless @nses;
return \@nses;
} else { return -1 }
}
sub get_ns {
my $tld = shift;
my @nses;
print "get_ns($tld): " if $verbosity > 1;
if ($TLD_NS{$tld} and (time() < $TLD_CACHED{$tld} + $glob_expire)) {
@nses = split ' ', $TLD_NS{$tld};
my $ns = $nses[rand(100) % (scalar @nses)];
print "$ns (cached)\n" if $verbosity > 1;
return $ns;
}
my $res = Net::DNS::Resolver->new();
$res->retry(1);
$res->retrans(3);
$res->nameservers($RootServers[rand(100) % (scalar @RootServers)]);
$res->usevc(0);
GETANS:
my $ans = $res->send($tld, "NS", "IN");
return undef unless $ans;
# resolve to IP and record
my $rep = handle_response($ans);
if ($rep == 1) {
foreach my $rr ($ans->answer) {
next unless $rr->type eq 'NS';
my $res_l = Net::DNS::Resolver->new();
$res_l->nameservers($rr->nsdname);
my @ns_ips = $res_l->nameservers;
push @nses, @ns_ips;
}
} elsif (ref($rep) eq 'ARRAY') {
$res->nameservers($$rep[rand(100) % (scalar @$rep)]);
print "get_ns()->",$res->nameservers,"\n";
goto GETANS;
}
return undef unless @nses;
$TLD_NS{$tld} = join ' ', @nses;
$TLD_CACHED{$tld} = time();
$cache_updated++;
store_tld_table();
my $ns = $nses[rand(100) % (scalar @nses)];
print "$ns\n" if $verbosity > 1;
return $ns;
}
sub load_tld_table {
open (TF, "<$tldcache") or die "Could not open TLD table file: $!\n";
while () {
chomp;
my ($tld, $name, $ns, $exp) = split '#', $_;
next unless $name;
$TLD_NAME{$tld} = $name;
if ($ns) {
$TLD_NS{$tld} = $ns;
$TLD_CACHED{$tld} = $exp;
}
}
close TF;
}
sub store_tld_table {
open (TF, ">$tldcache") or die "Could not open TLD table file: $!\n";
while (my ($tld, $name) = each %TLD_NAME) {
print TF "$tld#$name#$TLD_NS{$tld}#$TLD_CACHED{$tld}\n";
}
close TF;
}