1: # feed this into perl
2	eval 'exec /usr/local/bin/perl -S $0 "$@"'
3		if $running_under_some_shell;
4
5# $Id: TEST,v 3.0.1.4 2001/03/17 18:14:23 ram Exp ram $
6#
7#  Copyright (c) 1990-2006, Raphael Manfredi
8#
9#  You may redistribute only under the terms of the Artistic License,
10#  as specified in the README file that comes with the distribution.
11#  You may reuse parts of this distribution only within the terms of
12#  that same Artistic License; a copy of which may be found at the root
13#  of the source tree for mailagent 3.0.
14#
15# $Log: TEST,v $
16# Revision 3.0.1.4  2001/03/17 18:14:23  ram
17# patch72: try to run tests as nobody when super-user -- from Debian
18#
19# Revision 3.0.1.3  1995/08/07  16:26:39  ram
20# patch37: added support for locking on filesystems with short filenames
21#
22# Revision 3.0.1.2  1994/09/22  14:40:10  ram
23# patch12: new -m option to monitor agentlog changes via atail
24#
25# Revision 3.0.1.1  1993/12/15  09:04:45  ram
26# patch3: now force . into PATH for msend/nsend
27#
28# Revision 3.0  1993/11/29  13:49:22  ram
29# Baseline for mailagent 3.0 netwide release.
30#
31
32if ($> == 0) {
33	print "Oh, you naughty person. You are superuser!\n";
34	my $uid = (stat('.'))[4];
35	$uid = (getpwnam('nobody'))[2] unless $uid;
36	$uid || die "Cannot run tests as super-user.[$<,$>]\n";
37	$> = $uid;
38	$< = $uid;
39	my $whom = (getpwuid($uid))[0];
40	print "Trying to run as user $whom [$uid]\n";
41}
42
43chop($pwd = `pwd`);
44$ENV{'HOME'} = "$pwd/out";
45chop($host = `(hostname 2>/dev/null || uname -n) 2>/dev/null`);
46$host =~ s/^([^.]*)\..*/$1/;	# Trim domain name
47$ENV{'HOST'} = $host;
48$ENV{'USER'} = 'nobody';	# In case we get mails back from RUN and friends
49$ENV{'PWD'} = $pwd;
50$ENV{'LEVEL'} = 0;			# Default loglvl for filter and cmd tests
51delete $ENV{'ENV'};			# For ksh
52&read_config_sh;			# Load configuration into package cfsh
53$ENV{'LOCKEXT'} = $cfsh'd_flexfnam eq 'define' ? '.lock' : '!';
54
55@tests = ('basic', 'option', 'filter', 'cmd', 'misc');
56$failed = 0;
57$how_many = 0;
58
59require './getopt.pl';
60&Getopt;
61
62$mailagent = 'mailagent';			# Default program (dataloaded version)
63$mailagent = 'magent' if $opt_n;	# Use non-dataloaded version
64$ENV{'MAILAGENT'} = $mailagent;
65$ENV{'PATH'} = "$pwd/..:.:" . $ENV{'PATH'};
66
67-f "../$mailagent" && -x _ || die "No $mailagent.\n";
68-f '../filter/filter' && -x _ || die "No filter.\n";
69$> || die "Cannot run tests as super-user. [$<,$>]\n";
70
71&load_ok;		# Don't rerun successful tests if up to date
72
73# A level file indicates default loglvl
74if (-f 'level') {
75	chop($level = `cat level`);
76	$ENV{'LEVEL'} = int($level);
77}
78
79# Launch atail if -m to monitor the agentlog file
80if ($opt_m) {
81	$atail_pid = fork;
82	unlink 'out/agentlog';
83	if (defined $atail_pid && $atail_pid == 0) {
84		# Child process
85		exec 'perl ./atail';
86		die "TEST: could not launch atail: $!\n";
87	}
88}
89
90unless (-f 'OK') {
91	%Ok = ();
92	`rm -rf out` if -d 'out';
93}
94
95umask 022;		# Ensure none of the files are world writable
96
97`mkdir out` unless -d 'out';
98
99select(STDOUT);
100$| = 1;
101
102# If they specified a list of files, run them and do not update "OK"
103# nor print any summary status.
104
105if (@ARGV) {
106	foreach my $file (@ARGV) {
107		run_file($file);
108		exit(1) if $failed && $opt_s;
109	}
110	exit($failed ? 1 : 0) ;
111}
112
113open(OK, ">>OK");
114select(OK);
115$| = 1;		# We may safely interrupt
116select(STDOUT);
117
118foreach $dir (@tests) {
119	next unless -d $dir;
120	&run($dir);
121}
122
123# Summarize what happened
124
125close OK;
126
127if ($failed == 0) {
128	print "All tests successful.\n";
129} else {
130	print "Failed $how_many test", $how_many == 1 ? '' : 's';
131	print " from $failed file", $failed == 1 ? '' : 's', ".\n";
132}
133
134&clean_up;
135&exit(0);		# End of tests
136
137#
138# Subroutines
139#
140
141sub exit {
142	local($code) = @_;
143	kill(15, $atail_pid) if $atail_pid;
144	exit $code;
145}
146
147sub clean_up {
148	return if $failed || $opt_i;	# -i asks for incrementality
149	unlink 'OK';
150	`rm -rf out` if -d 'out';
151}
152
153sub print {
154	local($dir, $file) = @_;
155	$file =~ s/\.t$//;
156	local($len) = 1 + length($dir) + length($file);
157	print "$dir/$file", '.' x (17 - $len);
158}
159
160sub num { $a <=> $b; }
161
162sub result {
163	local($test, $output) = @_;
164	local($now) = time;
165	local(@res) = split(/\n/, $output);	# Failed test numbers
166	if ($res[0] eq '') {
167		print "FAILED (no test run)\n";
168		++$failed;
169	} elsif ($res[$#res] == 0 && $#res > 0 && $res[$#res -1] == $#res) {
170		print "FAILED (all tests)\n";
171		++$failed;
172		$how_many += $#res;
173	} elsif ($res[0] == 0) {
174		print "ok\n";
175		print OK "$test $now\n";
176	} elsif ($res[0] == -1) {
177		print "untested\n";
178	} else {
179		# Program outputs the number of each test failed, and last must be 0
180		local($last) = pop(@res);
181		push(@res, $last) unless $last == 0;
182		local($n) = @res + 0;
183		local($s) = $n == 1 ? '' : 's';
184		print "FAILED ($n test$s:";
185		@res = sort num @res;
186		print ' ', join(',', @res);
187		print " and aborted" unless $last == 0;
188		print ")\n";
189		++$failed;
190		$how_many += $n;
191	}
192	if ($failed && $opt_s) {	# Stop at first error if -s
193		print "Aborted tests.\n";
194		&exit(0);
195	}
196}
197
198sub run {
199	local($dir) = @_;
200	chdir $dir or die "Cannot chdir to $dir: $!\n";
201	local(@files) = <*.t>;
202	local($test);
203	local($output);
204	foreach $file (@files) {
205		&print($dir, $file);
206		$test = "$dir/$file";
207		if ($Ok{$test} >= ((stat($file))[9])) {	# Check time stamp
208			print "done\n";
209			next;
210		}
211		$output = `perl $file`;
212		&result($test, $output);
213		&basic_failed if $dir eq 'basic' && $failed;
214	}
215	chdir '..' or die "Cannot chdir back to ..: $!\n";
216}
217
218sub run_file {
219	my ($path) = @_;
220	my ($dir, $file) = $path =~ m|^(.*)/(.*)|;
221	my $test = "$dir/$file";
222	unless (-f $test) {
223		warn "WARNING: ignoring missing $path\n";
224		return;
225	}
226	&print($dir, $file);
227	chdir $dir or die "Cannot chdir to $dir: $!\n";
228	$output = `perl $file`;
229	&result($test, $output);
230	chdir $pwd or die "Cannot chdir back to ..: $!\n";
231}
232
233sub basic_failed {
234	print "Failed a basic test, cannot continue.\n";
235	unlink 'OK';
236	&exit(0);
237}
238
239sub load_ok {
240	return unless -f 'OK';
241
242	# Make sure the OK file is up to date, unless -o (outdated)
243	unless ($opt_o) {
244		local($ok_mtime) = (stat('OK'))[9];
245		local($ma_mtime) = (stat("../$mailagent"))[9];
246		local($fi_mtime) = (stat('../filter/filter'))[9];
247		local($restart) = 0;
248		if ($ma_mtime > $ok_mtime) {
249			warn "Mailagent has changed, restarting tests...\n";
250			++$restart;
251		} elsif ($fi_mtime > $ok_mtime) {
252			warn "Filter has changed, restarting tests...\n";
253			++$restart;
254		}
255		unlink 'OK' if $restart;
256	}
257
258	return unless -f 'OK';
259	local($file, $when);
260	open(OK, 'OK') || return;
261	while (<OK>) {
262		chop;
263		($file, $when) = /^(\S+)\s+(\d+)/;
264		$Ok{$file} = $when if $when;
265	}
266	close OK;
267
268}
269
270# Read configuration information from config.sh
271sub read_config_sh {
272	open(CONFIG, '../../config.sh') ||
273		die "No config.sh at the toplevel directory! Did you run Configure?\n";
274	local($_);
275	local($config) = "package cfsh;\n";
276	local($var, $value);
277	while (<CONFIG>) {
278		next unless ($var, $value) = /^(\w+)='([^']*)'/;
279		$config .= "\$$var = '$value';\n";
280	}
281	close CONFIG;
282	eval($config);
283	warn $@ if $@;
284	die "Can't create config from config.sh\n" if $@;
285}
286
287