ComputerSurge/bind9
3
0
Fork 0
Code Pull Requests 1 Activity

3059. [test] Added a regression test for change #3023.

Browse Source
This commit is contained in:
Evan Hunt
2011-03-04 22:03:27 +00:00
parent b0a697dfba
commit 958e5acd60
16 changed files with 622 additions and 164 deletions
Download Patch File Download Diff File Expand all files Collapse all files

157
bin/tests/system/ixfr/ans2/ans.pl
View File

@@ -1,157 +0,0 @@
#!/usr/bin/perl
#
# Copyright (C) 2004, 2007 Internet Systems Consortium, Inc. ("ISC")
# Copyright (C) 2001 Internet Software Consortium.
#
# Permission to use, copy, modify, and/or distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH
# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT,
# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
# $Id: ans.pl,v 1.6 2007/09/24 04:13:25 marka Exp $
#
# This is the name server from hell. It provides canned
# responses based on pattern matching the queries, and
# can be reprogrammed on-the-fly over a TCP connection.
#
# The server listens for control connections on port 5301.
# A control connection is a TCP stream of lines like
#
# /pattern/
# name ttl type rdata
# name ttl type rdata
# ...
# /pattern/
# name ttl type rdata
# name ttl type rdata
# ...
#
# There can be any number of patterns, each associated
# with any number of response RRs. Each pattern is a
# Perl regular expression.
#
# Each incoming query is converted into a string of the form
# "qname qtype" (the printable query domain name, space,
# printable query type) and matched against each pattern.
#
# The first pattern matching the query is selected, and
# the RR following the pattern line are sent in the
# answer section of the response.
#
# Each new control connection causes the current set of
# patterns and responses to be cleared before adding new
# ones.
#
# The server handles UDP and TCP queries. Zone transfer
# responses work, but must fit in a single 64 k message.
#
use IO::File;
use IO::Socket;
use Net::DNS;
use Net::DNS::Packet;
my $ctlsock = IO::Socket::INET->new(LocalAddr => "10.53.0.2",
LocalPort => 5301, Proto => "tcp", Listen => 5, Reuse => 1) or die "$!";
my $udpsock = IO::Socket::INET->new(LocalAddr => "10.53.0.2",
LocalPort => 5300, Proto => "udp", Reuse => 1) or die "$!";
my $tcpsock = IO::Socket::INET->new(LocalAddr => "10.53.0.2",
LocalPort => 5300, Proto => "tcp", Listen => 5, Reuse => 1) or die "$!";
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 @answers = ();
sub handle {
my ($buf) = @_;
my ($packet, $err) = new Net::DNS::Packet(\$buf, 0);
$err and die $err;
$packet->header->qr(1);
$packet->header->aa(1);
my @questions = $packet->question;
my $qname = $questions[0]->qname;
my $qtype = $questions[0]->qtype;
my $r;
foreach $r (@rules) {
my $pattern = $r->{pattern};
warn "match $qname $qtype == $pattern";
if ("$qname $qtype" =~ /$pattern/) {
my $a;
foreach $a (@{$r->{answer}}) {
$packet->push("answer", $a);
}
last;
}
}
# $packet->print;
return $packet->data;
}
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;
@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";
$udpsock->recv($buf, 512);
$response = handle($buf);
$udpsock->send($response);
} elsif (vec($rout, fileno($tcpsock), 1)) {
my $conn = $tcpsock->accept;
for (;;) {
printf "TCP request\n";
my $n = $conn->sysread($lenbuf, 2);
last unless $n == 2;
my $len = unpack("n", $lenbuf);
$n = $conn->sysread($buf, $len);
last unless $n == $len;
$response = handle($buf);
$len = length($response);
$n = $conn->syswrite(pack("n", $len), 2);
$n = $conn->syswrite($response, $len);
}
$conn->close;
}
}

0
bin/tests/system/ixfr/ans2/startme Normal file
View File