1#!/usr/bin/perl -w 2# 3# Copyright (C) 2004-2008, 2010-2014 Internet Systems Consortium, Inc. ("ISC") 4# Copyright (C) 2001 Internet Software Consortium. 5# 6# Permission to use, copy, modify, and/or distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND ISC DISCLAIMS ALL WARRANTIES WITH 11# REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY 12# AND FITNESS. IN NO EVENT SHALL ISC BE LIABLE FOR ANY SPECIAL, DIRECT, 13# INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 14# LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE 15# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 16# PERFORMANCE OF THIS SOFTWARE. 17 18# Id: start.pl,v 1.30 2012/02/06 23:46:44 tbox Exp 19 20# Framework for starting test servers. 21# Based on the type of server specified, check for port availability, remove 22# temporary files, start the server, and verify that the server is running. 23# If a server is specified, start it. Otherwise, start all servers for test. 24 25use strict; 26use Cwd; 27use Cwd 'abs_path'; 28use Getopt::Long; 29 30# Option handling 31# --noclean test [server [options]] 32# 33# --noclean - Do not cleanup files in server directory 34# test - name of the test directory 35# server - name of the server directory 36# options - alternate options for the server 37# NOTE: options must be specified with '-- "<option list>"', 38# for instance: start.pl . ns1 -- "-c n.conf -d 43" 39# ALSO NOTE: this variable will be filled with the 40# contents of the first non-commented/non-blank line of args 41# in a file called "named.args" in an ns*/ subdirectory only 42# the FIRST non-commented/non-blank line is used (everything 43# else in the file is ignored. If "options" is already set, 44# then "named.args" is ignored. 45 46my $usage = "usage: $0 [--noclean] [--restart] test-directory [server-directory [server-options]]"; 47my $noclean = ''; 48my $restart = ''; 49GetOptions('noclean' => \$noclean, 'restart' => \$restart); 50my $test = $ARGV[0]; 51my $server = $ARGV[1]; 52my $options = $ARGV[2]; 53 54if (!$test) { 55 print "$usage\n"; 56} 57if (!-d $test) { 58 print "No test directory: \"$test\"\n"; 59} 60if ($server && !-d "$test/$server") { 61 print "No server directory: \"$test/$server\"\n"; 62} 63 64# Global variables 65my $topdir = abs_path("$test/.."); 66my $testdir = abs_path("$test"); 67my $NAMED = $ENV{'NAMED'}; 68my $LWRESD = $ENV{'LWRESD'}; 69my $DIG = $ENV{'DIG'}; 70my $PERL = $ENV{'PERL'}; 71 72# Start the server(s) 73 74if ($server) { 75 if ($server =~ /^ns/) { 76 &check_ports($server); 77 } 78 &start_server($server, $options); 79 if ($server =~ /^ns/) { 80 &verify_server($server); 81 } 82} else { 83 # Determine which servers need to be started for this test. 84 opendir DIR, $testdir; 85 my @files = sort readdir DIR; 86 closedir DIR; 87 88 my @ns = grep /^ns[0-9]*$/, @files; 89 my @lwresd = grep /^lwresd[0-9]*$/, @files; 90 my @ans = grep /^ans[0-9]*$/, @files; 91 my $name; 92 93 # Start the servers we found. 94 &check_ports(); 95 foreach $name(@ns, @lwresd, @ans) { 96 &start_server($name); 97 &verify_server($name) if ($name =~ /^ns/); 98 99 } 100} 101 102# Subroutines 103 104sub check_ports { 105 my $server = shift; 106 my $options = ""; 107 my $port = 5300; 108 my $file = ""; 109 110 $file = $testdir . "/" . $server . "/named.port" if ($server); 111 112 if ($server && $server =~ /(\d+)$/) { 113 $options = "-i $1"; 114 } 115 116 if ($file ne "" && -e $file) { 117 open(FH, "<", $file); 118 while(my $line=<FH>) { 119 chomp $line; 120 $port = $line; 121 last; 122 } 123 close FH; 124 } 125 126 my $tries = 0; 127 while (1) { 128 my $return = system("$PERL $topdir/testsock.pl -p $port $options"); 129 last if ($return == 0); 130 if (++$tries > 4) { 131 print "$0: could not bind to server addresses, still running?\n"; 132 print "I:server sockets not available\n"; 133 print "R:FAIL\n"; 134 system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior? 135 exit 1; 136 } 137 print "I:Couldn't bind to socket (yet)\n"; 138 sleep 2; 139 } 140} 141 142sub start_server { 143 my $server = shift; 144 my $options = shift; 145 146 my $cleanup_files; 147 my $command; 148 my $pid_file; 149 my $cwd = getcwd(); 150 my $args_file = $cwd . "/" . $test . "/" . $server . "/" . "named.args"; 151 152 if ($server =~ /^ns/) { 153 $cleanup_files = "{*.jnl,*.bk,*.st,named.run}"; 154 $command = "$NAMED "; 155 if ($options) { 156 $command .= "$options"; 157 } elsif (-e $args_file) { 158 open(FH, "<", $args_file); 159 while(my $line=<FH>) 160 { 161 #$line =~ s/\R//g; 162 chomp $line; 163 next if ($line =~ /^\s*$/); #discard blank lines 164 next if ($line =~ /^\s*#/); #discard comment lines 165 $line =~ s/#.*$//g; 166 $options = $line; 167 last; 168 } 169 close FH; 170 $command .= "$options"; 171 } else { 172 $command .= "-D $server "; 173 $command .= "-m record,size,mctx "; 174 $command .= "-T clienttest "; 175 $command .= "-T nosoa " 176 if (-e "$testdir/$server/named.nosoa"); 177 $command .= "-T noaa " 178 if (-e "$testdir/$server/named.noaa"); 179 $command .= "-T noedns " 180 if (-e "$testdir/$server/named.noedns"); 181 $command .= "-T dropedns " 182 if (-e "$testdir/$server/named.dropedns"); 183 $command .= "-T maxudp512 " 184 if (-e "$testdir/$server/named.maxudp512"); 185 $command .= "-T maxudp1460 " 186 if (-e "$testdir/$server/named.maxudp1460"); 187 $command .= "-c named.conf -d 99 -g -U 4"; 188 } 189 $command .= " -T notcp" 190 if (-e "$testdir/$server/named.notcp"); 191 if ($restart) { 192 $command .= " >>named.run 2>&1 &"; 193 } else { 194 $command .= " >named.run 2>&1 &"; 195 } 196 $pid_file = "named.pid"; 197 } elsif ($server =~ /^lwresd/) { 198 $cleanup_files = "{lwresd.run}"; 199 $command = "$LWRESD "; 200 if ($options) { 201 $command .= "$options"; 202 } else { 203 $command .= "-m record,size,mctx "; 204 $command .= "-T clienttest "; 205 $command .= "-C resolv.conf -d 99 -g -U 4 "; 206 $command .= "-i lwresd.pid -P 9210 -p 5300"; 207 } 208 if ($restart) { 209 $command .= " >>lwresd.run 2>&1 &"; 210 } else { 211 $command .= " >lwresd.run 2>&1 &"; 212 } 213 $pid_file = "lwresd.pid"; 214 } elsif ($server =~ /^ans/) { 215 $cleanup_files = "{ans.run}"; 216 if (-e "$testdir/$server/ans.pl") { 217 $command = "$PERL ans.pl"; 218 } else { 219 $command = "$PERL $topdir/ans.pl 10.53.0.$'"; 220 } 221 if ($options) { 222 $command .= "$options"; 223 } else { 224 $command .= ""; 225 } 226 if ($restart) { 227 $command .= " >>ans.run 2>&1 &"; 228 } else { 229 $command .= " >ans.run 2>&1 &"; 230 } 231 $pid_file = "ans.pid"; 232 } else { 233 print "I:Unknown server type $server\n"; 234 print "R:FAIL\n"; 235 system "$PERL $topdir/stop.pl $testdir"; 236 exit 1; 237 } 238 239 # print "I:starting server %s\n",$server; 240 241 chdir "$testdir/$server"; 242 243 unless ($noclean) { 244 unlink glob $cleanup_files; 245 } 246 247 # get the shell to report the pid of the server ($!) 248 $command .= "echo \$!"; 249 250 # start the server 251 my $child = `$command`; 252 $child =~ s/\s+$//g; 253 254 # wait up to 14 seconds for the server to start and to write the 255 # pid file otherwise kill this server and any others that have 256 # already been started 257 my $tries = 0; 258 while (!-s $pid_file) { 259 if (++$tries > 140) { 260 print "I:Couldn't start server $server (pid=$child)\n"; 261 print "R:FAIL\n"; 262 system "kill -9 $child" if ("$child" ne ""); 263 system "$PERL $topdir/stop.pl $testdir"; 264 exit 1; 265 } 266 # sleep for 0.1 seconds 267 select undef,undef,undef,0.1; 268 } 269 270 # go back to the top level directory 271 chdir $cwd; 272} 273 274sub verify_server { 275 my $server = shift; 276 my $n = $server; 277 my $port = 5300; 278 my $tcp = "+tcp"; 279 280 $n =~ s/^ns//; 281 282 if (-e "$testdir/$server/named.port") { 283 open(FH, "<", "$testdir/$server/named.port"); 284 while(my $line=<FH>) { 285 chomp $line; 286 $port = $line; 287 last; 288 } 289 close FH; 290 } 291 292 $tcp = "" if (-e "$testdir/$server/named.notcp"); 293 294 my $tries = 0; 295 while (1) { 296 my $return = system("$DIG $tcp +noadd +nosea +nostat +noquest +nocomm +nocmd +noedns -p $port version.bind. chaos txt \@10.53.0.$n > dig.out"); 297 last if ($return == 0); 298 if (++$tries >= 30) { 299 print `grep ";" dig.out > /dev/null`; 300 print "I:no response from $server\n"; 301 print "R:FAIL\n"; 302 system("$PERL $topdir/stop.pl $testdir"); 303 exit 1; 304 } 305 sleep 2; 306 } 307 unlink "dig.out"; 308} 309