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