external/bsd/bind/dist/bin/tests/system/start.pl

   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
  25 use strict;
  26 use Cwd;
  27 use Cwd 'abs_path';
  28 use 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
  46 my $usage = "usage: $0 [--noclean] [--restart] test-directory [server-directory [server-options]]";
  47 my $noclean = '';
  48 my $restart = '';
  49 GetOptions('noclean' => \$noclean, 'restart' => \$restart);
  50 my $test = $ARGV[0];
  51 my $server = $ARGV[1];
  52 my $options = $ARGV[2];
  53
  54 if (!$test) {
  55         print "$usage\n";
  56 }
  57 if (!-d $test) {
  58         print "No test directory: \"$test\"\n";
  59 }
  60 if ($server && !-d "$test/$server") {
  61         print "No server directory: \"$test/$server\"\n";
  62 }
  63
  64 # Global variables
  65 my $topdir = abs_path("$test/..");
  66 my $testdir = abs_path("$test");
  67 my $NAMED = $ENV{'NAMED'};
  68 my $LWRESD = $ENV{'LWRESD'};
  69 my $DIG = $ENV{'DIG'};
  70 my $PERL = $ENV{'PERL'};
  71
  72 # Start the server(s)
  73
  74 if ($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
 104 sub 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
 142 sub 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
 274 sub 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 }