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 https://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
17use strict;
18use warnings;
19
20use Cwd ':DEFAULT', 'abs_path';
21use English '-no_match_vars';
22use Getopt::Long;
23
24# Usage:
25#   perl stop.pl [--use-rndc [--port port]] test [server]
26#
27#   --use-rndc      Attempt to stop the server via the "rndc stop" command.
28#
29#   --port port     Only relevant if --use-rndc is specified, this sets the
30#                   command port over which the attempt should be made.  If
31#                   not specified, port 9953 is used.
32#
33#   test            Name of the test directory.
34#
35#   server          Name of the server directory.
36
37my $usage = "usage: $0 [--use-rndc [--halt] [--port port]] test-directory [server-directory]";
38
39my $use_rndc = 0;
40my $halt = 0;
41my $rndc_port = 9953;
42my $errors = 0;
43
44GetOptions(
45	'use-rndc!' => \$use_rndc,
46	'halt!' => \$halt,
47	'port=i' => \$rndc_port
48    ) or die "$usage\n";
49
50my ( $test, $server_arg ) = @ARGV;
51
52if (!$test) {
53	die "$usage\n";
54}
55
56# Global variables
57my $topdir = abs_path($ENV{'SYSTEMTESTTOP'});
58my $testdir = abs_path($topdir . "/" . $test);
59
60if (! -d $testdir) {
61	die "No test directory: \"$testdir\"\n";
62}
63
64if ($server_arg && ! -d "$testdir/$server_arg") {
65	die "No server directory: \"$testdir/$server_arg\"\n";
66}
67
68my $RNDC = $ENV{RNDC};
69
70my @ns;
71my @ans;
72my @lwresd;
73
74if ($server_arg) {
75	if ($server_arg =~ /^ns/) {
76		push(@ns, $server_arg);
77	} elsif ($server_arg =~ /^ans/) {
78		push(@ans, $server_arg);
79	} elsif ($server_arg =~ /^lwresd/) {
80		push(@lwresd, $server_arg);
81	} else {
82		print "$0: ns or ans directory expected";
83		print "I:$test:failed";
84	}
85} else {
86	# Determine which servers need to be stopped for this test.
87	opendir DIR, $testdir or die "unable to read test directory: \"$test\" ($OS_ERROR)\n";
88	my @files = sort readdir DIR;
89	closedir DIR;
90
91	@ns = grep /^ns[0-9]*$/, @files;
92	@ans = grep /^ans[0-9]*$/, @files;
93	@lwresd = grep /^lwresd[0-9]*$/, @files;
94}
95
96# Stop the server(s), pass 1: rndc.
97if ($use_rndc) {
98	foreach my $name(@ns) {
99		stop_rndc($name, $rndc_port);
100	}
101
102	@ns = wait_for_servers(30, @ns);
103}
104
105# Pass 2: SIGTERM
106foreach my $name (@ns) {
107	stop_signal($name, "TERM");
108}
109
110@ns = wait_for_servers(60, @ns);
111
112foreach my $name(@ans) {
113	stop_signal($name, "TERM", 1);
114}
115
116@ans = wait_for_servers(60, @ans);
117
118foreach my $name(@lwresd) {
119	stop_signal($name, "TERM");
120}
121
122@lwresd = wait_for_servers(60, @lwresd);
123
124# Pass 3: SIGABRT
125foreach my $name (@ns, @lwresd) {
126	print "I:$test:$name didn't die when sent a SIGTERM\n";
127	stop_signal($name, "ABRT");
128	$errors = 1;
129}
130foreach my $name (@ans) {
131	print "I:$test:$name didn't die when sent a SIGTERM\n";
132	stop_signal($name, "ABRT", 1);
133	$errors = 1;
134}
135
136exit($errors);
137
138# Subroutines
139
140# Return the full path to a given server's lock file.
141sub server_lock_file {
142	my ( $server ) = @_;
143
144	return if (defined($ENV{'CYGWIN'}));
145
146	return $testdir . "/" . $server . "/named.lock" if ($server =~ /^ns/);
147	return if ($server =~ /^ans/);
148	return $testdir . "/" . $server . "/lwresd.lock" if ($server =~ /^lwresd/);
149
150	die "Unknown server type $server\n";
151}
152
153# Return the full path to a given server's PID file.
154sub server_pid_file {
155	my ( $server ) = @_;
156
157	return $testdir . "/" . $server . "/named.pid" if ($server =~ /^ns/);
158	return $testdir . "/" . $server . "/ans.pid" if ($server =~ /^ans/);
159	return $testdir . "/" . $server . "/lwresd.pid" if ($server =~ /^lwresd/);
160
161	die "Unknown server type $server\n";
162}
163
164# Read a PID.
165sub read_pid {
166	my ( $pid_file ) = @_;
167
168	return unless -f $pid_file;
169	# we don't really care about the race condition here
170	my $result = open(my $fh, "<", $pid_file);
171	if (!defined($result)) {
172		print "I:$test:$pid_file: $!\n";
173		unlink $pid_file;
174		return;
175	}
176
177	my $pid = <$fh>;
178	return unless defined($pid);
179
180	chomp($pid);
181	return $pid;
182}
183
184# Stop a named process with rndc.
185sub stop_rndc {
186	my ( $server, $port ) = @_;
187	my $n;
188
189	if ($server =~ /^ns(\d+)/) {
190		$n = $1;
191	} else {
192		die "unable to parse server number from name \"$server\"\n";
193	}
194
195	my $ip = "10.53.0.$n";
196	my $how = $halt ? "halt" : "stop";
197
198	# Ugly, but should work.
199	system("$RNDC -c ../common/rndc.conf -s $ip -p $port $how | sed 's/^/I:$test:$server /'");
200	return;
201}
202
203sub server_died {
204	my ( $server, $signal ) = @_;
205
206	print "I:$test:$server died before a SIG$signal was sent\n";
207	$errors = 1;
208
209	my $pid_file = server_pid_file($server);
210	unlink($pid_file);
211
212	return;
213}
214
215sub send_signal {
216	my ( $signal, $pid, $ans ) = @_;
217
218	if (! defined $ans) {
219		$ans = 0;
220	}
221
222	my $result = 0;
223
224	if (!$ans && ($^O eq 'cygwin' || $^O eq 'msys')) {
225		my $killout = `/bin/kill -f -$signal $pid 2>&1`;
226		chomp($killout);
227		$result = 1 if ($killout eq '');
228	} else {
229		$result = kill $signal, $pid;
230	}
231	return $result;
232}
233
234# Stop a server by sending a signal to it.
235sub stop_signal {
236	my ( $server, $signal, $ans ) = @_;
237	if (! defined $ans) {
238		$ans = 0;
239	}
240
241	my $pid_file = server_pid_file($server);
242	my $pid = read_pid($pid_file);
243
244	return unless defined($pid);
245
246	# Send signal to the server, and bail out if signal can't be sent
247	if (send_signal($signal, $pid, $ans) != 1) {
248		server_died($server, $signal);
249		return;
250	}
251
252	return;
253}
254
255sub pid_file_exists {
256	my ( $server ) = @_;
257
258	my $pid_file = server_pid_file($server);
259	my $pid = read_pid($pid_file);
260
261	return unless defined($pid);
262
263	# If we're here, the PID file hasn't been cleaned up yet
264	if (send_signal(0, $pid) == 0) {
265		# XXX: on windows this is likely to result in a
266		# false positive, so don't bother reporting the error.
267		if (!defined($ENV{'CYGWIN'})) {
268			print "I:$test:$server crashed on shutdown\n";
269			$errors = 1;
270		}
271		return;
272	}
273
274	return $server;
275}
276
277sub lock_file_exists {
278	my ( $server ) = @_;
279	my $lock_file = server_lock_file($server);
280
281	return unless defined($lock_file) && -f $lock_file;
282
283	return $server;
284}
285
286sub wait_for_servers {
287	my ( $timeout, @servers ) = @_;
288
289	while ($timeout > 0 && @servers > 0) {
290		sleep 1 if (@servers > 0);
291		@servers =
292			grep { defined($_) }
293			map  { pid_file_exists($_) || lock_file_exists($_) } @servers;
294		$timeout--;
295	}
296
297	return @servers;
298}
299