#!/usr/bin/perl 
 
## fauxdns.pl - return phony DNS records for sandnet client
## (c)2006 Joe Stewart <jstewart@lurhq.com>

use Net::DNS::Nameserver;
use strict;

my %cache_a  = ();
my %cache_ptr = ();

sub reply_handler {
   my ($qname, $qclass, $qtype, $peerhost) = @_;
   my ($rcode, @ans, @auth, @add);
   logger("request: name=$qname, class=$qclass, type=$qtype, peer=$peerhost");
   if ($qname =~ /rofling.isa-geek.com/i) {
#       my $rdata = "10.0.0.1";
#       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata");
#       $rcode = "NOERROR";
       $rcode = "NXDOMAIN";
#   } elsif ($qname =~ /irc.johnny.gr/i) {
#       my $rdata = "72.52.222.64";
#       logger("responseIP: $rdata");
#       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata");
#       $rcode = "NOERROR";
   } elsif ($qname =~ /time.windows.com/i) {
       my $rdata = "4.5.6.1";
       logger("responseIP: $rdata");
       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata");
       $rcode = "NOERROR";
   } elsif ($qtype eq "A") {
       if (!defined($cache_a{$qname})) {
         my $rdata1 = "4.3.2." . (int(rand(243))+11);
         my $rdata2 = "4.3.2." . (int(rand(243))+11);
         $cache_a{$qname}[0] = $rdata1;
         $cache_ptr{$rdata1} = $qname;
         $cache_a{$qname}[1] = $rdata2;
         $cache_ptr{$rdata2} = $qname;
         logger("responseIP: $rdata1");
         push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata1");
         logger("responseIP: $rdata2");
         push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata2");
       } else {
         logger("responseIP: $cache_a{$qname}[1]");
	 push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $cache_a{$qname}[1]");
         logger("responseIP: $cache_a{$qname}[0]");
	 push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $cache_a{$qname}[0]");
       }
       $rcode = "NOERROR";
   } elsif ($qtype eq "MX") {
       my $rdata = "mail." . $qname;
       logger("responseMX: $rdata");
       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype 10 $rdata");
       $rcode = "NOERROR";
   } elsif ($qtype eq "NS") {
       my $rdata1 = "ns1." . $qname;
       logger("responseNS: $rdata1");
       my $rdata2 = "ns2." . $qname;
       logger("responseNS: $rdata2");
       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata1");
       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $rdata2");
       $rcode = "NOERROR";
   } elsif ($qtype eq "PTR") {
     my @list;
     my $ip;
     @list = split /\./,$qname;
     $ip = sprintf("%d.%d.%d.%d",$list[3],$list[2],$list[1],$list[0]);
     if (defined($cache_ptr{$ip})) {
       push @ans, Net::DNS::RR->new("$qname 86400 $qclass $qtype $cache_ptr{$ip}");
       logger("responsePTR: $ip");
       $rcode = "NOERROR";
     } else {
       $rcode = "NXDOMAIN";
     }
   } else {
       $rcode = "NXDOMAIN";
   }
   
   logger("response: rcode=$rcode, ans=@ans, auth=@auth, add=@add, aa=1");
   # mark the answer as authoritive (by setting the 'aa' flag
   return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

print "Starting Faux DNS Server Emulation on port 53\n";
my $ns = Net::DNS::Nameserver->new(
     LocalAddr	  => "4.5.6.1",
     LocalPort    => 53,
     ReplyHandler => \&reply_handler,
     Verbose      => 0,
) || die "couldn't create nameserver object\n";
 

$ns->main_loop;

sub logger {
    my $msg = shift;
    open(OUT,">>/tmp/sandnetdns.log") or return;
    print OUT "$msg\n";
    close OUT;
}