mir/bind
2
0
Fork 0
mirror of https://gitlab.isc.org/isc-projects/bind9 synced 2025-09-02 07:35:26 +00:00
Code Issues Releases Wiki Activity

start.pl - refactor

Browse Source
This commit is contained in:
Brian Conry
2018-11-27 17:47:08 -06:00
committed by Ondřej Surý
parent 597049461d
commit 0fc8bfef13
1 changed files with 271 additions and 187 deletions
Download Patch File Download Diff File Expand all files Collapse all files

458
bin/tests/system/start.pl
View File

@@ -15,9 +15,12 @@
# If a server is specified, start it. Otherwise, start all servers for test. # If a server is specified, start it. Otherwise, start all servers for test.
use strict; use strict;
use Cwd; use warnings;
use Cwd 'abs_path';
use Cwd ':DEFAULT', 'abs_path';
use English '-no_match_vars';
use Getopt::Long; use Getopt::Long;
use Time::HiRes 'sleep'; # allows sleeping fractional seconds
# Usage: # Usage:
# perl start.pl [--noclean] [--restart] [--port port] test [server [options]] # perl start.pl [--noclean] [--restart] [--port port] test [server [options]]
@@ -55,29 +58,34 @@ use Getopt::Long;
# "named.args" is ignored. # "named.args" is ignored.
my $usage = "usage: $0 [--noclean] [--restart] [--port <port>] test-directory [server-directory [server-options]]"; my $usage = "usage: $0 [--noclean] [--restart] [--port <port>] test-directory [server-directory [server-options]]";
my $noclean = ''; my $clean = 1;
my $restart = ''; my $restart = 0;
my $queryport = 5300; my $queryport = 5300;
GetOptions('noclean' => \$noclean, 'restart' => \$restart, 'port=i' => \$queryport) or die "$usage\n"; GetOptions(
'clean!' => \$clean,
'restart!' => \$restart,
'port=i' => \$queryport,
) or die "$usage\n";
my $test = $ARGV[0]; my( $test, $server_arg, $options_arg ) = @ARGV;
my $server = $ARGV[1];
my $options = $ARGV[2];
if (!$test) { if (!$test) {
die "$usage\n"; die "$usage\n";
} }
if (!-d $test) {
die "No test directory: \"$test\"\n";
}
if ($server && !-d "$test/$server") {
die "No server directory: \"$test/$server\"\n";
}
# Global variables # Global variables
my $topdir = abs_path("$test/.."); my $topdir = abs_path($ENV{'SYSTEMTESTTOP'});
my $testdir = abs_path("$test"); my $testdir = abs_path($topdir . "/" . $test);
if (! -d $testdir) {
die "No test directory: \"$testdir\"\n";
}
if ($server_arg && ! -d "$testdir/$server_arg") {
die "No server directory: \"$testdir/$server_arg\"\n";
}
my $NAMED = $ENV{'NAMED'}; my $NAMED = $ENV{'NAMED'};
my $DIG = $ENV{'DIG'}; my $DIG = $ENV{'DIG'};
my $PERL = $ENV{'PERL'}; my $PERL = $ENV{'PERL'};
@@ -85,185 +93,109 @@ my $PYTHON = $ENV{'PYTHON'};
# Start the server(s) # Start the server(s)
if ($server) { my @ns;
if ($server =~ /^ns/) { my @ans;
&check_ports($server);
} if ($server_arg) {
&start_server($server, $options); if ($server_arg =~ /^ns/) {
if ($server =~ /^ns/) { push(@ns, $server_arg);
&verify_server($server); } elsif ($server_arg =~ /^ans/) {
push(@ans, $server_arg);
} else {
print "$0: ns or ans directory expected";
print "I:$test:failed";
} }
} else { } else {
# Determine which servers need to be started for this test. # Determine which servers need to be started for this test.
opendir DIR, $testdir; opendir DIR, $testdir or die "unable to read test directory: \"$test\" ($OS_ERROR)\n";
my @files = sort readdir DIR; my @files = sort readdir DIR;
closedir DIR; closedir DIR;
my @ns = grep /^ns[0-9]*$/, @files; @ns = grep /^ns[0-9]*$/, @files;
my @ans = grep /^ans[0-9]*$/, @files; @ans = grep /^ans[0-9]*$/, @files;
my $name; }
# Start the servers we found. # Start the servers we found.
&check_ports();
foreach $name(@ns, @ans) { foreach my $name(@ns) {
&start_server($name); &check_ns_port($name);
&verify_server($name) if ($name =~ /^ns/); &start_ns_server($name, $options_arg);
} &verify_ns_server($name);
}
foreach my $name(@ans) {
&start_ans_server($name);
} }
# Subroutines # Subroutines
sub check_ports { sub read_ns_port {
my $server = shift;
my $port = $queryport;
my $options = "";
if ($server) {
my $file = $testdir . "/" . $server . "/named.port";
if (-e $file) {
open(my $fh, "<", $file) or die "unable to read ports file \"$file\" ($OS_ERROR)";
my $line = <$fh>;
if ($line) {
chomp $line;
$port = $line;
}
}
}
return ($port);
}
sub check_ns_port {
my $server = shift; my $server = shift;
my $options = ""; my $options = "";
my $port = $queryport; my $port = read_ns_port($server);
my $file = "";
$file = $testdir . "/" . $server . "/named.port" if ($server); if ($server =~ /(\d+)$/) {
if ($server && $server =~ /(\d+)$/) {
$options = "-i $1"; $options = "-i $1";
} }
if ($file ne "" && -e $file) {
open(FH, "<", $file);
while(my $line=<FH>) {
chomp $line;
$port = $line;
last;
}
close FH;
}
my $tries = 0; my $tries = 0;
while (1) { while (1) {
my $return = system("$PERL $topdir/testsock.pl -p $port $options"); my $return = system("$PERL $topdir/testsock.pl -p $port $options");
last if ($return == 0);
if (++$tries > 4) { if ($return == 0) {
last;
}
$tries++;
if ($tries > 4) {
print "$0: could not bind to server addresses, still running?\n"; print "$0: could not bind to server addresses, still running?\n";
print "I:server sockets not available\n"; print "I:$test:server sockets not available\n";
print "I:failed\n"; print "I:$test:failed\n";
system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior? system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior?
exit 1; exit 1;
} }
print "I:Couldn't bind to socket (yet)\n";
print "I:$test:Couldn't bind to socket (yet)\n";
sleep 2; sleep 2;
} }
} }
sub start_server { sub start_server {
my $server = shift; my $server = shift;
my $options = shift; my $command = shift;
my $pid_file = shift;
my $cleanup_files; chdir "$testdir/$server" or die "unable to chdir \"$testdir/$server\" ($OS_ERROR)\n";
my $command;
my $pid_file;
my $cwd = getcwd();
my $args_file = $cwd . "/" . $test . "/" . $server . "/" . "named.args";
if ($server =~ /^ns/) {
$cleanup_files = "{*.jnl,*.bk,*.st,named.run}";
if ($ENV{'USE_VALGRIND'}) {
$command = "valgrind -q --gen-suppressions=all --num-callers=48 --fullpath-after= --log-file=named-$server-valgrind-%p.log ";
if ($ENV{'USE_VALGRIND'} eq 'helgrind') {
$command .= "--tool=helgrind ";
} else {
$command .= "--tool=memcheck --track-origins=yes --leak-check=full ";
}
$command .= "$NAMED -m none -M external ";
} else {
$command = "$NAMED ";
}
if ($options) {
$command .= "$options";
} elsif (-e $args_file) {
open(FH, "<", $args_file);
while(my $line=<FH>)
{
#$line =~ s/\R//g;
chomp $line;
next if ($line =~ /^\s*$/); #discard blank lines
next if ($line =~ /^\s*#/); #discard comment lines
$line =~ s/#.*$//g;
$options = $line;
last;
}
close FH;
$command .= "$options";
} else {
$command .= "-D $test-$server ";
$command .= "-X named.lock ";
$command .= "-m record,size,mctx ";
$command .= "-T clienttest ";
$command .= "-T dropedns "
if (-e "$testdir/$server/named.dropedns");
$command .= "-T ednsformerr "
if (-e "$testdir/$server/named.ednsformerr");
$command .= "-T ednsnotimp "
if (-e "$testdir/$server/named.ednsnotimp");
$command .= "-T ednsrefused "
if (-e "$testdir/$server/named.ednsrefused");
$command .= "-T noaa "
if (-e "$testdir/$server/named.noaa");
$command .= "-T noedns "
if (-e "$testdir/$server/named.noedns");
$command .= "-T nosoa "
if (-e "$testdir/$server/named.nosoa");
$command .= "-T maxudp512 "
if (-e "$testdir/$server/named.maxudp512");
$command .= "-T maxudp1460 "
if (-e "$testdir/$server/named.maxudp1460");
$command .= "-c named.conf -d 99 -g -U 4";
}
$command .= " -T notcp"
if (-e "$testdir/$server/named.notcp");
if ($restart) {
$command .= " >>named.run 2>&1 &";
} else {
$command .= " >named.run 2>&1 &";
}
$pid_file = "named.pid";
} elsif ($server =~ /^ans/) {
$cleanup_files = "{ans.run}";
if (-e "$testdir/$server/ans.py") {
$command = "$PYTHON -u ans.py 10.53.0.$' $queryport";
} elsif (-e "$testdir/$server/ans.pl") {
$command = "$PERL ans.pl";
} else {
$command = "$PERL $topdir/ans.pl 10.53.0.$'";
}
if ($options) {
$command .= "$options";
} else {
$command .= "";
}
if ($restart) {
$command .= " >>ans.run 2>&1 &";
} else {
$command .= " >ans.run 2>&1 &";
}
$pid_file = "ans.pid";
} else {
print "I:Unknown server type $server\n";
print "I:failed\n";
system "$PERL $topdir/stop.pl $testdir";
exit 1;
}
# print "I:starting server %s\n",$server;
chdir "$testdir/$server";
unless ($noclean) {
unlink glob $cleanup_files;
}
# get the shell to report the pid of the server ($!)
$command .= "echo \$!";
# start the server # start the server
my $child = `$command`; my $child = `$command`;
$child =~ s/\s+$//g; $child =~ s/\s+$//;
# wait up to 14 seconds for the server to start and to write the # wait up to 14 seconds for the server to start and to write the
# pid file otherwise kill this server and any others that have # pid file otherwise kill this server and any others that have
@@ -271,39 +203,171 @@ sub start_server {
my $tries = 0; my $tries = 0;
while (!-s $pid_file) { while (!-s $pid_file) {
if (++$tries > 140) { if (++$tries > 140) {
print "I:Couldn't start server $server (pid=$child)\n"; print "I:$test:Couldn't start server $command (pid=$child)\n";
print "I:failed\n"; print "I:$test:failed\n";
system "kill -9 $child" if ("$child" ne ""); system "kill -9 $child" if ("$child" ne "");
system "$PERL $topdir/stop.pl $testdir"; system "$PERL $topdir/stop.pl $testdir";
exit 1; exit 1;
} }
# sleep for 0.1 seconds sleep 0.1;
select undef,undef,undef,0.1;
} }
# go back to the top level directory # go back to the top level directory
chdir $cwd; chdir $topdir;
} }
sub verify_server { sub construct_ns_command {
my $server = shift; my $server = shift;
my $n = $server; my $options = shift;
my $port = $queryport;
my $tcp = "+tcp";
$n =~ s/^ns//; my $command;
if (-e "$testdir/$server/named.port") { if ($ENV{'USE_VALGRIND'}) {
open(FH, "<", "$testdir/$server/named.port"); $command = "valgrind -q --gen-suppressions=all --num-callers=48 --fullpath-after= --log-file=named-$server-valgrind-%p.log ";
while(my $line=<FH>) {
chomp $line; if ($ENV{'USE_VALGRIND'} eq 'helgrind') {
$port = $line; $command .= "--tool=helgrind ";
last; } else {
$command .= "--tool=memcheck --track-origins=yes --leak-check=full ";
} }
close FH;
$command .= "$NAMED -m none -M external ";
} else {
$command = "$NAMED ";
} }
$tcp = "" if (-e "$testdir/$server/named.notcp"); my $args_file = $testdir . "/" . $server . "/" . "named.args";
if ($options) {
$command .= $options;
} elsif (-e $args_file) {
open(my $fh, "<", $args_file) or die "unable to read args_file \"$args_file\" ($OS_ERROR)\n";
while(my $line=<$fh>) {
next if ($line =~ /^\s*$/); #discard blank lines
next if ($line =~ /^\s*#/); #discard comment lines
chomp $line;
$line =~ s/#.*$//;
$command .= $line;
last;
}
} else {
$command .= "-D $test-$server ";
$command .= "-X named.lock ";
$command .= "-m record,size,mctx ";
$command .= "-T clienttest ";
foreach my $t_option(
"dropedns", "ednsformerr", "ednsnotimp", "ednsrefused",
"noaa", "noedns", "nosoa", "maxudp512", "maxudp1460",
) {
if (-e "$testdir/$server/named.$t_option") {
$command .= "-T $t_option "
}
}
$command .= "-c named.conf -d 99 -g -U 4";
}
if (-e "$testdir/$server/named.notcp") {
$command .= " -T notcp"
}
if ($restart) {
$command .= " >>named.run 2>&1 &";
} else {
$command .= " >named.run 2>&1 &";
}
# get the shell to report the pid of the server ($!)
$command .= " echo \$!";
return $command;
}
sub start_ns_server {
my $server = shift;
my $options = shift;
my $cleanup_files;
my $command;
my $pid_file;
$cleanup_files = "{./*.jnl,./*.bk,./*.st,./named.run}";
$command = construct_ns_command($server, $options);
$pid_file = "named.pid";
if ($clean) {
unlink glob $cleanup_files;
}
start_server($server, $command, $pid_file);
}
sub construct_ans_command {
my $server = shift;
my $options = shift;
my $command;
my $n;
if ($server =~ /^ans(\d+)/) {
$n = $1;
} else {
die "unable to parse server number from name \"$server\"\n";
}
if (-e "$testdir/$server/ans.py") {
$command = "$PYTHON -u ans.py 10.53.0.$n $queryport";
} elsif (-e "$testdir/$server/ans.pl") {
$command = "$PERL ans.pl";
} else {
$command = "$PERL $topdir/ans.pl 10.53.0.$n";
}
if ($options) {
$command .= $options;
}
if ($restart) {
$command .= " >>ans.run 2>&1 &";
} else {
$command .= " >ans.run 2>&1 &";
}
# get the shell to report the pid of the server ($!)
$command .= " echo \$!";
return $command;
}
sub start_ans_server {
my $server = shift; # masks the global variable
my $options = shift; # masks the global variable
my $cleanup_files;
my $command;
my $pid_file;
$cleanup_files = "{./ans.run}";
$command = construct_ans_command($server, $options);
$pid_file = "ans.pid";
if ($clean) {
unlink glob $cleanup_files;
}
start_server($server, $command, $pid_file);
}
sub verify_ns_server {
my $server = shift;
my $tries = 0; my $tries = 0;
@@ -323,8 +387,8 @@ sub verify_server {
$tries++; $tries++;
if ($tries >= 30) { if ($tries >= 30) {
print "I:server $server seems to have not started\n"; print "I:$test:server $server seems to have not started\n";
print "I:failed\n"; print "I:$test:failed\n";
system("$PERL $topdir/stop.pl $testdir"); system("$PERL $topdir/stop.pl $testdir");
@@ -336,16 +400,36 @@ sub verify_server {
$tries = 0; $tries = 0;
my $port = read_ns_port($server);
my $tcp = "+tcp";
my $n;
if ($server =~ /^ns(\d+)/) {
$n = $1;
} else {
die "unable to parse server number from name \"$server\"\n";
}
if (-e "$testdir/$server/named.notcp") {
$tcp = "";
}
while (1) { while (1) {
my $return = system("$DIG $tcp +noadd +nosea +nostat +noquest +nocomm +nocmd +noedns -p $port version.bind. chaos txt \@10.53.0.$n > dig.out"); my $return = system("$DIG $tcp +noadd +nosea +nostat +noquest +nocomm +nocmd +noedns -p $port version.bind. chaos txt \@10.53.0.$n > /dev/null");
last if ($return == 0); last if ($return == 0);
if (++$tries >= 30) {
print "I:no response from $server\n"; $tries++;
print "I:failed\n";
if ($tries >= 30) {
print "I:$test:no response from $server\n";
print "I:$test:failed\n";
system("$PERL $topdir/stop.pl $testdir"); system("$PERL $topdir/stop.pl $testdir");
exit 1; exit 1;
} }
sleep 2; sleep 2;
} }
unlink "dig.out";
} }