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