start.pl revision 1.1.1.4
1#!/usr/bin/perl -w 2# 3# Copyright (C) Internet Systems Consortium, Inc. ("ISC") 4# 5# This Source Code Form is subject to the terms of the Mozilla Public 6# License, v. 2.0. If a copy of the MPL was not distributed with this 7# file, You can obtain one at http://mozilla.org/MPL/2.0/. 8# 9# See the COPYRIGHT file distributed with this work for additional 10# information regarding copyright ownership. 11 12# Framework for starting test servers. 13# Based on the type of server specified, check for port availability, remove 14# temporary files, start the server, and verify that the server is running. 15# If a server is specified, start it. Otherwise, start all servers for test. 16 17use strict; 18use warnings; 19 20use Cwd ':DEFAULT', 'abs_path'; 21use English '-no_match_vars'; 22use Getopt::Long; 23use Time::HiRes 'sleep'; # allows sleeping fractional seconds 24 25# Usage: 26# perl start.pl [--noclean] [--restart] [--port port] test [server [options]] 27# 28# --noclean Do not cleanup files in server directory. 29# 30# --restart Indicate that the server is being restarted, so get the 31# server to append output to an existing log file instead of 32# starting a new one. 33# 34# --port port Specify the default port being used by the server to answer 35# queries (default 5300). This script will interrogate the 36# server on this port to see if it is running. (Note: for 37# "named" nameservers, this can be overridden by the presence 38# of the file "named.port" in the server directory containing 39# the number of the query port.) 40# 41# test Name of the test directory. 42# 43# server Name of the server directory. This will be of the form 44# "nsN" or "ansN", where "N" is an integer between 1 and 8. 45# If not given, the script will start all the servers in the 46# test directory. 47# 48# options Alternate options for the server. 49# 50# NOTE: options must be specified with '-- "<option list>"', 51# for instance: start.pl . ns1 -- "-c n.conf -d 43" 52# 53# ALSO NOTE: this variable will be filled with the contents 54# of the first non-commented/non-blank line of args in a file 55# called "named.args" in an ns*/ subdirectory. Only the FIRST 56# non-commented/non-blank line is used (everything else in 57# the file is ignored). If "options" is already set, then 58# "named.args" is ignored. 59 60my $usage = "usage: $0 [--noclean] [--restart] [--port <port>] test-directory [server-directory [server-options]]"; 61my $clean = 1; 62my $restart = 0; 63my $queryport = 5300; 64 65GetOptions( 66 'clean!' => \$clean, 67 'restart!' => \$restart, 68 'port=i' => \$queryport, 69) or die "$usage\n"; 70 71my( $test, $server_arg, $options_arg ) = @ARGV; 72 73if (!$test) { 74 die "$usage\n"; 75} 76 77# Global variables 78my $topdir = abs_path($ENV{'SYSTEMTESTTOP'}); 79my $testdir = abs_path($topdir . "/" . $test); 80 81if (! -d $testdir) { 82 die "No test directory: \"$testdir\"\n"; 83} 84 85if ($server_arg && ! -d "$testdir/$server_arg") { 86 die "No server directory: \"$testdir/$server_arg\"\n"; 87} 88 89my $NAMED = $ENV{'NAMED'}; 90my $DIG = $ENV{'DIG'}; 91my $PERL = $ENV{'PERL'}; 92my $PYTHON = $ENV{'PYTHON'}; 93 94# Start the server(s) 95 96my @ns; 97my @ans; 98 99if ($server_arg) { 100 if ($server_arg =~ /^ns/) { 101 push(@ns, $server_arg); 102 } elsif ($server_arg =~ /^ans/) { 103 push(@ans, $server_arg); 104 } else { 105 print "$0: ns or ans directory expected"; 106 print "I:$test:failed"; 107 } 108} else { 109 # Determine which servers need to be started for this test. 110 opendir DIR, $testdir or die "unable to read test directory: \"$test\" ($OS_ERROR)\n"; 111 my @files = sort readdir DIR; 112 closedir DIR; 113 114 @ns = grep /^ns[0-9]*$/, @files; 115 @ans = grep /^ans[0-9]*$/, @files; 116} 117 118# Start the servers we found. 119 120foreach my $name(@ns) { 121 &check_ns_port($name); 122 &start_ns_server($name, $options_arg); 123 &verify_ns_server($name); 124} 125 126foreach my $name(@ans) { 127 &start_ans_server($name); 128} 129 130# Subroutines 131 132sub read_ns_port { 133 my ( $server ) = @_; 134 my $port = $queryport; 135 my $options = ""; 136 137 if ($server) { 138 my $file = $testdir . "/" . $server . "/named.port"; 139 140 if (-e $file) { 141 open(my $fh, "<", $file) or die "unable to read ports file \"$file\" ($OS_ERROR)"; 142 143 my $line = <$fh>; 144 145 if ($line) { 146 chomp $line; 147 $port = $line; 148 } 149 } 150 } 151 return ($port); 152} 153 154sub check_ns_port { 155 my ( $server ) = @_; 156 my $options = ""; 157 my $port = read_ns_port($server); 158 159 if ($server =~ /(\d+)$/) { 160 $options = "-i $1"; 161 } 162 163 my $tries = 0; 164 165 while (1) { 166 my $return = system("$PERL $topdir/testsock.pl -p $port $options"); 167 168 if ($return == 0) { 169 last; 170 } 171 172 $tries++; 173 174 if ($tries > 4) { 175 print "$0: could not bind to server addresses, still running?\n"; 176 print "I:$test:server sockets not available\n"; 177 print "I:$test:failed\n"; 178 179 system("$PERL $topdir/stop.pl $test"); # Is this the correct behavior? 180 181 exit 1; 182 } 183 184 print "I:$test:Couldn't bind to socket (yet)\n"; 185 sleep 2; 186 } 187} 188 189sub start_server { 190 my ( $server, $command, $pid_file ) = @_; 191 192 chdir "$testdir/$server" or die "unable to chdir \"$testdir/$server\" ($OS_ERROR)\n"; 193 194 # start the server 195 my $child = `$command`; 196 chomp($child); 197 198 # wait up to 14 seconds for the server to start and to write the 199 # pid file otherwise kill this server and any others that have 200 # already been started 201 my $tries = 0; 202 while (!-s $pid_file) { 203 if (++$tries > 140) { 204 print "I:$test:Couldn't start server $command (pid=$child)\n"; 205 print "I:$test:failed\n"; 206 system "kill -9 $child" if ("$child" ne ""); 207 chdir "$testdir"; 208 system "$PERL $topdir/stop.pl $test"; 209 exit 1; 210 } 211 sleep 0.1; 212 } 213 214 # go back to the top level directory 215 chdir $topdir; 216} 217 218sub construct_ns_command { 219 my ( $server, $options ) = @_; 220 221 my $command; 222 223 if ($ENV{'USE_VALGRIND'}) { 224 $command = "valgrind -q --gen-suppressions=all --num-callers=48 --fullpath-after= --log-file=named-$server-valgrind-%p.log "; 225 226 if ($ENV{'USE_VALGRIND'} eq 'helgrind') { 227 $command .= "--tool=helgrind "; 228 } else { 229 $command .= "--tool=memcheck --track-origins=yes --leak-check=full "; 230 } 231 232 $command .= "$NAMED -m none -M external "; 233 } else { 234 $command = "$NAMED "; 235 } 236 237 my $args_file = $testdir . "/" . $server . "/" . "named.args"; 238 239 if ($options) { 240 $command .= $options; 241 } elsif (-e $args_file) { 242 open(my $fh, "<", $args_file) or die "unable to read args_file \"$args_file\" ($OS_ERROR)\n"; 243 244 while(my $line=<$fh>) { 245 next if ($line =~ /^\s*$/); #discard blank lines 246 next if ($line =~ /^\s*#/); #discard comment lines 247 248 chomp $line; 249 250 $line =~ s/#.*$//; 251 252 $command .= $line; 253 254 last; 255 } 256 } else { 257 $command .= "-D $test-$server "; 258 $command .= "-X named.lock "; 259 $command .= "-m record,size,mctx "; 260 261 foreach my $t_option( 262 "dropedns", "ednsformerr", "ednsnotimp", "ednsrefused", 263 "noaa", "noedns", "nosoa", "maxudp512", "maxudp1460", 264 ) { 265 if (-e "$testdir/$server/named.$t_option") { 266 $command .= "-T $t_option " 267 } 268 } 269 270 $command .= "-c named.conf -d 99 -g -U 4"; 271 } 272 273 if (-e "$testdir/$server/named.notcp") { 274 $command .= " -T notcp" 275 } 276 277 if ($restart) { 278 $command .= " >>named.run 2>&1 &"; 279 } else { 280 $command .= " >named.run 2>&1 &"; 281 } 282 283 # get the shell to report the pid of the server ($!) 284 $command .= " echo \$!"; 285 286 return $command; 287} 288 289sub start_ns_server { 290 my ( $server, $options ) = @_; 291 292 my $cleanup_files; 293 my $command; 294 my $pid_file; 295 296 $cleanup_files = "{./*.jnl,./*.bk,./*.st,./named.run}"; 297 298 $command = construct_ns_command($server, $options); 299 300 $pid_file = "named.pid"; 301 302 if ($clean) { 303 unlink glob $cleanup_files; 304 } 305 306 start_server($server, $command, $pid_file); 307} 308 309sub construct_ans_command { 310 my ( $server, $options ) = @_; 311 312 my $command; 313 my $n; 314 315 if ($server =~ /^ans(\d+)/) { 316 $n = $1; 317 } else { 318 die "unable to parse server number from name \"$server\"\n"; 319 } 320 321 if (-e "$testdir/$server/ans.py") { 322 $command = "$PYTHON -u ans.py 10.53.0.$n $queryport"; 323 } elsif (-e "$testdir/$server/ans.pl") { 324 $command = "$PERL ans.pl"; 325 } else { 326 $command = "$PERL $topdir/ans.pl 10.53.0.$n"; 327 } 328 329 if ($options) { 330 $command .= $options; 331 } 332 333 if ($restart) { 334 $command .= " >>ans.run 2>&1 &"; 335 } else { 336 $command .= " >ans.run 2>&1 &"; 337 } 338 339 # get the shell to report the pid of the server ($!) 340 $command .= " echo \$!"; 341 342 return $command; 343} 344 345sub start_ans_server { 346 my ( $server, $options ) = @_; 347 348 my $cleanup_files; 349 my $command; 350 my $pid_file; 351 352 $cleanup_files = "{./ans.run}"; 353 $command = construct_ans_command($server, $options); 354 $pid_file = "ans.pid"; 355 356 if ($clean) { 357 unlink glob $cleanup_files; 358 } 359 360 start_server($server, $command, $pid_file); 361} 362 363sub verify_ns_server { 364 my ( $server ) = @_; 365 366 my $tries = 0; 367 368 my $runfile = "$testdir/$server/named.run"; 369 370 while (1) { 371 # the shell *ought* to have created the file immediately, but this 372 # logic allows the creation to be delayed without issues 373 if (open(my $fh, "<", $runfile)) { 374 # the two non-whitespace blobs should be the date and time 375 # but we don't care about them really, only that they are there 376 if (grep /^\S+ \S+ running\R/, <$fh>) { 377 last; 378 } 379 } 380 381 $tries++; 382 383 if ($tries >= 30) { 384 print "I:$test:server $server seems to have not started\n"; 385 print "I:$test:failed\n"; 386 387 system("$PERL $topdir/stop.pl $test"); 388 389 exit 1; 390 } 391 392 sleep 2; 393 } 394 395 $tries = 0; 396 397 my $port = read_ns_port($server); 398 my $tcp = "+tcp"; 399 my $n; 400 401 if ($server =~ /^ns(\d+)/) { 402 $n = $1; 403 } else { 404 die "unable to parse server number from name \"$server\"\n"; 405 } 406 407 if (-e "$testdir/$server/named.notcp") { 408 $tcp = ""; 409 } 410 411 while (1) { 412 my $return = system("$DIG $tcp +noadd +nosea +nostat +noquest +nocomm +nocmd +noedns -p $port version.bind. chaos txt \@10.53.0.$n > /dev/null"); 413 414 last if ($return == 0); 415 416 $tries++; 417 418 if ($tries >= 30) { 419 print "I:$test:no response from $server\n"; 420 print "I:$test:failed\n"; 421 422 system("$PERL $topdir/stop.pl $test"); 423 424 exit 1; 425 } 426 427 sleep 2; 428 } 429} 430