#!/usr/bin/perl
# tor-resolve-server.pl - dns server that does queries with tor-resolve
# Copyright (C) 2005 Timo Lindfors <timo.lindfors@iki.fi>
#
#This program is free software; you can redistribute it and/or modify
#it under the terms of the GNU General Public License as published by
#the Free Software Foundation; either version 2 of the License, or
#(at your option) any later version.

#This program is distributed in the hope that it will be useful,
#but WITHOUT ANY WARRANTY; without even the implied warranty of
#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#GNU General Public License for more details.

#You should have received a copy of the GNU General Public License
#along with this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# sudo iptables -t nat -A PREROUTING -p tcp -d 192.168.0.4 --dport 53 -j DNAT --to-destination 192.168.0.4:5353
# to test the setup: dig @localhost -p 5353 www.google.com

use strict;
use warnings;
BEGIN { eval { require Net::DNS; }; if($@) {die "Please apt-get install libnet-dns-perl\n";} }
use Net::DNS;
use Net::DNS::Nameserver;

sub parse_ptr {
    my ($qname) = @_;
    if ($qname =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)\.in-addr.arpa$/) {
	return "$4.$3.$2.$1"; # reverse the order of octets
    }
    return;
}
sub reply_handler {
    my ($qname, $qclass, $qtype, $peerhost) = @_;
    my ($rcode, @ans, @auth, @add);

#    print "DEBUG: qname = $qname, qclass = $qclass, qtype = $qtype, peerhost = $peerhost\n";
    if ($qtype eq "A") {
	if ($qname =~ /^[0-9A-Za-z\.\-]+$/) {
	    my $ttl = 3600;
	    my $rdata = `tor-resolve $qname`;
#	    print "DEBUG2: rdata = $rdata\n";
	    push @ans, Net::DNS::RR->new("$qname $ttl $qclass $qtype $rdata");
	    $rcode = "NOERROR";
	} else {
	    print "\"$qname\" failed sanity check\n";
	}
    } else {
	print "Received query of type \"$qtype\" but tor-resolve can only handle \"A\".\n";
        $rcode = "NXDOMAIN";
    }

    # mark the answer as authoritive (by setting the 'aa' flag
    return ($rcode, \@ans, \@auth, \@add, { aa => 1 });
}

my $ns = Net::DNS::Nameserver->new(
    LocalAddr    => "127.0.0.1",
    LocalPort    => 5353,
    ReplyHandler => \&reply_handler,
    Verbose      => 1,
				   ) || die "couldn't create nameserver object\n";


$ns->main_loop;

