#!/usr/bin/perl 
 
# Loopdnsd.pl version 0.01 by Jakub Wartak 2005-2006 ( vnull@pcnet.com.pl )
# Licensed under GPLv2.
#
# Simple, stupid DNS server too fool some network viruses ( after DNATing of DNS ).
# It just sits there and reply with 127.0.0.1 to any DNS requests - worms
# will try to connect to theirs own machines.
# Recommended use: automatic ( ipt_recent ) DNAT of DNS packets, more on my site
# Blocking model could be improved with select() aproach.
# Based on example from Net::DNS::Nameserver manual
#

use Proc::Daemon;
use Net::DNS;
use Net::DNS::Nameserver;
use strict;
use warnings;

# customize this!
my $background = 0;
my $port = 53;
my $bindto = "127.0.0.1";

# these are allowed...
my @allowACL  = ();
push @allowACL,'www.internet.pcnet.com.pl';
push @allowACL,'internet.pcnet.com.pl';

sub lookup($) {
	my $in = shift;

	foreach my $val ( @allowACL ) {
		if($val eq $in){
			return 1;
		}
	}

	return 0;
}

sub resolve($) {
	my $arg0 = shift;
	my $r = Net::DNS::Resolver->new;
	my $q = $r->search($arg0);
	if($q) {
		foreach my $data ($q->answer) {
			next if ($data->type ne 'A');
			return $data->address;
		}
	}
	return undef;
}
 
sub reply {
	my ($qname, $qclass, $qtype, $peerhost) = @_;
	my ($rcode, @ans, @auth, @add);
         
	# rekordy o Adres IP
	if ($qtype eq "A") {
		my $tmp = "127.0.0.1";
		if(lookup($qname)) {
			my $resolved = resolve($qname);
			$tmp = $resolved if defined($resolved);	
		} 

		my ($ttl, $rdata) = (3600, $tmp);
		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
		$rcode = "NOERROR";
	
	} elsif ($qtype eq "MX") {
		# mx.localhost. will return also 127.0.0.1
		my ($ttl, $rdata) = (3600, "10 mx.localhost.");
		push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
	        $rcode = "NOERROR";
	} else {
		$rcode = "NXDOMAIN";
	}

	# autorytatwyna odp.
	return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}
 
if($background == 1) {
	Proc::Daemon::Init;
}
my $verb = not $background;

my $ns = Net::DNS::Nameserver->new(
	LocalPort    => $port,
	LocalAddr    => $bindto,
	ReplyHandler => \&reply,
	Verbose      => $verb,
) || die "Couldn't initialize nameserver (Net::DNS::Nameserver)\n";
 
$ns->main_loop;

exit 0;