Home | History | Annotate | Line # | Download | only in system
stop.pl revision 1.1.1.1
      1 #!/usr/bin/perl -w
      2 #
      3 # Copyright (C) Internet Systems Consortium, Inc. ("ISC")
      4 #
      5 # This Source Code Form is subject to the terms of the Mozilla Public
      6 # License, v. 2.0. If a copy of the MPL was not distributed with this
      7 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
      8 #
      9 # See the COPYRIGHT file distributed with this work for additional
     10 # information regarding copyright ownership.
     11 
     12 # Framework for stopping test servers
     13 # Based on the type of server specified, signal the server to stop, wait
     14 # briefly for it to die, and then kill it if it is still alive.
     15 # If a server is specified, stop it. Otherwise, stop all servers for test.
     16 
     17 use strict;
     18 use Cwd 'abs_path';
     19 use Getopt::Long;
     20 
     21 # Usage:
     22 #   perl stop.pl [--use-rndc [--port port]] test [server]
     23 #
     24 #   --use-rndc      Attempt to stop the server via the "rndc stop" command.
     25 #
     26 #   --port port     Only relevant if --use-rndc is specified, this sets the
     27 #                   command port over which the attempt should be made.  If
     28 #                   not specified, port 9953 is used.
     29 #
     30 #   test            Name of the test directory.
     31 #
     32 #   server          Name of the server directory.
     33 
     34 my $usage = "usage: $0 [--use-rndc [--port port]] test-directory [server-directory]";
     35 
     36 my $use_rndc = 0;
     37 my $port = 9953;
     38 GetOptions('use-rndc' => \$use_rndc, 'port=i' => \$port) or die "$usage\n";
     39 
     40 my $errors = 0;
     41 
     42 my $test = $ARGV[0];
     43 my $server = $ARGV[1];
     44 die "$usage\n" unless defined($test);
     45 die "No test directory: \"$test\"\n" unless (-d $test);
     46 die "No server directory: \"$server\"\n" if (defined($server) && !-d "$test/$server");
     47 
     48 # Global variables
     49 my $testdir = abs_path($test);
     50 my @servers;
     51 
     52 
     53 # Determine which servers need to be stopped.
     54 if (defined $server) {
     55 	@servers = ($server);
     56 } else {
     57 	local *DIR;
     58 	opendir DIR, $testdir or die "$testdir: $!\n";
     59 	my @files = sort readdir DIR;
     60 	closedir DIR;
     61 
     62 	my @ns = grep /^ns[0-9]*$/, @files;
     63 	my @ans = grep /^ans[0-9]*$/, @files;
     64 	
     65 	push @servers, @ns, @ans;
     66 }
     67 
     68 
     69 # Stop the server(s), pass 1: rndc.
     70 if ($use_rndc) {
     71 	foreach my $server (grep /^ns/, @servers) {
     72 		stop_rndc($server);
     73 	}
     74 
     75 	wait_for_servers(30, grep /^ns/, @servers);
     76 }
     77 
     78 
     79 # Pass 2: SIGTERM
     80 foreach my $server (@servers) {
     81 	stop_signal($server, "TERM");
     82 }
     83 
     84 wait_for_servers(60, @servers);
     85 
     86 # Pass 3: SIGABRT
     87 foreach my $server (@servers) {
     88 	stop_signal($server, "ABRT");
     89 }
     90 
     91 exit($errors ? 1 : 0);
     92 
     93 # Subroutines
     94 
     95 # Return the full path to a given server's PID file.
     96 sub server_pid_file {
     97 	my($server) = @_;
     98 
     99 	my $pid_file;
    100 	if ($server =~ /^ns/) {
    101 		$pid_file = "named.pid";
    102 	} elsif ($server =~ /^ans/) {
    103 		$pid_file = "ans.pid";
    104 	} else {
    105 		print "I:Unknown server type $server\n";
    106 		exit 1;
    107 	}
    108 	$pid_file = "$testdir/$server/$pid_file";
    109 }
    110 
    111 # Read a PID.
    112 sub read_pid {
    113 	my($pid_file) = @_;
    114 
    115 	local *FH;
    116 	my $result = open FH, "< $pid_file";
    117 	if (!$result) {
    118 		print "I:$pid_file: $!\n";
    119 		unlink $pid_file;
    120 		return;
    121 	}
    122 
    123 	my $pid = <FH>;
    124 	chomp($pid);
    125 	return $pid;
    126 }
    127 
    128 # Stop a named process with rndc.
    129 sub stop_rndc {
    130 	my($server) = @_;
    131 
    132 	return unless ($server =~ /^ns(\d+)$/);
    133 	my $ip = "10.53.0.$1";
    134 
    135 	# Ugly, but should work.
    136 	system("$ENV{RNDC} -c ../common/rndc.conf -s $ip -p $port stop | sed 's/^/I:$server /'");
    137 	return;
    138 }
    139 
    140 # Stop a server by sending a signal to it.
    141 sub stop_signal {
    142 	my($server, $sig) = @_;
    143 
    144 	my $pid_file = server_pid_file($server);
    145 	return unless -f $pid_file;
    146 	
    147 	my $pid = read_pid($pid_file);
    148 	return unless defined($pid);
    149 
    150 	if ($sig eq 'ABRT') {
    151 		print "I:$server didn't die when sent a SIGTERM\n";
    152 		$errors++;
    153 	}
    154 
    155 	my $result;
    156 	if ($^O eq 'cygwin') {
    157 		$result = system("/bin/kill -f -$sig $pid");
    158 		unlink $pid_file;
    159 		if ($result != 0) {
    160 			print "I:$server died before a SIG$sig was sent\n";
    161 			$errors++;
    162 		}
    163 	} else {
    164 		$result = kill $sig, $pid;
    165 		if (!$result) {
    166 			print "I:$server died before a SIG$sig was sent\n";
    167 			unlink $pid_file;
    168 			$errors++;
    169 		}
    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 }
    189