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

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright (C) 2004-2007  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: stop.pl,v 1.12 2007/06/19 23:47:00 tbox Exp
  19
  20 # Framework for stopping test servers
  21 # Based on the type of server specified, signal the server to stop, wait
  22 # briefly for it to die, and then kill it if it is still alive.
  23 # If a server is specified, stop it. Otherwise, stop all servers for test.
  24
  25 use strict;
  26 use Cwd 'abs_path';
  27
  28 # Option handling
  29 #   [--use-rndc] test [server]
  30 #
  31 #   test - name of the test directory
  32 #   server - name of the server directory
  33
  34 my $usage = "usage: $0 [--use-rndc] test-directory [server-directory]";
  35 my $use_rndc;
  36
  37 while (@ARGV && $ARGV[0] =~ /^-/) {
  38         my $opt = shift @ARGV;
  39         if ($opt eq '--use-rndc') {
  40                 $use_rndc = 1;
  41         } else {
  42                 die "$usage\n";
  43         }
  44 }
  45
  46 my $test = $ARGV[0];
  47 my $server = $ARGV[1];
  48
  49 my $errors = 0;
  50
  51 die "$usage\n" unless defined($test);
  52 die "No test directory: \"$test\"\n" unless (-d $test);
  53 die "No server directory: \"$server\"\n" if (defined($server) && !-d "$test/$server");
  54
  55 # Global variables
  56 my $testdir = abs_path($test);
  57 my @servers;
  58
  59
  60 # Determine which servers need to be stopped.
  61 if (defined $server) {
  62         @servers = ($server);
  63 } else {
  64         local *DIR;
  65         opendir DIR, $testdir or die "$testdir: $!\n";
  66         my @files = sort readdir DIR;
  67         closedir DIR;
  68
  69         my @ns = grep /^ns[0-9]*$/, @files;
  70         my @lwresd = grep /^lwresd[0-9]*$/, @files;
  71         my @ans = grep /^ans[0-9]*$/, @files;
  72
  73         push @servers, @ns, @lwresd, @ans;
  74 }
  75
  76
  77 # Stop the server(s), pass 1: rndc.
  78 if ($use_rndc) {
  79         foreach my $server (grep /^ns/, @servers) {
  80                 stop_rndc($server);
  81         }
  82
  83         wait_for_servers(30, grep /^ns/, @servers);
  84 }
  85
  86
  87 # Pass 2: SIGTERM
  88 foreach my $server (@servers) {
  89         stop_signal($server, "TERM");
  90 }
  91
  92 wait_for_servers(60, @servers);
  93
  94 # Pass 3: SIGABRT
  95 foreach my $server (@servers) {
  96         stop_signal($server, "ABRT");
  97 }
  98
  99 exit($errors ? 1 : 0);
 100
 101 # Subroutines
 102
 103 # Return the full path to a given server's PID file.
 104 sub server_pid_file {
 105         my($server) = @_;
 106
 107         my $pid_file;
 108         if ($server =~ /^ns/) {
 109                 $pid_file = "named.pid";
 110         } elsif ($server =~ /^lwresd/) {
 111                 $pid_file = "lwresd.pid";
 112         } elsif ($server =~ /^ans/) {
 113                 $pid_file = "ans.pid";
 114         } else {
 115                 print "I:Unknown server type $server\n";
 116                 exit 1;
 117         }
 118         $pid_file = "$testdir/$server/$pid_file";
 119 }
 120
 121 # Read a PID.
 122 sub read_pid {
 123         my($pid_file) = @_;
 124
 125         local *FH;
 126         my $result = open FH, "< $pid_file";
 127         if (!$result) {
 128                 print "I:$pid_file: $!\n";
 129                 unlink $pid_file;
 130                 return;
 131         }
 132
 133         my $pid = <FH>;
 134         chomp($pid);
 135         return $pid;
 136 }
 137
 138 # Stop a named process with rndc.
 139 sub stop_rndc {
 140         my($server) = @_;
 141
 142         return unless ($server =~ /^ns(\d+)$/);
 143         my $ip = "10.53.0.$1";
 144
 145         # Ugly, but should work.
 146         system("$ENV{RNDC} -c $testdir/../common/rndc.conf -s $ip -p 9953 stop | sed 's/^/I:$server /'");
 147         return;
 148 }
 149
 150 # Stop a server by sending a signal to it.
 151 sub stop_signal {
 152         my($server, $sig) = @_;
 153
 154         my $pid_file = server_pid_file($server);
 155         return unless -f $pid_file;
 156
 157         my $pid = read_pid($pid_file);
 158         return unless defined($pid);
 159
 160         if ($sig eq 'ABRT') {
 161                 print "I:$server didn't die when sent a SIGTERM\n";
 162                 $errors++;
 163         }
 164
 165         my $result = kill $sig, $pid;
 166         if (!$result) {
 167                 print "I:$server died before a SIG$sig was sent\n";
 168                 unlink $pid_file;
 169                 $errors++;
 170         }
 171
 172         return;
 173 }
 174
 175 sub wait_for_servers {
 176         my($timeout, @servers) = @_;
 177
 178         my @pid_files = grep { defined($_) }
 179                         map  { server_pid_file($_) } @servers;
 180
 181         while ($timeout > 0 && @pid_files > 0) {
 182                 @pid_files = grep { -f $_ } @pid_files;
 183                 sleep 1 if (@pid_files > 0);
 184                 $timeout--;
 185         }
 186
 187         return;
 188 }