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

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright (C) 2004-2008  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.13 2008/01/02 23:47:01 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 'abs_path';
  27 use Getopt::Long;
  28
  29 # Option handling
  30 #   --noclean test [server [options]]
  31 #
  32 #   --noclean - Do not cleanup files in server directory
  33 #   test - name of the test directory
  34 #   server - name of the server directory
  35 #   options - alternate options for the server
  36
  37 my $usage = "usage: $0 [--noclean] test-directory [server-directory [server-options]]";
  38 my $noclean;
  39 GetOptions('noclean' => \$noclean);
  40 my $test = $ARGV[0];
  41 my $server = $ARGV[1];
  42 my $options = $ARGV[2];
  43
  44 if (!$test) {
  45         print "$usage\n";
  46 }
  47 if (!-d $test) {
  48         print "No test directory: \"$test\"\n";
  49 }
  50 if ($server && !-d "$test/$server") {
  51         print "No server directory: \"$test/$server\"\n";
  52 }
  53
  54 # Global variables
  55 my $topdir = abs_path("$test/..");
  56 my $testdir = abs_path("$test");
  57 my $NAMED = $ENV{'NAMED'};
  58 my $LWRESD = $ENV{'LWRESD'};
  59 my $DIG = $ENV{'DIG'};
  60 my $PERL = $ENV{'PERL'};
  61
  62 # Start the server(s)
  63
  64 if ($server) {
  65         if ($server =~ /^ns/) {
  66                 &check_ports($server);
  67         }
  68         &start_server($server, $options);
  69         if ($server =~ /^ns/) {
  70                 &verify_server($server);
  71         }
  72 } else {
  73         # Determine which servers need to be started for this test.
  74         opendir DIR, $testdir;
  75         my @files = sort readdir DIR;
  76         closedir DIR;
  77
  78         my @ns = grep /^ns[0-9]*$/, @files;
  79         my @lwresd = grep /^lwresd[0-9]*$/, @files;
  80         my @ans = grep /^ans[0-9]*$/, @files;
  81
  82         # Start the servers we found.
  83         &check_ports();
  84         foreach (@ns, @lwresd, @ans) {
  85                 &start_server($_);
  86         }
  87         foreach (@ns) {
  88                 &verify_server($_);
  89         }
  90 }
  91
  92 # Subroutines
  93
  94 sub check_ports {
  95         my $server = shift;
  96         my $options = "";
  97
  98         if ($server && $server =~ /(\d+)$/) {
  99                 $options = "-i $1";
 100         }
 101
 102         my $tries = 0;
 103         while (1) {
 104                 my $return = system("$PERL $topdir/testsock.pl -p 5300 $options");
 105                 last if ($return == 0);
 106                 if (++$tries > 4) {
 107                         print "$0: could not bind to server addresses, still running?\n";
 108                         print "I:server sockets not available\n";
 109                         print "R:FAIL\n";
 110                         system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior?
 111                         exit 1;
 112                 }
 113                 print "I:Couldn't bind to socket (yet)\n";
 114                 sleep 2;
 115         }
 116 }
 117
 118 sub start_server {
 119         my $server = shift;
 120         my $options = shift;
 121
 122         my $cleanup_files;
 123         my $command;
 124         my $pid_file;
 125
 126         if ($server =~ /^ns/) {
 127                 $cleanup_files = "{*.jnl,*.bk,*.st,named.run}";
 128                 $command = "$NAMED ";
 129                 if ($options) {
 130                         $command .= "$options";
 131                 } else {
 132                         $command .= "-m record,size,mctx ";
 133                         $command .= "-T clienttest ";
 134                         $command .= "-c named.conf -d 99 -g";
 135                 }
 136                 $command .= " >named.run 2>&1 &";
 137                 $pid_file = "named.pid";
 138         } elsif ($server =~ /^lwresd/) {
 139                 $cleanup_files = "{lwresd.run}";
 140                 $command = "$LWRESD ";
 141                 if ($options) {
 142                         $command .= "$options";
 143                 } else {
 144                         $command .= "-m record,size,mctx ";
 145                         $command .= "-T clienttest ";
 146                         $command .= "-C resolv.conf -d 99 -g ";
 147                         $command .= "-i lwresd.pid -P 9210 -p 5300";
 148                 }
 149                 $command .= " >lwresd.run 2>&1 &";
 150                 $pid_file = "lwresd.pid";
 151         } elsif ($server =~ /^ans/) {
 152                 $cleanup_files = "{ans.run}";
 153                 $command = "$PERL ./ans.pl ";
 154                 if ($options) {
 155                         $command .= "$options";
 156                 } else {
 157                         $command .= "";
 158                 }
 159                 $command .= " >ans.run 2>&1 &";
 160                 $pid_file = "ans.pid";
 161         } else {
 162                 print "I:Unknown server type $server\n";
 163                 print "R:FAIL\n";
 164                 system "$PERL $topdir/stop.pl $testdir";
 165                 exit 1;
 166         }
 167
 168         #               print "I:starting server $server\n";
 169
 170         chdir "$testdir/$server";
 171
 172         unless ($noclean) {
 173                 unlink glob $cleanup_files;
 174         }
 175
 176         system "$command";
 177
 178         my $tries = 0;
 179         while (!-f $pid_file) {
 180                 if (++$tries > 14) {
 181                         print "I:Couldn't start server $server\n";
 182                         print "R:FAIL\n";
 183                         system "$PERL $topdir/stop.pl $testdir";
 184                         exit 1;
 185                 }
 186                 sleep 1;
 187         }
 188 }
 189
 190 sub verify_server {
 191         my $server = shift;
 192         my $n = $server;
 193         $n =~ s/^ns//;
 194
 195         my $tries = 0;
 196         while (1) {
 197                 my $return = system("$DIG +tcp +noadd +nosea +nostat +noquest +nocomm +nocmd -p 5300 version.bind. chaos txt \@10.53.0.$n > dig.out");
 198                 last if ($return == 0);
 199                 print `grep ";" dig.out`;
 200                 if (++$tries >= 30) {
 201                         print "I:no response from $server\n";
 202                         print "R:FAIL\n";
 203                         system("$PERL $topdir/stop.pl $testdir");
 204                         exit 1;
 205                 }
 206                 sleep 2;
 207         }
 208         unlink "dig.out";
 209 }