#!/usr/bin/perl 

use strict;
use warnings;
use Net::DNS;
use Net::DNS::Nameserver;
use Time::HiRes qw(sleep time);

our @res = ();
for my $nameserver (
'1.2.3.4', # enter some real ones here!
'999.99.9.0',
) {
	my $res = Net::DNS::Resolver->new;
	$res->nameservers($nameserver);
	$res->retry(1);
	$res->recurse(1);
	$res->dnsrch(0);
	$res->udp_timeout(2);
	push @res, $res;
}

our %cache = (
	'1.20.168.192.in-addr.arpa  IN  PTR' => [ # must reverse lookup myself
		'NOERROR',
		[Net::DNS::RR->new("1.20.168.192.in-addr.arpa. 86400 PTR localhost")],
		[], # VPN client doesn't allow 127.0.0.1 for DNS server, so
		[], # use one of my VMWARE interfaces for it
		{} 
		]
	);

sub reply_handler {
	my ($qname, $qclass, $qtype, $peerhost) = @_;
	print "\n";

	# cache?
	if (exists $cache{"$qname  $qclass  $qtype"}) {
		print " Answering from cache\n";
		return @{ $cache{"$qname  $qclass  $qtype"} };
	}

	# send queries to all servers
	my @bgres = ();
	RES0: foreach my $res (@res) {
		print ' Querying '.$res->{nameservers}[0]."\n";
		push @bgres, [ $res, $res->bgsend($qname, $qtype, $qclass) ];
	}

	# ans wait for the answers
	my $starttime = time();
	my $failedcount = 0;
	RES1: while (grep { defined($_) } @bgres) { # finish if all servers have answered
		RES: foreach my $resl (@bgres) {
			next unless defined $resl;
			my ($res, $sock) = @$resl;
			next RES unless $res->bgisready($sock);
			my $answer = $res->bgread($sock);
			$resl = undef; # mark this server as 'has answered'
			next RES unless $answer;
			if ($answer->{header}->{rcode} eq 'NOERROR') {
				print " Gotcha from ".$res->{nameservers}[0]."!\n";
				$cache{"$qname  $qclass  $qtype"} = [
				         $answer->{header}->{rcode},
				         $answer->{answer},
				         $answer->{authority},
				         $answer->{additional},
				         { aa => $answer->{header}->{aa},
				           ad => $answer->{header}->{ad},
				           ra => $answer->{header}->{ra}
				         }
				       ];
				return @{ $cache{"$qname  $qclass  $qtype"} };
			} else {
				print " Failed from ".$res->{nameservers}[0]."!\n";
				$failedcount++;
			}
		}
		last RES1 if (time() - $starttime) > 5; # finish after timeout
		sleep 0.05; # be nice to out CPU
	}
	if ($failedcount == @bgres) {
		# cache negative answers only if there was no timeout,
		# that is, when all servers reported NXDOMAIN...
		$cache{"$qname  $qclass  $qtype"} = [ 'NXDOMAIN', [], [], [], {} ];
	}
	return ( 'NXDOMAIN', [], [], [], {} );
}

# add some interface to it, if you're not firewalled already
my $ns = Net::DNS::Nameserver->new(
   LocalPort    => 53,
   ReplyHandler => \&reply_handler,
   Verbose      => 1,
) || die "couldn't create nameserver object\n";

while (1) {
	eval {
		$ns->main_loop;
	}
}