use IO::File;
use IO::Socket;
use Data::Dumper;
use Net::DNS;
use Net::DNS::Packet;
use strict;
local $SIG{PIPE} = 'IGNORE';
local $| = 1;
my $server_addr = "10.53.0.2";
if (@ARGV > 0) {
$server_addr = @ARGV[0];
}
my $ctlsock = IO::Socket::INET->new(LocalAddr => "$server_addr",
LocalPort => 5301, Proto => "tcp", Listen => 5, Reuse => 1) or die "$!";
my $udpsock = IO::Socket::INET->new(LocalAddr => "$server_addr",
LocalPort => 5300, Proto => "udp", Reuse => 1) or die "$!";
my $tcpsock = IO::Socket::INET->new(LocalAddr => "$server_addr",
LocalPort => 5300, Proto => "tcp", Listen => 5, Reuse => 1) or die "$!";
print "listening on $server_addr:5300,5301.\n";
my $pidf = new IO::File "ans.pid", "w" or die "cannot open pid file: $!";
print $pidf "$$\n" or die "cannot write pid file: $!";
$pidf->close or die "cannot close pid file: $!";;
sub rmpid { unlink "ans.pid"; exit 1; };
$SIG{INT} = \&rmpid;
$SIG{TERM} = \&rmpid;
my @rules;
sub handleUDP {
my ($buf) = @_;
my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
$err and die $err;
my @questions = $request->question;
my $qname = $questions[0]->qname;
my $qtype = $questions[0]->qtype;
my $qclass = $questions[0]->qclass;
my $id = $request->header->id;
my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
$packet->header->qr(1);
$packet->header->aa(1);
$packet->header->id($id);
my $prev_tsig;
while (my $rr = $request->pop("additional")) {
if ($rr->type eq "TSIG") {
$prev_tsig = $rr;
}
}
my $r;
foreach $r (@rules) {
my $pattern = $r->{pattern};
my($dbtype, $key_name, $key_data) = split(/ /,$pattern);
print "[handleUDP] $dbtype, $key_name, $key_data \n";
if ("$qname $qtype" =~ /$dbtype/) {
my $a;
foreach $a (@{$r->{answer}}) {
$packet->push("answer", $a);
}
if(defined($key_name) && defined($key_data)) {
print " Signing the response with " .
"$key_name/$key_data\n";
my $tsig = Net::DNS::RR->
new("$key_name TSIG $key_data");
$packet->{"compnames"} = {};
$packet->{"header"}{"arcount"} += 1;
if (defined($prev_tsig)) {
my $rmac = pack('n H*',
$prev_tsig->mac_size,
$prev_tsig->mac);
$tsig->{"request_mac"} =
unpack("H*", $rmac);
}
$packet->sign_tsig($tsig);
}
last;
}
}
return $packet->data;
}
sub namelen {
my ($data) = @_;
my $len = 0;
my $label_len = 0;
do {
$label_len = unpack("c", $data);
$data = substr($data, $label_len + 1);
$len += $label_len + 1;
} while ($label_len != 0);
return ($len);
}
sub packetlen {
my ($data) = @_;
my $q;
my $rr;
my $header;
my $offset;
my $decode = 0;
$decode = 1 if ($Net::DNS::VERSION >= 0.68);
if ($decode) {
($header, $offset) = Net::DNS::Header->decode(\$data);
} else {
($header, $offset) = Net::DNS::Header->parse(\$data);
}
for (1 .. $header->qdcount) {
if ($decode) {
($q, $offset) =
Net::DNS::Question->decode(\$data, $offset);
} else {
($q, $offset) =
Net::DNS::Question->parse(\$data, $offset);
}
}
for (1 .. $header->ancount) {
if ($decode) {
($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
} else {
($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
}
}
for (1 .. $header->nscount) {
if ($decode) {
($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
} else {
($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
}
}
for (1 .. $header->arcount) {
if ($decode) {
($q, $offset) = Net::DNS::RR->decode(\$data, $offset);
} else {
($q, $offset) = Net::DNS::RR->parse(\$data, $offset);
}
}
return $offset;
}
sub sign_tcp_continuation {
my ($key, $data) = @_;
my $rmacsize = unpack("n", $data);
$data = substr($data, 2);
my $rmac = substr($data, 0, $rmacsize);
$data = substr($data, $rmacsize);
my $plen = packetlen($data);
my $pdata = substr($data, 0, $plen);
$data = substr($data, $plen);
$data = substr($data, namelen($data));
$data = substr($data, 6);
$data = substr($data, namelen($data));
my $tdata = substr($data, 0, 8);
$data = pack("n", $rmacsize) . $rmac . $pdata . $tdata;
return Net::DNS::RR::TSIG::sign_hmac($key, $data);
}
sub handleTCP {
my ($buf) = @_;
my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
$err and die $err;
my @questions = $request->question;
my $qname = $questions[0]->qname;
my $qtype = $questions[0]->qtype;
my $qclass = $questions[0]->qclass;
my $id = $request->header->id;
my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
$packet->header->qr(1);
$packet->header->aa(1);
$packet->header->id($id);
my $prev_tsig;
my $signer;
while (my $rr = $request->pop("additional")) {
if ($rr->type eq "TSIG") {
$prev_tsig = $rr;
}
}
my @results = ();
my $count_these = 0;
my $r;
foreach $r (@rules) {
my $pattern = $r->{pattern};
my($dbtype, $key_name, $key_data) = split(/ /,$pattern);
print "[handleTCP] $dbtype, $key_name, $key_data \n";
if ("$qname $qtype" =~ /$dbtype/) {
$count_these++;
my $a;
foreach $a (@{$r->{answer}}) {
$packet->push("answer", $a);
}
if(defined($key_name) && defined($key_data)) {
print " Signing the data with " .
"$key_name/$key_data\n";
my $tsig = Net::DNS::RR->
new("$key_name TSIG $key_data");
$packet->{"compnames"} = {};
$packet->{"header"}{"arcount"} += 1;
if (defined($prev_tsig)) {
my $rmac = pack('n H*',
$prev_tsig->mac_size,
$prev_tsig->mac);
$tsig->{"request_mac"} =
unpack("H*", $rmac);
}
$tsig->sign_func($signer) if defined($signer);
$packet->sign_tsig($tsig);
$signer = \&sign_tcp_continuation;
my $copy =
Net::DNS::Packet->new(\($packet->data));
$prev_tsig = $copy->pop("additional");
}
push(@results,$packet->data);
$packet = new Net::DNS::Packet($qname, $qtype, $qclass);
$packet->header->qr(1);
$packet->header->aa(1);
$packet->header->id($id);
}
}
print " A total of $count_these patterns matched\n";
return \@results;
}
my $rin;
my $rout;
for (;;) {
$rin = '';
vec($rin, fileno($ctlsock), 1) = 1;
vec($rin, fileno($tcpsock), 1) = 1;
vec($rin, fileno($udpsock), 1) = 1;
select($rout = $rin, undef, undef, undef);
if (vec($rout, fileno($ctlsock), 1)) {
warn "ctl conn";
my $conn = $ctlsock->accept;
my $rule = ();
@rules = ();
while (my $line = $conn->getline) {
chomp $line;
if ($line =~ m!^/(.*)/$!) {
$rule = { pattern => $1, answer => [] };
push(@rules, $rule);
} else {
push(@{$rule->{answer}},
new Net::DNS::RR($line));
}
}
$conn->close;
} elsif (vec($rout, fileno($udpsock), 1)) {
printf "UDP request\n";
my $buf;
$udpsock->recv($buf, 512);
my $result = handleUDP($buf);
my $num_chars = $udpsock->send($result);
print " Sent $num_chars bytes via UDP\n";
} elsif (vec($rout, fileno($tcpsock), 1)) {
my $conn = $tcpsock->accept;
my $buf;
for (;;) {
my $lenbuf;
my $n = $conn->sysread($lenbuf, 2);
last unless $n == 2;
my $len = unpack("n", $lenbuf);
$n = $conn->sysread($buf, $len);
last unless $n == $len;
print "TCP request\n";
my $result = handleTCP($buf);
foreach my $response (@$result) {
$len = length($response);
$n = $conn->syswrite(pack("n", $len), 2);
$n = $conn->syswrite($response, $len);
print " Sent: $n chars via TCP\n";
}
}
$conn->close;
}
}