From: Brian Conry <bconry@isc.org>
Date: Tue, 27 Nov 2018 23:47:08 +0000 (-0600)
Subject: start.pl - refactor
X-Git-Tag: v9.13.5~17^2~3
X-Git-Url: http://git.ipfire.org/gitweb/index.cgi?a=commitdiff_plain;h=0fc8bfef139407dbe33ce936a55e279910ff82a5;p=thirdparty%2Fbind9.git

start.pl - refactor
---

diff --git a/bin/tests/system/start.pl b/bin/tests/system/start.pl
index 8df5ab1b52e..0af13cd3ada 100755
--- a/bin/tests/system/start.pl
+++ b/bin/tests/system/start.pl
@@ -15,9 +15,12 @@
 # If a server is specified, start it. Otherwise, start all servers for test.
 
 use strict;
-use Cwd;
-use Cwd 'abs_path';
+use warnings;
+
+use Cwd ':DEFAULT', 'abs_path';
+use English '-no_match_vars';
 use Getopt::Long;
+use Time::HiRes 'sleep'; # allows sleeping fractional seconds
 
 # Usage:
 #   perl start.pl [--noclean] [--restart] [--port port] test [server [options]]
@@ -55,29 +58,34 @@ use Getopt::Long;
 #                   "named.args" is ignored.
 
 my $usage = "usage: $0 [--noclean] [--restart] [--port <port>] test-directory [server-directory [server-options]]";
-my $noclean = '';
-my $restart = '';
+my $clean = 1;
+my $restart = 0;
 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 $server = $ARGV[1];
-my $options = $ARGV[2];
+my( $test, $server_arg, $options_arg ) = @ARGV;
 
 if (!$test) {
 	die "$usage\n";
 }
-if (!-d $test) {
-	die "No test directory: \"$test\"\n";
+
+# Global variables
+my $topdir = abs_path($ENV{'SYSTEMTESTTOP'});
+my $testdir = abs_path($topdir . "/" . $test);
+
+if (! -d $testdir) {
+	die "No test directory: \"$testdir\"\n";
 }
-if ($server && !-d "$test/$server") {
-	die "No server directory: \"$test/$server\"\n";
+
+if ($server_arg && ! -d "$testdir/$server_arg") {
+	die "No server directory: \"$testdir/$server_arg\"\n";
 }
 
-# Global variables
-my $topdir = abs_path("$test/..");
-my $testdir = abs_path("$test");
 my $NAMED = $ENV{'NAMED'};
 my $DIG = $ENV{'DIG'};
 my $PERL = $ENV{'PERL'};
@@ -85,185 +93,109 @@ my $PYTHON = $ENV{'PYTHON'};
 
 # Start the server(s)
 
-if ($server) {
-	if ($server =~ /^ns/) {
-		&check_ports($server);
-	}
-	&start_server($server, $options);
-	if ($server =~ /^ns/) {
-		&verify_server($server);
+my @ns;
+my @ans;
+
+if ($server_arg) {
+	if ($server_arg =~ /^ns/) {
+		push(@ns, $server_arg);
+	} elsif ($server_arg =~ /^ans/) {
+		push(@ans, $server_arg);
+	} else {
+		print "$0: ns or ans directory expected";
+		print "I:$test:failed";
 	}
 } else {
 	# 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;
 	closedir DIR;
 
-	my @ns = grep /^ns[0-9]*$/, @files;
-	my @ans = grep /^ans[0-9]*$/, @files;
-	my $name;
+	@ns = grep /^ns[0-9]*$/, @files;
+	@ans = grep /^ans[0-9]*$/, @files;
+}
 
-	# Start the servers we found.
-	&check_ports();
-	foreach $name(@ns, @ans) {
-		&start_server($name);
-		&verify_server($name) if ($name =~ /^ns/);
-	}
+# Start the servers we found.
+
+foreach my $name(@ns) {
+	&check_ns_port($name);
+	&start_ns_server($name, $options_arg);
+	&verify_ns_server($name);
+}
+
+foreach my $name(@ans) {
+	&start_ans_server($name);
 }
 
 # Subroutines
 
-sub check_ports {
+sub read_ns_port {
 	my $server = shift;
-	my $options = "";
 	my $port = $queryport;
-	my $file = "";
+	my $options = "";
 
-	$file = $testdir . "/" . $server . "/named.port" if ($server);
+	if ($server) {
+		my $file = $testdir . "/" . $server . "/named.port";
 
-	if ($server && $server =~ /(\d+)$/) {
-		$options = "-i $1";
-	}
+		if (-e $file) {
+			open(my $fh, "<", $file) or die "unable to read ports file \"$file\" ($OS_ERROR)";
 
-	if ($file ne "" && -e $file) {
-		open(FH, "<", $file);
-		while(my $line=<FH>) {
-			chomp $line;
-			$port = $line;
-			last;
+			my $line = <$fh>;
+
+			if ($line) {
+				chomp $line;
+				$port = $line;
+			}
 		}
-		close FH;
+	}
+	return ($port);
+}
+
+sub check_ns_port {
+	my $server = shift;
+	my $options = "";
+	my $port = read_ns_port($server);
+
+	if ($server =~ /(\d+)$/) {
+		$options = "-i $1";
 	}
 
 	my $tries = 0;
+
 	while (1) {
 		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 "I:server sockets not available\n";
-			print "I:failed\n";
+			print "I:$test:server sockets not available\n";
+			print "I:$test:failed\n";
+
 			system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior?
+
 			exit 1;
 		}
-		print "I:Couldn't bind to socket (yet)\n";
+
+		print "I:$test:Couldn't bind to socket (yet)\n";
 		sleep 2;
 	}
 }
 
 sub start_server {
 	my $server = shift;
-	my $options = shift;
+	my $command = shift;
+	my $pid_file = shift;
 
-	my $cleanup_files;
-	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 \$!";
+	chdir "$testdir/$server" or die "unable to chdir \"$testdir/$server\" ($OS_ERROR)\n";
 
 	# start the server
 	my $child = `$command`;
-	$child =~ s/\s+$//g;
+	$child =~ s/\s+$//;
 
 	# 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
@@ -271,39 +203,171 @@ sub start_server {
 	my $tries = 0;
 	while (!-s $pid_file) {
 		if (++$tries > 140) {
-			print "I:Couldn't start server $server (pid=$child)\n";
-			print "I:failed\n";
+			print "I:$test:Couldn't start server $command (pid=$child)\n";
+			print "I:$test:failed\n";
 			system "kill -9 $child" if ("$child" ne "");
 			system "$PERL $topdir/stop.pl $testdir";
 			exit 1;
 		}
-		# sleep for 0.1 seconds
-		select undef,undef,undef,0.1;
+		sleep 0.1;
 	}
 
-        # go back to the top level directory
-	chdir $cwd;
+	# go back to the top level directory
+	chdir $topdir;
 }
 
-sub verify_server {
+sub construct_ns_command {
 	my $server = shift;
-	my $n = $server;
-	my $port = $queryport;
-	my $tcp = "+tcp";
+	my $options = shift;
+
+	my $command;
+
+	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 ";
+	}
 
-	$n =~ s/^ns//;
+	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
 
-	if (-e "$testdir/$server/named.port") {
-		open(FH, "<", "$testdir/$server/named.port");
-		while(my $line=<FH>) {
 			chomp $line;
-			$port = $line;
+
+			$line =~ s/#.*$//;
+
+			$command .= $line;
+
 			last;
 		}
-		close FH;
+	} 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;
 	}
 
-	$tcp = "" if (-e "$testdir/$server/named.notcp");
+	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;
 
@@ -323,8 +387,8 @@ sub verify_server {
 		$tries++;
 
 		if ($tries >= 30) {
-			print "I:server $server seems to have not started\n";
-			print "I:failed\n";
+			print "I:$test:server $server seems to have not started\n";
+			print "I:$test:failed\n";
 
 			system("$PERL $topdir/stop.pl $testdir");
 
@@ -336,16 +400,36 @@ sub verify_server {
 
 	$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) {
-		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);
-		if (++$tries >= 30) {
-			print "I:no response from $server\n";
-			print "I:failed\n";
+
+		$tries++;
+
+		if ($tries >= 30) {
+			print "I:$test:no response from $server\n";
+			print "I:$test:failed\n";
+
 			system("$PERL $topdir/stop.pl $testdir");
+
 			exit 1;
 		}
+
 		sleep 2;
 	}
-	unlink "dig.out";
 }