1#!/usr/bin/perl -w
2#
3# Copyright (C) 2004-2008, 2010-2012  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$
19
20# Framework for starting test servers.
21# Based on the type of server specified, check for port availability, remove
22# temporary files, start the server, and verify that the server is running.
23# If a server is specified, start it. Otherwise, start all servers for test.
24
25use strict;
26use Cwd;
27use Cwd 'abs_path';
28use Getopt::Long;
29
30# Option handling
31#   --noclean test [server [options]]
32#
33#   --noclean - Do not cleanup files in server directory
34#   test - name of the test directory
35#   server - name of the server directory
36#   options - alternate options for the server
37#             NOTE: options must be specified with '-- "<option list>"',
38#              for instance: start.pl . ns1 -- "-c n.conf -d 43"
39#             ALSO NOTE: this variable will be filled with the
40#		contents of the first non-commented/non-blank line of args
41#		in a file called "named.args" in an ns*/ subdirectory only
42#		the FIRST non-commented/non-blank line is used (everything
43#		else in the file is ignored. If "options" is already set,
44#		then "named.args" is ignored.
45
46my $usage = "usage: $0 [--noclean] [--restart] test-directory [server-directory [server-options]]";
47my $noclean = '';
48my $restart = '';
49GetOptions('noclean' => \$noclean, 'restart' => \$restart);
50my $test = $ARGV[0];
51my $server = $ARGV[1];
52my $options = $ARGV[2];
53
54if (!$test) {
55	print "$usage\n";
56}
57if (!-d $test) {
58	print "No test directory: \"$test\"\n";
59}
60if ($server && !-d "$test/$server") {
61	print "No server directory: \"$test/$server\"\n";
62}
63
64# Global variables
65my $topdir = abs_path("$test/..");
66my $testdir = abs_path("$test");
67my $NAMED = $ENV{'NAMED'};
68my $LWRESD = $ENV{'LWRESD'};
69my $DIG = $ENV{'DIG'};
70my $PERL = $ENV{'PERL'};
71
72# Start the server(s)
73
74if ($server) {
75	if ($server =~ /^ns/) {
76		&check_ports($server);
77	}
78	&start_server($server, $options);
79	if ($server =~ /^ns/) {
80		&verify_server($server);
81	}
82} else {
83	# Determine which servers need to be started for this test.
84	opendir DIR, $testdir;
85	my @files = sort readdir DIR;
86	closedir DIR;
87
88	my @ns = grep /^ns[0-9]*$/, @files;
89	my @lwresd = grep /^lwresd[0-9]*$/, @files;
90	my @ans = grep /^ans[0-9]*$/, @files;
91	my $name;
92
93	# Start the servers we found.
94	&check_ports();
95	foreach $name(@ns, @lwresd, @ans) {
96		&start_server($name);
97		&verify_server($name) if ($name =~ /^ns/);
98
99	}
100}
101
102# Subroutines
103
104sub check_ports {
105	my $server = shift;
106	my $options = "";
107
108	if ($server && $server =~ /(\d+)$/) {
109		$options = "-i $1";
110	}
111
112	my $tries = 0;
113	while (1) {
114		my $return = system("$PERL $topdir/testsock.pl -p 5300 $options");
115		last if ($return == 0);
116		if (++$tries > 4) {
117			print "$0: could not bind to server addresses, still running?\n";
118			print "I:server sockets not available\n";
119			print "R:FAIL\n";
120			system("$PERL $topdir/stop.pl $testdir"); # Is this the correct behavior?
121			exit 1;
122		}
123		print "I:Couldn't bind to socket (yet)\n";
124		sleep 2;
125	}
126}
127
128sub start_server {
129	my $server = shift;
130	my $options = shift;
131
132	my $cleanup_files;
133	my $command;
134	my $pid_file;
135        my $cwd = getcwd();
136	my $args_file = $cwd . "/" . $test . "/" . $server . "/" . "named.args";
137
138	if ($server =~ /^ns/) {
139		$cleanup_files = "{*.jnl,*.bk,*.st,named.run}";
140		$command = "$NAMED ";
141		if ($options) {
142			$command .= "$options";
143		} elsif (-e $args_file) {
144			open(FH, "<", $args_file);
145			while(my $line=<FH>)
146			{
147				#$line =~ s/\R//g;
148				chomp $line;
149				next if ($line =~ /^\s*$/); #discard blank lines
150				next if ($line =~ /^\s*#/); #discard comment lines
151				$line =~ s/#.*$//g;
152				$options = $line;
153				last;
154			}
155			close FH;
156			$command .= "$options";
157		} else {
158			$command .= "-m record,size,mctx ";
159			$command .= "-T clienttest ";
160			$command .= "-T nosoa "
161				if (-e "$testdir/$server/named.nosoa");
162			$command .= "-T noaa "
163				if (-e "$testdir/$server/named.noaa");
164			$command .= "-c named.conf -d 99 -g";
165		}
166		if ($restart) {
167			$command .= " >>named.run 2>&1 &";
168		} else {
169			$command .= " >named.run 2>&1 &";
170		}
171		$pid_file = "named.pid";
172	} elsif ($server =~ /^lwresd/) {
173		$cleanup_files = "{lwresd.run}";
174		$command = "$LWRESD ";
175		if ($options) {
176			$command .= "$options";
177		} else {
178			$command .= "-m record,size,mctx ";
179			$command .= "-T clienttest ";
180			$command .= "-C resolv.conf -d 99 -g ";
181			$command .= "-i lwresd.pid -P 9210 -p 5300";
182		}
183		if ($restart) {
184			$command .= " >>lwresd.run 2>&1 &";
185		} else {
186			$command .= " >lwresd.run 2>&1 &";
187		}
188		$pid_file = "lwresd.pid";
189	} elsif ($server =~ /^ans/) {
190		$cleanup_files = "{ans.run}";
191                if (-e "$testdir/$server/ans.pl") {
192                        $command = "$PERL ans.pl";
193                } else {
194                        $command = "$PERL $topdir/ans.pl 10.53.0.$'";
195                }
196		if ($options) {
197			$command .= "$options";
198		} else {
199			$command .= "";
200		}
201		if ($restart) {
202			$command .= " >>ans.run 2>&1 &";
203		} else {
204			$command .= " >ans.run 2>&1 &";
205		}
206		$pid_file = "ans.pid";
207	} else {
208		print "I:Unknown server type $server\n";
209		print "R:FAIL\n";
210		system "$PERL $topdir/stop.pl $testdir";
211		exit 1;
212	}
213
214	# print "I:starting server %s\n",$server;
215
216	chdir "$testdir/$server";
217
218	unless ($noclean) {
219		unlink glob $cleanup_files;
220	}
221
222	# get the shell to report the pid of the server ($!)
223	$command .= "echo \$!";
224
225	# start the server
226	my $child = `$command`;
227	chomp($child);
228
229	# wait up to 14 seconds for the server to start and to write the
230	# pid file otherwise kill this server and any others that have
231	# already been started
232	my $tries = 0;
233	while (!-s $pid_file) {
234		if (++$tries > 140) {
235			print "I:Couldn't start server $server (pid=$child)\n";
236			print "R:FAIL\n";
237			system "kill -9 $child" if ("$child" ne "");
238			system "$PERL $topdir/stop.pl $testdir";
239			exit 1;
240		}
241		# sleep for 0.1 seconds
242		select undef,undef,undef,0.1;
243	}
244
245        # go back to the top level directory
246	chdir $cwd;
247}
248
249sub verify_server {
250	my $server = shift;
251	my $n = $server;
252	$n =~ s/^ns//;
253
254	my $tries = 0;
255	while (1) {
256		my $return = system("$DIG +tcp +noadd +nosea +nostat +noquest +nocomm +nocmd -p 5300 version.bind. chaos txt \@10.53.0.$n > dig.out");
257		last if ($return == 0);
258		if (++$tries >= 30) {
259			print `grep ";" dig.out > /dev/null`;
260			print "I:no response from $server\n";
261			print "R:FAIL\n";
262			system("$PERL $topdir/stop.pl $testdir");
263			exit 1;
264		}
265		sleep 2;
266	}
267	unlink "dig.out";
268}
269