[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
Re: The State of the DNS and Tor Union (also: a DNS UDP - >TCP shim)
On Mon, Jul 5, 2010 at 6:49 PM, Jacob Appelbaum <jacob@xxxxxxxxxxxxx> wrote:
> ...
> I haven't seen a PERL version of the program - do you have a link to the
> source?
this is the only copy i have on hand. i believe there is an updated
version in bsd ports archive (no longer in current mirrors).
best regards,
#!/usr/bin/perl
#
# dns-proxy-tor
#
# This script has been dedicated to the public domain.
# See LICENSE file included with this distribution for the dedication.
#
use strict;
use warnings;
our $VERSION = '0.0.6';
{
package Log;
use strict;
use warnings;
use constant INFO => 0;
use constant DEBUG => 1;
my @Levels = qw/INFO DEBUG/;
my @Attributes = qw/level handle/;
our %Log = (level => 1);
our $Err;
sub _self {
my $class = __PACKAGE__;
no strict 'refs';
return \%$class;
}
sub init {
my $self = shift->_self;
%$self = @_;
if (not $self->{handle} and not open $self->{handle}, '>>', $self->{file}) {
$Err = "Can't open log file $self->{file}: $!\n";
return;
}
select( (select($self->{handle}), $| = 1)[0] );
return 1;
}
sub close {
my $self = shift->_self;
close $self->{handle};
}
for my $attribute (@Attributes) {
no strict 'refs';
*$attribute = sub {
use strict 'refs';
my $self = shift->_self;
$self->{$attribute} = shift if @_;
return $self->{$attribute};
};
}
for my $level (@Levels) {
no strict 'refs';
*{lc $level} = sub {
my $self = shift->_self;
return unless $self->{level} >= &$level;
use strict 'refs';
my $fh = $self->{handle};
printf $fh @_;
};
}
1;
}
{
package DNS::Session;
use strict;
use warnings;
use Socket;
use constant SERVFAIL => 0x8102;
use constant NOERROR => 0x8100;
use constant TYPE_A => 1;
use constant CLASS_IN => 1;
use constant NAME_PTR => 0xc00c;
sub new {
my $class = shift;
my $self = {
sessions => {},
last_timeout => time,
@_
};
bless $self, $class;
}
sub add_request {
my ($self, $dns_request) = @_;
Log->debug("Adding session for %s\n", $dns_request->domain);
push @{ $self->{sessions}{lc $dns_request->domain} }, $dns_request;
}
sub _pack_name {
join( '', map chr(length).$_, split /\./, $_[1] )."\0";
}
sub _pack_response {
my ($self, $id, $flags, $req_type, $domain, $addr) = @_;
my ($qd, $an, $ns, $ar) = (1, 0, 0, 0);
my $answer;
if ($addr) {
$an = 1;
$answer = pack('n3Nn', NAME_PTR, TYPE_A, CLASS_IN, 0, 4).inet_aton($addr);
}
# header
my $response = pack 'n6', $id, $flags, $qd, $an, $ns, $ar;
# question
$response .= $self->_pack_name($domain).pack('n2', $req_type, CLASS_IN);
# answer
$response .= $answer if $an;
return $response;
}
sub exists {
my ($self, $domain) = @_;
return exists $self->{sessions}{lc $domain};
}
sub flush {
my $self = shift;
$self->send_response($_ => 0)
for keys %{ $self->{sessions} };
}
sub send_response {
my ($self, $domain, $addr) = @_;
if (not $self->exists($domain)) {
Log->debug("Session not found for $domain\n");
return;
}
my $requests = $self->{sessions}{lc $domain};
my $flags = $addr ne '0' ? NOERROR : SERVFAIL;
undef $addr if $addr eq '0';
while (my $request = shift @$requests) {
if (defined $addr) {
Log->info("Resolved %s => %s, sent to %s:%s\n", $domain, $addr,
$request->remote_addr, $request->remote_port);
} else {
Log->info("Failed to resolve %s, sent to %s:%s\n", $domain,
$request->remote_addr, $request->remote_port);
}
my $response = $self->_pack_response(
$request->id,
$flags,
$request->type,
$request->domain,
$addr
);
send $self->{handle}, $response, 0, $request->remote_sa;
}
delete $self->{sessions}{lc $domain};
}
sub timeout {
my $self = shift;
my $limit = time - $self->{timeout};
return if $limit < $self->{last_timeout};
for (keys %{ $self->{sessions} }) {
delete $self->{sessions}{$_}
if $self->{sessions}{$_}[0]->time < $limit;
}
$self->{last_timeout} = time;
}
sub handle {
my $self = shift;
$self->{handle} = shift if @_;
return $self->{handle};
}
1;
}
{
package DNS::Request;
use strict;
use warnings;
use Socket;
use constant INVALID => 0;
use constant FORMERR => 0x8101;
use constant SERVFAIL => 0x8102;
use constant TYPE_A => 1;
use constant TYPE_AAAA => 0x1c;
use constant CLASS_IN => 1;
use constant MAX_LABEL_LEN => 63;
use constant MAX_DOMAIN_LEN => 255;
sub receive {
my ($class, $handle) = @_;
my $remote_sa = recv $handle, my $query, 512, 0;
return unless defined $remote_sa;
my $self = {
query => $query,
remote_sa => $remote_sa,
time => time
};
bless $self, $class;
}
sub _unpack_name {
my ($self, $pos) = @_;
return if length $self->{query} < $pos + 2;
my @labels;
while (my $len = ord substr $self->{query}, $pos, 1) {
return if ($len & 0xc0) == 0xc0 or length $self->{query} < $pos+$len+2;
push @labels, substr $self->{query}, ++$pos, $len;
$pos += $len;
}
return $pos + 1, @labels;
}
sub remote_addr {
my $self = shift;
my (undef, $remote_addr) = sockaddr_in $self->{remote_sa};
return inet_ntoa $remote_addr;
}
sub remote_port {
my $self = shift;
(sockaddr_in $self->{remote_sa})[0];
}
sub parse {
my $self = shift;
Log->info("Received datagram from %s:%s\n",
$self->remote_addr, $self->remote_port);
if (length $self->{query} < 19) {
Log->info("Dropping invalid packet from %s:%s\n",
$self->remote_addr, $self->remote_port);
$self->{error} = INVALID;
return;
}
my ($id, $flags, $qd, $an, $ns, $ar) = unpack 'n6', $self->{query};
my $pos = 12;
Log->info("id=0x%04x flags=0x%04x qd=0x%04x an=0x%04x ".
"ns=0x%04x ar=0x%04x\n", $id, $flags, $qd, $an, $ns, $ar);
unless ($qd == 1
and $an == 0 and $ns == 0 and $ar == 0) {
Log->info("Server failure (unsupported) to %s:%s\n",
$self->remote_addr, $self->remote_port);
$self->{error} = SERVFAIL;
return;
}
my @labels;
($pos, @labels) = $self->_unpack_name($pos);
unless ($pos and length $self->{query} >= $pos + 4) {
Log->info("Format error (invalid name or length) to %s:%s\n",
$self->remote_addr, $self->remote_port);
$self->{error} = FORMERR;
return;
}
my ($type, $class) = unpack 'n2', substr $self->{query}, $pos, 4;
$pos += 4;
# unless ($type == TYPE_A) {
# || $type == TYPE_AAAA and $class == CLASS_IN) {
# Log->info("Server failure (unsupported type/class) to %s:%s\n",
# $self->remote_addr, $self->remote_port);
# $self->{error} = SERVFAIL;
# return;
# }
my $domain_len = 0;
for my $label (@labels) {
my $label_len = length $label;
$domain_len += 1 + $label_len;
unless ($label_len <= MAX_LABEL_LEN and
$domain_len <= MAX_DOMAIN_LEN and
# labels can only start with a letter, but we need
# to allow numbers for .onion names
$label =~ /(\A[[:alnum:]](?:[[:alnum:]\-]*[[:alnum:]])?\z)/) {
Log->info("Format error (invalid label/domain) to %s:%s\n",
$self->remote_addr, $self->remote_port);
$self->{error} = FORMERR;
return;
}
$label = $1;
}
my $domain = join '.', @labels;
%$self = (%$self, id => $id, type => $type, domain => $domain);
return 1;
}
sub send_error {
my ($self, $handle) = @_;
return if $self->{error} == INVALID;
my $response = substr($self->{query}, 0, 2).pack('n', $self->{error}).
substr($self->{query}, 4);
send $handle, $response, 0, $self->{remote_sa};
}
sub remote_sa { $_[0]->{remote_sa} }
sub id { $_[0]->{id} }
sub domain { $_[0]->{domain} }
sub type { $_[0]->{type} }
sub time { $_[0]->{time} }
1;
}
{
package Connection;
use strict;
use warnings;
use Socket;
use Fcntl;
my $Tcp_proto = getprotobyname 'tcp';
sub connect {
my ($self, $timeout) = @_;
eval {
local $SIG{ALRM} = sub { die "Connection timed out\n" };
alarm $timeout;
socket $self->{handle}, AF_INET, SOCK_STREAM, $Tcp_proto
or die "socket() failed: $!\n";
select( (select($self->{handle}), $| = 1)[0] );
connect $self->{handle}, $self->{sockaddr}
or die "connect() failed: $!\n";
};
alarm 0;
close $self->{handle} if $@;
return not $@;
}
sub _set_nonblocking {
my $self = shift;
my $flags = fcntl $self->{handle}, F_GETFL, 0
or die "fcntl() failed: $!\n";
fcntl $self->{handle}, F_SETFL, $flags | O_NONBLOCK
or die "fcntl() failed: $!\n";
}
1;
}
{
package Tor::Control;
use base 'Connection';
use strict;
use warnings;
use Socket qw/:DEFAULT :crlf/;
use Errno 'EWOULDBLOCK';
use constant BUF_SIZE => 8192;
use constant TIMEOUT => 300;
sub new {
my $class = shift;
my $self = {
read_buf => "\0" x BUF_SIZE,
write_buf => "\0" x BUF_SIZE,
read_pos => 0,
write_pos => 0,
disconnected => 1,
@_
};
bless $self, $class;
}
sub _read_auth_cookie {
my $self = shift;
my $cookie_file = "$self->{data_directory}/control_auth_cookie";
if (open my $cookie_handle, '<', $cookie_file) {
local $/;
my $cookie = <$cookie_handle>;
$self->{secret} = unpack 'H*', $cookie;
} else {
Log->info("Can't open $cookie_file: $!\n");
}
}
sub _authenticate {
my $self = shift;
local $/ = CRLF;
$self->_read_auth_cookie if $self->{data_directory};
syswrite $self->{handle}, 'AUTHENTICATE '.$self->{secret}.CRLF
or die "syswrite() failed: $!\n";
defined( my $response = readline $self->{handle} )
or die "readline() failed: $!\n";
chomp $response;
$response eq '250 OK'
or die "Authentication failed\n";
}
sub connect {
my $self = shift;
my $timeout = 5;
for (;;) {
eval {
$self->SUPER::connect($timeout) or die $@;
local $SIG{ALRM} = sub { die "Authentication timed out\n" };
alarm $timeout;
$self->_authenticate;
$self->_set_nonblocking if $^O ne 'MSWin32';
};
alarm 0;
if ($@) {
Log->info("$@Connection to Tor failed. Retrying...\n");
close $self->{handle};
sleep $timeout;
last if $self->{terminate}->();
} else {
Log->info("Connected to Tor\n");
$self->{disconnected} = 0;
last;
}
}
$self->{read_pos} = $self->{write_pos} = 0;
}
sub add_mapaddress_to_buf {
my ($self, $domain) = @_;
my $command = 'MAPADDRESS 0.0.0.0='.$domain.CRLF;
my $len = length $command;
if ($self->{write_pos} + $len < BUF_SIZE) {
Log->debug("Adding mapaddress to buffer for $domain\n");
substr $self->{write_buf}, $self->{write_pos}, $len, $command;
$self->{write_pos} += $len;
} else {
Log->info("Write buffer full. Dropping packet.\n");
}
}
sub _readline {
my $self = shift;
my $index = index substr($self->{read_buf}, 0, $self->{read_pos}), CRLF;
return if $index == -1;
my $len = $index + length CRLF;
my $line = substr $self->{read_buf}, 0, $len;
if ($len == $self->{read_pos}) {
$self->{read_pos} = 0;
} else {
substr $self->{read_buf}, 0, $self->{read_pos} - $len,
substr $self->{read_buf}, $len, $self->{read_pos} - $len;
$self->{read_pos} -= $len;
}
return $line;
}
sub _read_mapaddress_response {
my $self = shift;
local $/ = CRLF;
while (defined( my $line = $self->_readline )) {
chomp $line;
my ($code, $ret) = split / /, $line;
next unless defined $code and $code eq '250';
my ($addr, $domain) = split /=/, $ret;
$self->{dns_session}->send_response($domain => $addr);
}
}
sub read {
my $self = shift;
Log->debug("Handling read from Tor control port\n");
my $bytes = sysread $self->{handle}, $self->{read_buf},
BUF_SIZE - $self->{read_pos}, $self->{read_pos};
if ($bytes) {
$self->{read_pos} += $bytes;
$self->_read_mapaddress_response;
} elsif (defined $bytes && $bytes == 0 or $! != EWOULDBLOCK) {
Log->info("Tor closed control connection\n");
$self->{dns_session}->flush;
$self->{disconnected} = 1;
}
}
sub write {
my $self = shift;
Log->debug("Handling write to Tor control port\n");
my $bytes = syswrite $self->{handle},$self->{write_buf},$self->{write_pos};
if (defined $bytes) {
if ($bytes == $self->{write_pos}) {
$self->{write_pos} = 0;
} else {
substr $self->{write_buf}, 0, $self->{write_pos} - $bytes,
substr $self->{write_buf}, $bytes, $self->{write_pos} - $bytes;
$self->{write_pos} -= $bytes;
}
} elsif ($! != EWOULDBLOCK) {
Log->info("syswrite() error: $!\n");
$self->{dns_session}->flush;
$self->{disconnected} = 1;
}
}
sub can_write { $_[0]->{write_pos} > 0 }
sub handle { $_[0]->{handle} }
sub disconnected { $_[0]->{disconnected} }
1;
}
{
package Socks::Resolve;
use base 'Connection';
use strict;
use warnings;
use Socket;
use Errno 'EWOULDBLOCK';
sub _add_request_to_buf {
my $self = shift;
Log->debug("Adding SOCKS resolve request to buffer\n");
$self->{write_buf} = "\4\xf0\0\0\0\0\0\1\0$self->{domain}\0";
}
sub connect {
my $class = shift;
my $self = {
handle => undef,
read_buf => '',
time => time,
@_
};
bless $self, $class;
my $timeout = 1;
eval {
# blocking connect shouldn't be a problem when tor is on loopback
$self->SUPER::connect($timeout) or die $@;
$self->_set_nonblocking if $^O ne 'MSWin32';
};
if ($@) {
Log->info("$@SOCKS connection failed, dropping request\n");
close $self->{handle};
return;
}
$self->_add_request_to_buf;
return $self;
}
sub _fail {
my $self = shift;
Log->info("SOCKS resolve failed for $self->{domain}\n");
$self->{dns_session}->send_response($self->{domain} => 0);
$self->{disconnected} = 1;
}
sub read {
my $self = shift;
Log->debug("Handling read from Tor SOCKS port\n");
my $bytes = sysread $self->{handle}, my $buf, 8 - length $self->{read_buf};
if (not defined $bytes) {
$self->_fail if $! != EWOULDBLOCK;
return;
}
$self->{read_buf} .= $buf;
if (length $self->{read_buf} < 8) {
$self->_fail if $bytes == 0;
return;
}
my ($ver, $res, $port) = unpack 'CCn', $self->{read_buf};
my $addr = substr $self->{read_buf}, 4, 4;
if ($res != 90) {
$self->_fail;
return;
}
$self->{dns_session}->send_response($self->{domain} => inet_ntoa($addr));
$self->{disconnected} = 1;
}
sub write {
my $self = shift;
Log->debug("Handling write to Tor SOCKS port\n");
if (defined( my $bytes = syswrite $self->{handle}, $self->{write_buf} )) {
substr $self->{write_buf}, 0, $bytes, '';
delete $self->{write_buf} if length $self->{write_buf} == 0;
} else {
$self->_fail if $! != EWOULDBLOCK;
}
}
sub can_read { not exists $_[0]->{write_buf} }
sub time { $_[0]->{time} }
sub handle { $_[0]->{handle} }
sub disconnected { $_[0]->{disconnected} }
1;
}
{
package DNS::Server;
use strict;
use warnings;
use Socket;
use POSIX;
use Getopt::Std;
use IO::Poll qw/POLLIN POLLOUT POLLERR POLLHUP/;
use constant TIMEOUT => 300;
my $Tcp_proto = getprotobyname 'tcp';
sub new {
my $class = shift;
my $self = { @_ };
bless $self, $class;
}
sub _fail {
my $self = shift;
print <<USAGE, @_;
Usage: $0 -b bind_addr:bind_port -t tor_ctrl_addr:tor_ctrl_port
\t[-f] [-s socks_addr:socks_port] [-u user:group] [-p pid_file]
\t[-c chroot_dir] [-k data_dir] [-w passwd] [-v log_level] [-l log_file]
USAGE
exit 1;
}
sub _set_ugid {
my ($self, $opt_u) = @_;
my ($user, $group) = split /:/, $opt_u;
$self->_fail("Invalid user:group\n")
unless $user and $group;
defined( $self->{uid} = getpwnam $user )
or $self->_fail("getpwnam($user) failed\n");
defined( $self->{gid} = getgrnam $group )
or $self->_fail("getgrnam($group) failed\n");
}
sub _sockaddr {
my ($self, $port, $addr) = @_;
return if $addr !~ /\A(?:\d+\.){3}\d+\z/;
eval { sockaddr_in $port, pack 'C4', split /\./, $addr };
}
sub _open_tor_control {
my $self = shift;
$self->{tor_control} = Tor::Control->new(
sockaddr => $self->{tor_control_sa},
dns_session => $self->{dns_session},
data_directory => $self->{data_directory} || undef,
secret => $self->{secret},
terminate => $self->{terminate}
);
my ($level, $handle) = (Log->level, Log->handle);
Log->level(Log::DEBUG); Log->handle(*STDERR);
$self->{tor_control}->connect;
Log->level($level); Log->handle($handle);
}
sub _test_socks {
my $self = shift;
socket my $socks_test, AF_INET, SOCK_STREAM, $Tcp_proto
or $self->_fail("socket() failed: $!\n");
connect $socks_test, $self->{socks_sa}
or $self->_fail("Connection failed to Tor SOCKS port\n");
close $socks_test;
}
sub _bind {
my $self = shift;
socket $self->{handle}, AF_INET, SOCK_DGRAM, scalar getprotobyname 'udp'
or $self->_fail("socket() failed: $!\n");
setsockopt $self->{handle}, SOL_SOCKET, SO_REUSEADDR, 1
or $self->_fail("setsockopt(SO_REUSEADDR) failed: $!\n");
bind $self->{handle}, $self->{bind_sa}
or $self->_fail("bind() failed: $!\n");
$self->{dns_session} = DNS::Session->new(
handle => $self->{handle},
timeout => TIMEOUT
);
}
sub _daemonize {
my $self = shift;
defined( fork and exit )
or $self->_fail("Can't fork: $!\n");
POSIX::setsid
or $self->_fail("setsid(): Can't create a new session: $!\n");
chdir '/';
umask 0;
open $_, '+<', '/dev/null'
or $self->_fail("Can't reopen $_ to /dev/null: $!")
for *STDIN, *STDOUT, *STDERR;
}
sub _write_pid_file {
my $self = shift;
my $pid_handle = $self->{pid_handle};
print $pid_handle $$;
close $self->{pid_handle};
}
sub _chroot {
my $self = shift;
chroot $self->{chroot} and chdir '/'
or $self->_fail("Can't chroot to $self->{chroot}: $!\n");
}
sub _drop_privileges {
my $self = shift;
$) = "$self->{gid} $self->{gid}";
$( = $self->{gid};
$> = $self->{uid};
$< = $self->{uid};
$self->_fail("Can't drop privileges to $self->{uid}:$self->{gid}: $!\n")
if $) ne "$self->{gid} $self->{gid}" or $( != $self->{gid} or
$> != $self->{uid} or $< != $self->{uid};
}
sub parse_options {
my $self = shift;
getopts 'b:t:s:u:p:c:v:k:w:l:f', \my %opt;
defined $opt{$_} or $self->_fail
for qw/b t/;
$self->_fail("Can't set both cookie and password\n")
if $opt{k} and $opt{w};
$self->_fail("Can't set log file without log level\n")
if $opt{l} and not $opt{v};
$self->_fail("Must be run as root to chroot\n")
if $opt{c} and $> != 0;
$self->_fail("Must be run as root to drop privileges\n")
if $opt{u} and $> != 0;
my ($bind_addr, $bind_port) = split /:/, $opt{b};
my ($tor_ctrl_addr, $tor_ctrl_port) = split /:/, $opt{t};
defined $_ or $self->_fail
for $bind_addr, $bind_port, $tor_ctrl_addr, $tor_ctrl_port;
if ($bind_addr eq 'any') {
$bind_addr = inet_ntoa INADDR_ANY;
} elsif ($bind_addr eq 'lo') {
$bind_addr = inet_ntoa INADDR_LOOPBACK;
}
$self->{bind_sa} = $self->_sockaddr($bind_port, $bind_addr)
or $self->_fail("Invalid bind address or port\n");
$self->{tor_control_sa} = $self->_sockaddr($tor_ctrl_port, $tor_ctrl_addr)
or $self->_fail("Invalid Tor control address or port\n");
if ($opt{s}) {
my ($socks_addr, $socks_port) = split /:/, $opt{s};
defined $_ or $self->_fail
for $socks_addr, $socks_port;
$self->{socks_sa} = $self->_sockaddr($socks_port, $socks_addr);
}
if ($opt{v}) {
$opt{v} =~ /\A([1-2])\z/
or $self->_fail("Log levels 1-2 are valid\n");
my $log_level = (Log::INFO, Log::DEBUG)[$1 - 1];
if ($opt{l}) {
Log->init(level => $log_level, file => $opt{l})
or $self->_fail($Log::Err);
} else {
Log->init(level => $log_level, handle => *STDERR);
}
}
open $self->{pid_handle}, '>', $opt{p}
or $self->_fail("Can't open pid_file $opt{p} for writing: $!\n")
if $opt{p};
$self->_set_ugid($opt{u}) if $opt{u};
$self->{secret} = '';
if ($opt{k}) {
$self->{data_directory} = $opt{k};
} elsif ($opt{w}) {
$self->{secret} = unpack 'H*', $opt{w};
}
$self->{chroot} = $opt{c} if $opt{c};
$self->{foreground} = 1 if $opt{f};
}
sub _dns_request_handler {
my $self = shift;
my $dns_request = receive DNS::Request $self->{handle} or return;
if (not $dns_request->parse) {
$dns_request->send_error($self->{handle});
return;
}
if (not $self->{dns_session}->exists($dns_request->domain)) {
if ($self->{socks_sa} and $dns_request->domain !~ /\.(?:exit|onion)\z/) {
my $socks_resolve = Socks::Resolve->connect(
sockaddr => $self->{socks_sa},
dns_session => $self->{dns_session},
domain => $dns_request->domain
) or return;
$self->{poll}->mask($socks_resolve->handle => POLLOUT);
$self->{socks_resolve}{$socks_resolve->handle} = $socks_resolve;
} else {
$self->{tor_control}->add_mapaddress_to_buf($dns_request->domain);
$self->{poll}->mask($self->{tor_control}->handle => POLLIN | POLLOUT);
}
}
$self->{dns_session}->add_request($dns_request);
}
sub _tor_control_handler {
my ($self, $handle, $event) = @_;
if ($event == POLLIN) {
$self->{tor_control}->read;
} else {
$self->{tor_control}->write;
}
if ($self->{tor_control}->disconnected) {
$self->{poll}->remove($handle);
$self->{tor_control}->connect;
}
$self->{poll}->mask($handle => POLLIN)
unless $self->{tor_control}->can_write;
}
sub _socks_resolve_handler {
my ($self, $handle, $event) = @_;
if ($event == POLLIN) {
$self->{socks_resolve}{$handle}->read;
} else {
$self->{socks_resolve}{$handle}->write;
}
if ($self->{socks_resolve}{$handle}->disconnected) {
$self->{poll}->remove($handle);
delete $self->{socks_resolve}{$handle};
} elsif ($self->{socks_resolve}{$handle}->can_read) {
$self->{poll}->mask($handle => POLLIN);
}
}
sub _timeout {
my $self = shift;
my $limit = time - TIMEOUT;
return unless $self->{last_timeout} < $limit;
$self->{dns_session}->timeout;
for (keys %{ $self->{socks_resolve} }) {
if ($self->{socks_resolve}{$_}{time} < $limit) {
$self->{poll}->remove($self->{socks_resolve}{$_}->handle);
delete $self->{socks_resolve}{$_};
}
}
$self->{last_timeout} = time;
}
sub _event_loop {
my $self = shift;
$self->{poll} = IO::Poll->new;
$self->{poll}->mask($_ => POLLIN)
for $self->{handle}, $self->{tor_control}->handle;
$self->{last_timeout} = time;
for (;;) {
$self->{poll}->poll;
last if $self->{terminate}->();
for my $h ($self->{poll}->handles(POLLIN | POLLERR | POLLHUP)) {
if ($h eq $self->{handle}) {
$self->_dns_request_handler;
} elsif ($h eq $self->{tor_control}->handle) {
$self->_tor_control_handler($h, POLLIN);
} else {
$self->_socks_resolve_handler($h, POLLIN);
}
}
for my $h ($self->{poll}->handles(POLLOUT)) {
if ($h eq $self->{tor_control}->handle) {
$self->_tor_control_handler($h, POLLOUT);
} else {
$self->_socks_resolve_handler($h, POLLOUT);
}
}
$self->_timeout;
}
delete $self->{poll};
delete $self->{socks_resolve};
$self->{dns_session}->flush;
}
sub _cleanup {
my $self = shift;
delete $self->{dns_session};
delete $self->{tor_control};
close $self->{handle} if $self->{handle};
Log->close if Log->handle;
}
sub DESTROY {
my $self = shift;
$self->_cleanup;
}
sub serve {
my $self = shift;
local %SIG;
$SIG{PIPE} = 'IGNORE';
my $terminate = 0;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $terminate = 1 };
$self->{terminate} = sub { $terminate };
$self->_bind;
$self->_open_tor_control;
if ($self->{terminate}->()) {
$self->_cleanup;
return;
}
$self->_test_socks if $self->{socks_sa};
$self->_daemonize unless $self->{foreground} or $^O eq 'MSWin32';
$self->_write_pid_file if $self->{pid_handle};
$self->_chroot if $self->{chroot};
$self->_drop_privileges if $self->{uid};
$self->_event_loop;
$self->_cleanup;
}
1;
}
my $server = DNS::Server->new;
$server->parse_options;
$server->serve;
=head1 NAME
B<dns-proxy-tor> - A DNS server for plugging DNS leaks when using Tor
=head1 SYNOPSIS
B<dns-proxy-tor> B<-b> I<bind_addr>:I<bind_port>
B<-t> I<tor_ctrl_addr>:I<tor_ctrl_port>
[B<-s> I<socks_addr>:I<socks_port>]
[B<-u> I<user>:I<group>] [B<-c> I<chroot_dir>]
[B<-p> I<pid_file>] [B<-k> I<data_dir>] [B<-w> I<passwd>]
[B<-f>] [B<-v> I<log_level>] [B<-l> I<log_file>]
=head1 DESCRIPTION
B<dns-proxy-tor> is a DNS server that instructs B<tor> to map a domain name to
a fake IP address, then responds with that fake address. Subsequently, B<tor>
will send connections intended for the fake address to the mapped domain name
instead. Actual domain names, C<.onion> names, and C<.node.exit> names work
using this method.
I<ControlPort> must be specified in your I<torrc> before B<tor> will listen on
the port needed for communication with B<dns-proxy-tor>.
If you want B<dns-proxy-tor> to answer queries over a network rather than just
over the loopback interface, you'll need to set I<VirtualAddrNetwork> in your
I<torrc> to C<10.192.0.0/10> or C<172.16.0.0/12>. This is necessary because by
default, B<tor> supplies fake addresses in the network 127.192.0.0/10, which
properly configured machines will route to the loopback interface.
Use the B<-s> option to resolve domain names with B<tor>'s SOCKS resolve
extension instead of the C<MAPADDRESS> controller command. You must use this
option if you want applications to resolve names through B<tor>, but make their
actual connections directly. Even when the B<-s> option is specified,
C<.node.exit> and C<.onion> names will still be resolved with C<MAPADDRESS>.
=head1 OPTIONS
B<-b> I<address>:I<port>
Bind the proxy to I<address> and I<port>. I<address> can be
either an IP address, C<lo> for the loopback
interface, or C<any> for all interfaces. If you
are forwarding connections to B<dns-proxy-tor>
with pf or iptables rules, this should be
C<lo:5353> or C<any:5353>. Otherwise, it should
be C<lo:53> or C<any:53>. Binding to port 53
requires root privileges.
B<-t> I<address>:I<port>
Send C<MAPADDRESS> B<tor> controller commands to B<tor>
on I<address> and I<port>. I<address> must be an IP
address. When B<tor> is listening on the loopback
interface, this should be C<127.0.0.1:9051>.
B<-s> I<address>:I<port>
Send SOCKS resolve requests to B<tor> on I<address> and
I<port>. I<address> must be an IP address. When B<tor>
is listening on the loopback interface, this
should be C<127.0.0.1:9050>.
B<-u> I<user>:I<group>
Drop privileges to those of I<user> and I<group>. Only
available when run as a privileged user.
B<-p> I<filename>
Write PID to I<filename>.
B<-c> I<directory>
Change root directory to I<directory>. Specify B<-u>
also to make this irreversible. Only available
when run as a privileged user.
B<-f> Run in the foreground.
B<-v> I<level>
Output log messages at I<level>. Available levels
are 1 and 2. Level 2 is more verbose than level 1.
Messages will be sent to stderr unless B<-l> is set.
B<-l> I<file>
Write log messages to I<file>.
B<-k> I<directory>
Authenticate to the B<tor> control port with the
C<control_auth_cookie> file located in B<tor>'s
data directory, I<directory>. Add
I<CookieAuthentication> to your I<torrc> to
enable this form of authentication. Cookie
authentication doesn't work in B<tor> 0.1.1.20
and earlier. Typically, B<dns-proxy-tor> should
be run as the same user B<tor> runs as to
access I<directory>. If running in a chroot,
I<directory> should be accessible both inside
and outside the chroot from the same path.
B<-w> I<password>
Authenticate to the B<tor> control port with
I<password>. To enable this form of
authentication, generate a hashed password with
C<< tor --hash-password <password> >>, then place
the hashed password in your I<torrc> as the
I<HashedControlPassword>.
=head1 SEE ALSO
B<trans-proxy-tor>, L<tor(8)>, L<pf(4)>, L<pfctl(8)>, L<pf.conf(5)>, L<iptables(8)>
=head1 COPYRIGHT
B<dns-proxy-tor> has been dedicated to the public domain. It has no
copyright.
=cut