mir/bind
2
0
Fork 0
mirror of https://gitlab.isc.org/isc-projects/bind9 synced 2025-09-03 16:15:27 +00:00
Code Issues Releases Wiki Activity

3287. [port] Update ans.pl to work with Net::DNS 0.68. [RT #28028]

Browse Source
This commit is contained in:
Mark Andrews
2012-02-22 14:22:54 +00:00
parent afe2009552
commit 490b05960c
5 changed files with 201 additions and 147 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
CHANGES
View File

@@ -1,3 +1,5 @@
3287. [port] Update ans.pl to work with Net::DNS 0.68. [RT #28028]
3286. [bug] Managed key maintenance timer could fail to start 3286. [bug] Managed key maintenance timer could fail to start
after 'rndc reconfig'. [RT #26786] after 'rndc reconfig'. [RT #26786]

319
bin/tests/system/ans.pl
View File

@@ -14,7 +14,7 @@
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE. # PERFORMANCE OF THIS SOFTWARE.
# $Id: ans.pl,v 1.4 2011/03/18 04:41:15 each Exp $ # $Id: ans.pl,v 1.5 2012/02/22 14:22:54 marka Exp $
# #
# This is the name server from hell. It provides canned # This is the name server from hell. It provides canned
@@ -80,7 +80,7 @@ local $| = 1;
# XXX: we should also be able to specify IPv6 # XXX: we should also be able to specify IPv6
my $server_addr = "10.53.0.2"; my $server_addr = "10.53.0.2";
if (@ARGV > 0) { if (@ARGV > 0) {
$server_addr = @ARGV[0]; $server_addr = @ARGV[0];
} }
# XXX: we should also be able to set the port numbers to listen on. # XXX: we should also be able to set the port numbers to listen on.
@@ -106,108 +106,144 @@ $SIG{TERM} = \&rmpid;
#my @answers = (); #my @answers = ();
my @rules; my @rules;
sub handleUDP { sub handleUDP {
my ($buf) = @_; my ($buf) = @_;
my ($packet, $err) = new Net::DNS::Packet(\$buf, 0); my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
$err and die $err; $err and die $err;
$packet->header->qr(1); my @questions = $request->question;
$packet->header->aa(1); my $qname = $questions[0]->qname;
my $qtype = $questions[0]->qtype;
my $qclass = $questions[0]->qclass;
my $id = $request->header->id;
my @questions = $packet->question; my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
my $qname = $questions[0]->qname; $packet->header->qr(1);
my $qtype = $questions[0]->qtype; $packet->header->aa(1);
$packet->header->id($id);
# get the existing signature if any, and clear the additional section # get the existing signature if any, and clear the additional section
my $prev_tsig; my $prev_tsig;
while (my $rr = $packet->pop("additional")) { while (my $rr = $request->pop("additional")) {
if ($rr->type eq "TSIG") { if ($rr->type eq "TSIG") {
$prev_tsig = $rr; $prev_tsig = $rr;
} }
} }
my $r; my $r;
foreach $r (@rules) { foreach $r (@rules) {
my $pattern = $r->{pattern}; my $pattern = $r->{pattern};
my($dbtype, $key_name, $key_data) = split(/ /,$pattern); my($dbtype, $key_name, $key_data) = split(/ /,$pattern);
print "[handleUDP] $dbtype, $key_name, $key_data \n"; print "[handleUDP] $dbtype, $key_name, $key_data \n";
if ("$qname $qtype" =~ /$dbtype/) { if ("$qname $qtype" =~ /$dbtype/) {
my $a; my $a;
foreach $a (@{$r->{answer}}) { foreach $a (@{$r->{answer}}) {
$packet->push("answer", $a); $packet->push("answer", $a);
} }
if(defined($key_name) && defined($key_data)) { if(defined($key_name) && defined($key_data)) {
# Sign the packet # Sign the packet
print " Signing the response with " . print " Signing the response with " .
"$key_name/$key_data\n"; "$key_name/$key_data\n";
my $tsig = Net::DNS::RR-> my $tsig = Net::DNS::RR->
new("$key_name TSIG $key_data"); new("$key_name TSIG $key_data");
# These kluges are necessary because Net::DNS # These kluges are necessary because Net::DNS
# doesn't know how to sign responses. We # doesn't know how to sign responses. We
# clear compnames so that the TSIG key and # clear compnames so that the TSIG key and
# algorithm name won't be compressed, and # algorithm name won't be compressed, and
# add one to arcount because the signing # add one to arcount because the signing
# function will attempt to decrement it, # function will attempt to decrement it,
# which is incorrect in a response. Finally # which is incorrect in a response. Finally
# we set request_mac to the previous digest. # we set request_mac to the previous digest.
$packet->{"compnames"} = {}; $packet->{"compnames"} = {};
$packet->{"header"}{"arcount"} += 1; $packet->{"header"}{"arcount"} += 1;
if (defined($prev_tsig)) { if (defined($prev_tsig)) {
my $rmac = pack('n H*', my $rmac = pack('n H*',
$prev_tsig->mac_size, $prev_tsig->mac_size,
$prev_tsig->mac); $prev_tsig->mac);
$tsig->{"request_mac"} = $tsig->{"request_mac"} =
unpack("H*", $rmac); unpack("H*", $rmac);
} }
$packet->sign_tsig($tsig); $packet->sign_tsig($tsig);
} }
last; last;
} }
} }
#$packet->print; #$packet->print;
return $packet->data; return $packet->data;
} }
# namelen: # namelen:
# given a stream of data, reads a DNS-formatted name and returns its # given a stream of data, reads a DNS-formatted name and returns its
# total length, thus making it possible to skip past it. # total length, thus making it possible to skip past it.
sub namelen { sub namelen {
my ($data) = @_; my ($data) = @_;
my $len = 0; my $len = 0;
my $label_len = 0; my $label_len = 0;
do { do {
$label_len = unpack("c", $data); $label_len = unpack("c", $data);
$data = substr($data, $label_len + 1); $data = substr($data, $label_len + 1);
$len += $label_len + 1; $len += $label_len + 1;
} while ($label_len != 0); } while ($label_len != 0);
return ($len); return ($len);
} }
# packetlen: # packetlen:
# given a stream of data, reads a DNS wire-format packet and returns # given a stream of data, reads a DNS wire-format packet and returns
# its total length, making it possible to skip past it. # its total length, making it possible to skip past it.
sub packetlen { sub packetlen {
my ($data) = @_; my ($data) = @_;
my $q; my $q;
my $rr; my $rr;
my $header;
my $offset;
my ($header, $offset) = Net::DNS::Header->parse(\$data); #
for (1 .. $header->qdcount) { # decode/encode were introduced in Net::DNS 0.68
($q, $offset) = Net::DNS::Question->parse(\$data, $offset); # parse is no longer a method and calling it here makes perl croak.
} #
for (1 .. $header->ancount) { my $decode = 0;
($rr, $offset) = Net::DNS::RR->parse(\$data, $offset); $decode = 1 if ($Net::DNS::VERSION >= 0.68);
}
for (1 .. $header->nscount) { if ($decode) {
($rr, $offset) = Net::DNS::RR->parse(\$data, $offset); ($header, $offset) = Net::DNS::Header->decode(\$data);
} } else {
for (1 .. $header->arcount) { ($header, $offset) = Net::DNS::Header->parse(\$data);
($rr, $offset) = Net::DNS::RR->parse(\$data, $offset); }
}
return $offset; 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;
} }
# sign_tcp_continuation: # sign_tcp_continuation:
@@ -222,55 +258,59 @@ sub packetlen {
# the unwanted data from the digest before calling the default sign_hmac # the unwanted data from the digest before calling the default sign_hmac
# function. # function.
sub sign_tcp_continuation { sub sign_tcp_continuation {
my ($key, $data) = @_; my ($key, $data) = @_;
# copy out first two bytes: size of the previous MAC # copy out first two bytes: size of the previous MAC
my $rmacsize = unpack("n", $data); my $rmacsize = unpack("n", $data);
$data = substr($data, 2); $data = substr($data, 2);
# copy out previous MAC # copy out previous MAC
my $rmac = substr($data, 0, $rmacsize); my $rmac = substr($data, 0, $rmacsize);
$data = substr($data, $rmacsize); $data = substr($data, $rmacsize);
# try parsing out the packet information # try parsing out the packet information
my $plen = packetlen($data); my $plen = packetlen($data);
my $pdata = substr($data, 0, $plen); my $pdata = substr($data, 0, $plen);
$data = substr($data, $plen); $data = substr($data, $plen);
# remove the keyname, ttl, class, and algorithm name # remove the keyname, ttl, class, and algorithm name
$data = substr($data, namelen($data)); $data = substr($data, namelen($data));
$data = substr($data, 6); $data = substr($data, 6);
$data = substr($data, namelen($data)); $data = substr($data, namelen($data));
# preserve the TSIG data # preserve the TSIG data
my $tdata = substr($data, 0, 8); my $tdata = substr($data, 0, 8);
# prepare a new digest and sign with it # prepare a new digest and sign with it
$data = pack("n", $rmacsize) . $rmac . $pdata . $tdata; $data = pack("n", $rmacsize) . $rmac . $pdata . $tdata;
return Net::DNS::RR::TSIG::sign_hmac($key, $data); return Net::DNS::RR::TSIG::sign_hmac($key, $data);
} }
sub handleTCP { sub handleTCP {
my ($buf) = @_; my ($buf) = @_;
my ($packet, $err) = new Net::DNS::Packet(\$buf, 0); my ($request, $err) = new Net::DNS::Packet(\$buf, 0);
$err and die $err; $err and die $err;
$packet->header->qr(1); my @questions = $request->question;
$packet->header->aa(1);
my @questions = $packet->question;
my $qname = $questions[0]->qname; my $qname = $questions[0]->qname;
my $qtype = $questions[0]->qtype; my $qtype = $questions[0]->qtype;
my $qclass = $questions[0]->qclass;
my $id = $request->header->id;
# get the existing signature if any, and clear the additional section my $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
my $prev_tsig; $packet->header->qr(1);
my $signer; $packet->header->aa(1);
while (my $rr = $packet->pop("additional")) { $packet->header->id($id);
if ($rr->type eq "TSIG") {
$prev_tsig = $rr; # get the existing signature if any, and clear the additional section
} my $prev_tsig;
} my $signer;
while (my $rr = $request->pop("additional")) {
if ($rr->type eq "TSIG") {
$prev_tsig = $rr;
}
}
my @results = (); my @results = ();
my $count_these = 0; my $count_these = 0;
@@ -289,42 +329,43 @@ sub handleTCP {
if(defined($key_name) && defined($key_data)) { if(defined($key_name) && defined($key_data)) {
# sign the packet # sign the packet
print " Signing the data with " . print " Signing the data with " .
"$key_name/$key_data\n"; "$key_name/$key_data\n";
my $tsig = Net::DNS::RR-> my $tsig = Net::DNS::RR->
new("$key_name TSIG $key_data"); new("$key_name TSIG $key_data");
# These kluges are necessary because Net::DNS # These kluges are necessary because Net::DNS
# doesn't know how to sign responses. We # doesn't know how to sign responses. We
# clear compnames so that the TSIG key and # clear compnames so that the TSIG key and
# algorithm name won't be compressed, and # algorithm name won't be compressed, and
# add one to arcount because the signing # add one to arcount because the signing
# function will attempt to decrement it, # function will attempt to decrement it,
# which is incorrect in a response. Finally # which is incorrect in a response. Finally
# we set request_mac to the previous digest. # we set request_mac to the previous digest.
$packet->{"compnames"} = {}; $packet->{"compnames"} = {};
$packet->{"header"}{"arcount"} += 1; $packet->{"header"}{"arcount"} += 1;
if (defined($prev_tsig)) { if (defined($prev_tsig)) {
my $rmac = pack('n H*', my $rmac = pack('n H*',
$prev_tsig->mac_size, $prev_tsig->mac_size,
$prev_tsig->mac); $prev_tsig->mac);
$tsig->{"request_mac"} = $tsig->{"request_mac"} =
unpack("H*", $rmac); unpack("H*", $rmac);
} }
$tsig->sign_func($signer) if defined($signer); $tsig->sign_func($signer) if defined($signer);
$packet->sign_tsig($tsig); $packet->sign_tsig($tsig);
$signer = \&sign_tcp_continuation; $signer = \&sign_tcp_continuation;
my $copy = my $copy =
Net::DNS::Packet->new(\($packet->data)); Net::DNS::Packet->new(\($packet->data));
$prev_tsig = $copy->pop("additional"); $prev_tsig = $copy->pop("additional");
} }
#$packet->print; #$packet->print;
push(@results,$packet->data); push(@results,$packet->data);
$packet = new Net::DNS::Packet(\$buf, 0); $packet = new Net::DNS::Packet($qname, $qtype, $qclass);
$packet->header->qr(1); $packet->header->qr(1);
$packet->header->aa(1); $packet->header->aa(1);
$packet->header->id($id);
} }
} }
print " A total of $count_these patterns matched\n"; print " A total of $count_these patterns matched\n";
@@ -358,10 +399,10 @@ for (;;) {
} }
} }
$conn->close; $conn->close;
#print Dumper(@rules); #print Dumper(@rules);
#print "+=+=+ $rules[0]->{'pattern'}\n"; #print "+=+=+ $rules[0]->{'pattern'}\n";
#print "+=+=+ $rules[0]->{'answer'}->[0]->{'rname'}\n"; #print "+=+=+ $rules[0]->{'answer'}->[0]->{'rname'}\n";
#print "+=+=+ $rules[0]->{'answer'}->[0]\n"; #print "+=+=+ $rules[0]->{'answer'}->[0]\n";
} elsif (vec($rout, fileno($udpsock), 1)) { } elsif (vec($rout, fileno($udpsock), 1)) {
printf "UDP request\n"; printf "UDP request\n";
my $buf; my $buf;

9
bin/tests/system/ixfr/tests.sh
View File

@@ -15,7 +15,7 @@
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE. # PERFORMANCE OF THIS SOFTWARE.
# $Id: tests.sh,v 1.10 2012/02/07 23:47:24 tbox Exp $ # $Id: tests.sh,v 1.11 2012/02/22 14:22:54 marka Exp $
# WARNING: The test labelled "testing request-ixfr option in view vs zone" # WARNING: The test labelled "testing request-ixfr option in view vs zone"
@@ -65,7 +65,12 @@ EOF
$RNDCCMD reload $RNDCCMD reload
sleep 2 for i in 0 1 2 3 4 5 6 7 8 9
do
$DIGCMD nil. SOA > dig.out
grep "SOA" dig.out > /dev/null && break
sleep 1
done
$DIGCMD nil. TXT | grep 'initial AXFR' >/dev/null || { $DIGCMD nil. TXT | grep 'initial AXFR' >/dev/null || {
echo "I:failed" echo "I:failed"

4
bin/tests/system/xfer/clean.sh
View File

@@ -15,13 +15,13 @@
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE. # PERFORMANCE OF THIS SOFTWARE.
# $Id: clean.sh,v 1.17 2011/12/01 00:53:58 marka Exp $ # $Id: clean.sh,v 1.18 2012/02/22 14:22:54 marka Exp $
# #
# Clean up after zone transfer tests. # Clean up after zone transfer tests.
# #
rm -f dig.out.ns1 dig.out.ns2 dig.out.ns3 rm -f dig.out.ns1 dig.out.ns2 dig.out.ns3 dig.out.ns4
rm -f dig.out.ns5 dig.out.ns6 dig.out.ns7 rm -f dig.out.ns5 dig.out.ns6 dig.out.ns7
rm -f axfr.out rm -f axfr.out
rm -f ns1/slave.db rm -f ns1/slave.db

10
bin/tests/system/xfer/tests.sh
View File

@@ -15,7 +15,7 @@
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR # OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE. # PERFORMANCE OF THIS SOFTWARE.
# $Id: tests.sh,v 1.35 2011/12/01 00:53:58 marka Exp $ # $Id: tests.sh,v 1.36 2012/02/22 14:22:54 marka Exp $
SYSTEMTESTTOP=.. SYSTEMTESTTOP=..
. $SYSTEMTESTTOP/conf.sh . $SYSTEMTESTTOP/conf.sh
@@ -234,7 +234,13 @@ EOF
$RNDCCMD reload | sed 's/^/I:ns4 /' $RNDCCMD reload | sed 's/^/I:ns4 /'
sleep 2
for i in 0 1 2 3 4 5 6 7 8 9
do
$DIGCMD nil. SOA > dig.out.ns4
grep SOA dig.out.ns4 > /dev/null && break
sleep 1
done
$DIGCMD nil. TXT | grep 'initial AXFR' >/dev/null || { $DIGCMD nil. TXT | grep 'initial AXFR' >/dev/null || {
echo "I:failed" echo "I:failed"