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