Testsuite: Getopt::Long, --help, --man for runtest
[exim.git] / test / runtest
CommitLineData
b057ad11
HSHR
1#! /usr/bin/env perl
2# We use env, because in some environments of our build farm
3# the Perl 5.010 interpreter is only reachable via $PATH
151b83f8 4
151b83f8
PH
5###############################################################################
6# This is the controlling script for the "new" test suite for Exim. It should #
7# be possible to export this suite for running on a wide variety of hosts, in #
8# contrast to the old suite, which was very dependent on the environment of #
9# Philip Hazel's desktop computer. This implementation inspects the version #
10# of Exim that it finds, and tests only those features that are included. The #
11# surrounding environment is also tested to discover what is available. See #
12# the README file for details of how it all works. #
13# #
14# Implementation started: 03 August 2005 by Philip Hazel #
15# Placed in the Exim CVS: 06 February 2006 #
16###############################################################################
17
3ff2360f 18#use strict;
b057ad11 19use 5.010;
fefe59d9 20use feature 'state'; # included in 5.010
b057ad11
HSHR
21use warnings;
22
151b83f8
PH
23use Errno;
24use FileHandle;
25use Socket;
f675bf30 26use Time::Local;
28e8a0f7
HSHR
27use Cwd;
28use File::Basename;
ffe0a357
HSHR
29use Pod::Usage;
30use Getopt::Long;
9a8a6839 31use FindBin qw'$RealBin';
1f187290 32
9a8a6839 33use lib "$RealBin/lib";
1f187290
HSHR
34use Exim::Runtest;
35
2f8e6f30 36use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####');
151b83f8 37
9b25e4a9
HSHR
38use constant TEST_TOP => 8999;
39use constant TEST_SPECIAL_TOP => 9999;
40
151b83f8
PH
41
42# Start by initializing some global variables
43
9a8a6839 44chomp(my $testversion = `git describe --always --dirty 2>&1` || '<unknown>');
151b83f8 45
83e2f8a2
PP
46# This gets embedded in the D-H params filename, and the value comes
47# from asking GnuTLS for "normal", but there appears to be no way to
48# use certtool/... to ask what that value currently is. *sigh*
9d26b8c0
PP
49# We also clamp it because of NSS interop, see addition of tls_dh_max_bits.
50# This value is correct as of GnuTLS 2.12.18 as clamped by tls_dh_max_bits.
51# normal = 2432 tls_dh_max_bits = 2236
9a8a6839 52my $gnutls_dh_bits_normal = 2236;
83e2f8a2 53
9a8a6839
HSHR
54my $cf = 'bin/cf -exact';
55my $cr = "\r";
56my $debug = 0;
57my $flavour = do {
c1395714 58 my $f = Exim::Runtest::flavour() // '';
6336058c
HSHR
59 (grep { $f eq $_ } Exim::Runtest::flavours()) ? $f : 'FOO';
60};
9a8a6839
HSHR
61my $force_continue = 0;
62my $force_update = 0;
63my $log_failed_filename = 'failed-summary.log';
a4ecb6a7 64my $log_summary_filename = 'run-summary.log';
9a8a6839
HSHR
65my $more = 'less -XF';
66my $optargs = '';
67my $save_output = 0;
68my $server_opts = '';
1a13c13c 69my $slow = 0;
9a8a6839
HSHR
70my $valgrind = 0;
71
72my $have_ipv4 = 1;
73my $have_ipv6 = 1;
74my $have_largefiles = 0;
75
76my $test_start = 1;
9b25e4a9
HSHR
77my $test_end = TEST_TOP;
78
9a8a6839 79my @test_list = ();
151b83f8
PH
80
81
82# Networks to use for DNS tests. We need to choose some networks that will
83# never be used so that there is no chance that the host on which we are
84# running is actually in one of the test networks. Private networks such as
85# the IPv4 10.0.0.0/8 network are no good because hosts may well use them.
86# Rather than use some unassigned numbers (that might become assigned later),
87# I have chosen some multicast networks, in the belief that such addresses
88# won't ever be assigned to hosts. This is the only place where these numbers
89# are defined, so it is trivially possible to change them should that ever
90# become necessary.
91
9a8a6839
HSHR
92my $parm_ipv4_test_net = 224;
93my $parm_ipv6_test_net = 'ff00';
151b83f8
PH
94
95# Port numbers are currently hard-wired
96
9a8a6839
HSHR
97my $parm_port_n = 1223; # Nothing listening on this port
98my $parm_port_s = 1224; # Used for the "server" command
99my $parm_port_d = 1225; # Used for the Exim daemon
100my $parm_port_d2 = 1226; # Additional for daemon
101my $parm_port_d3 = 1227; # Additional for daemon
102my $parm_port_d4 = 1228; # Additional for daemon
df613eb4 103my $dynamic_socket; # allocated later for PORT_DYNAMIC
151b83f8 104
1f187290
HSHR
105# Find a suiteable group name for test (currently only 0001
106# uses a group name. A numeric group id would do
107my $parm_mailgroup = Exim::Runtest::mailgroup('mail');
108
df88d501 109# Manually set locale
d63a9563 110$ENV{LC_ALL} = 'C';
df88d501 111
9a8a6839
HSHR
112# In some environments USER does not exist, but we need it for some test(s)
113$ENV{USER} = getpwuid($>) if not exists $ENV{USER};
151b83f8 114
d63a9563
HSHR
115my ($parm_configure_owner, $parm_configure_group);
116my ($parm_ipv4, $parm_ipv6);
117my $parm_hostname;
151b83f8
PH
118
119###############################################################################
120###############################################################################
121
122# Define a number of subroutines
123
124###############################################################################
125###############################################################################
126
127
128##################################################
129# Handle signals #
130##################################################
131
132sub pipehandler { $sigpipehappened = 1; }
133
134sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); }
135
136
137##################################################
138# Do global macro substitutions #
139##################################################
140
141# This function is applied to configurations, command lines and data lines in
142# scripts, and to lines in the files of the aux-var-src and the dnszones-src
143# directory. It takes one argument: the current test number, or zero when
144# setting up files before running any tests.
145
146sub do_substitute{
147s?\bCALLER\b?$parm_caller?g;
1b781f48 148s?\bCALLERGROUP\b?$parm_caller_group?g;
151b83f8
PH
149s?\bCALLER_UID\b?$parm_caller_uid?g;
150s?\bCALLER_GID\b?$parm_caller_gid?g;
151s?\bCLAMSOCKET\b?$parm_clamsocket?g;
152s?\bDIR/?$parm_cwd/?g;
153s?\bEXIMGROUP\b?$parm_eximgroup?g;
154s?\bEXIMUSER\b?$parm_eximuser?g;
155s?\bHOSTIPV4\b?$parm_ipv4?g;
156s?\bHOSTIPV6\b?$parm_ipv6?g;
157s?\bHOSTNAME\b?$parm_hostname?g;
158s?\bPORT_D\b?$parm_port_d?g;
159s?\bPORT_D2\b?$parm_port_d2?g;
160s?\bPORT_D3\b?$parm_port_d3?g;
161s?\bPORT_D4\b?$parm_port_d4?g;
162s?\bPORT_N\b?$parm_port_n?g;
163s?\bPORT_S\b?$parm_port_s?g;
164s?\bTESTNUM\b?$_[0]?g;
165s?(\b|_)V4NET([\._])?$1$parm_ipv4_test_net$2?g;
166s?\bV6NET:?$parm_ipv6_test_net:?g;
df613eb4 167s?\bPORT_DYNAMIC\b?$dynamic_socket->sockport()?eg;
1f187290 168s?\bMAILGROUP\b?$parm_mailgroup?g;
151b83f8
PH
169}
170
171
1ca9f507
PP
172##################################################
173# Any state to be preserved across tests #
174##################################################
175
176my $TEST_STATE = {};
177
151b83f8
PH
178
179##################################################
180# Subroutine to tidy up and exit #
181##################################################
182
183# In all cases, we check for any Exim daemons that have been left running, and
184# kill them. Then remove all the spool data, test output, and the modified Exim
185# binary if we are ending normally.
186
187# Arguments:
188# $_[0] = 0 for a normal exit; full cleanup done
189# $_[0] > 0 for an error exit; no files cleaned up
190# $_[0] < 0 for a "die" exit; $_[1] contains a message
191
192sub tests_exit{
193my($rc) = $_[0];
194my($spool);
195
196# Search for daemon pid files and kill the daemons. We kill with SIGINT rather
197# than SIGTERM to stop it outputting "Terminated" to the terminal when not in
198# the background.
199
1ca9f507
PP
200if (exists $TEST_STATE->{exim_pid})
201 {
202 $pid = $TEST_STATE->{exim_pid};
203 print "Tidyup: killing wait-mode daemon pid=$pid\n";
ee15e974 204 system("sudo kill -INT $pid");
1ca9f507
PP
205 }
206
151b83f8
PH
207if (opendir(DIR, "spool"))
208 {
209 my(@spools) = sort readdir(DIR);
210 closedir(DIR);
211 foreach $spool (@spools)
212 {
213 next if $spool !~ /^exim-daemon./;
214 open(PID, "spool/$spool") || die "** Failed to open \"spool/$spool\": $!\n";
215 chomp($pid = <PID>);
216 close(PID);
217 print "Tidyup: killing daemon pid=$pid\n";
ee15e974 218 system("sudo rm -f spool/$spool; sudo kill -INT $pid");
151b83f8
PH
219 }
220 }
221else
222 { die "** Failed to opendir(\"spool\"): $!\n" unless $!{ENOENT}; }
223
224# Close the terminal input and remove the test files if all went well, unless
225# the option to save them is set. Always remove the patched Exim binary. Then
226# exit normally, or die.
227
228close(T);
229system("sudo /bin/rm -rf ./spool test-* ./dnszones/*")
230 if ($rc == 0 && !$save_output);
231
b3e39dd7
TL
232system("sudo /bin/rm -rf ./eximdir/*")
233 if (!$save_output);
6bf5d8f2
PP
234
235print "\nYou were in test $test at the end there.\n\n" if defined $test;
151b83f8
PH
236exit $rc if ($rc >= 0);
237die "** runtest error: $_[1]\n";
238}
239
240
241
242##################################################
243# Subroutines used by the munging subroutine #
244##################################################
245
246# This function is used for things like message ids, where we want to generate
247# more than one value, but keep a consistent mapping throughout.
248#
249# Arguments:
250# $oldid the value from the file
251# $base a base string into which we insert a sequence
252# $sequence the address of the current sequence counter
253
254sub new_value {
255my($oldid, $base, $sequence) = @_;
256my($newid) = $cache{$oldid};
257if (! defined $newid)
258 {
259 $newid = sprintf($base, $$sequence++);
260 $cache{$oldid} = $newid;
261 }
262return $newid;
263}
264
265
f675bf30
JH
266# This is used while munging the output from exim_dumpdb.
267# May go wrong across DST changes.
151b83f8
PH
268
269sub date_seconds {
270my($day,$month,$year,$hour,$min,$sec) =
271 $_[0] =~ /^(\d\d)-(\w\w\w)-(\d{4})\s(\d\d):(\d\d):(\d\d)/;
f675bf30
JH
272my($mon);
273if ($month =~ /Jan/) {$mon = 0;}
274elsif($month =~ /Feb/) {$mon = 1;}
275elsif($month =~ /Mar/) {$mon = 2;}
276elsif($month =~ /Apr/) {$mon = 3;}
277elsif($month =~ /May/) {$mon = 4;}
278elsif($month =~ /Jun/) {$mon = 5;}
279elsif($month =~ /Jul/) {$mon = 6;}
280elsif($month =~ /Aug/) {$mon = 7;}
281elsif($month =~ /Sep/) {$mon = 8;}
282elsif($month =~ /Oct/) {$mon = 9;}
283elsif($month =~ /Nov/) {$mon = 10;}
284elsif($month =~ /Dec/) {$mon = 11;}
285return timelocal($sec,$min,$hour,$day,$mon,$year);
151b83f8
PH
286}
287
288
289# This is a subroutine to sort maildir files into time-order. The second field
290# is the microsecond field, and may vary in length, so must be compared
291# numerically.
292
293sub maildirsort {
294return $a cmp $b if ($a !~ /^\d+\.H\d/ || $b !~ /^\d+\.H\d/);
295my($x1,$y1) = $a =~ /^(\d+)\.H(\d+)/;
296my($x2,$y2) = $b =~ /^(\d+)\.H(\d+)/;
297return ($x1 != $x2)? ($x1 <=> $x2) : ($y1 <=> $y2);
298}
299
300
301
302##################################################
303# Subroutine list files below a directory #
304##################################################
305
306# This is used to build up a list of expected mail files below a certain path
307# in the directory tree. It has to be recursive in order to deal with multiple
308# maildir mailboxes.
309
310sub list_files_below {
311my($dir) = $_[0];
312my(@yield) = ();
313my(@sublist, $file);
314
315opendir(DIR, $dir) || tests_exit(-1, "Failed to open $dir: $!");
316@sublist = sort maildirsort readdir(DIR);
317closedir(DIR);
318
319foreach $file (@sublist)
320 {
321 next if $file eq "." || $file eq ".." || $file eq "CVS";
322 if (-d "$dir/$file")
323 { @yield = (@yield, list_files_below("$dir/$file")); }
324 else
325 { push @yield, "$dir/$file"; }
326 }
327
328return @yield;
329}
330
331
332
333##################################################
334# Munge a file before comparing #
335##################################################
336
337# The pre-processing turns all dates, times, Exim versions, message ids, and so
338# on into standard values, so that the compare works. Perl's substitution with
339# an expression provides a neat way to do some of these changes.
340
341# We keep a global associative array for repeatedly turning the same values
342# into the same standard values throughout the data from a single test.
343# Message ids get this treatment (can't be made reliable for times), and
344# times in dumped retry databases are also handled in a special way, as are
345# incoming port numbers.
346
347# On entry to the subroutine, the file to write to is already opened with the
348# name MUNGED. The input file name is the only argument to the subroutine.
349# Certain actions are taken only when the name contains "stderr", "stdout",
350# or "log". The yield of the function is 1 if a line matching "*** truncated
351# ***" is encountered; otherwise it is 0.
352
353sub munge {
354my($file) = $_[0];
c9a55f6a 355my($extra) = $_[1];
151b83f8
PH
356my($yield) = 0;
357my(@saved) = ();
358
2f8e6f30
HSHR
359local $_;
360
151b83f8
PH
361open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!");
362
363my($is_log) = $file =~ /log/;
364my($is_stdout) = $file =~ /stdout/;
365my($is_stderr) = $file =~ /stderr/;
87cb4a16 366my($is_mail) = $file =~ /mail/;
151b83f8
PH
367
368# Date pattern
369
370$date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}";
371
372# Pattern for matching pids at start of stderr lines; initially something
373# that won't match.
374
375$spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
376
377# Scan the file and make the changes. Near the bottom there are some changes
378# that are specific to certain file types, though there are also some of those
379# inline too.
380
bc3c7bb7 381LINE: while(<IN>)
151b83f8 382 {
8f1cff48 383RESET_AFTER_EXTRA_LINE_READ:
c9a55f6a
JH
384 # Custom munges
385 if ($extra)
386 {
387 next if $extra =~ m%^/% && eval $extra;
388 eval $extra if $extra =~ m/^s/;
389 }
390
151b83f8
PH
391 # Check for "*** truncated ***"
392 $yield = 1 if /\*\*\* truncated \*\*\*/;
393
394 # Replace the name of this host
395 s/\Q$parm_hostname\E/the.local.host.name/g;
396
397 # But convert "name=the.local.host address=127.0.0.1" to use "localhost"
398 s/name=the\.local\.host address=127\.0\.0\.1/name=localhost address=127.0.0.1/g;
399
d40f27c3
JH
400 # The name of the shell may vary
401 s/\s\Q$parm_shell\E\b/ ENV_SHELL/;
402
151b83f8
PH
403 # Replace the path to the testsuite directory
404 s?\Q$parm_cwd\E?TESTSUITE?g;
405
406 # Replace the Exim version number (may appear in various places)
a769a501 407 # patchexim should have fixed this for us
026d45f5 408 #s/(Exim) \d+\.\d+[\w_-]*/$1 x.yz/i;
151b83f8
PH
409
410 # Replace Exim message ids by a unique series
411 s/((?:[^\W_]{6}-){2}[^\W_]{2})
412 /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
413
414 # The names of lock files appear in some error and debug messages
415 s/\.lock(\.[-\w]+)+(\.[\da-f]+){2}/.lock.test.ex.dddddddd.pppppppp/;
416
417 # Unless we are in an IPv6 test, replace IPv4 and/or IPv6 in "listening on
418 # port" message, because it is not always the same.
419 s/port (\d+) \([^)]+\)/port $1/g
420 if !$is_ipv6test && m/listening for SMTP(S?) on port/;
421
422 # Challenges in SPA authentication
423 s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/;
424
425 # PRVS values
85b6260a
PH
426 s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; # Old form
427 s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g; # New form
151b83f8 428
b6d22362
PH
429 # There are differences in error messages between OpenSSL versions
430 s/SSL_CTX_set_cipher_list/SSL_connect/;
431
151b83f8
PH
432 # One error test in expansions mentions base 62 or 36
433 s/is not a base (36|62) number/is not a base 36\/62 number/;
434
435 # This message sometimes has a different number of seconds
436 s/forced fail after \d seconds/forced fail after d seconds/;
437
438 # This message may contain a different DBM library name
439 s/Failed to open \S+( \([^\)]+\))? file/Failed to open DBM file/;
440
441 # The message for a non-listening FIFO varies
442 s/:[^:]+: while opening named pipe/: Error: while opening named pipe/;
443
151b83f8
PH
444 # Debugging output of lists of hosts may have different sort keys
445 s/sort=\S+/sort=xx/ if /^\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\S+/;
446
447 # Random local part in callout cache testing
448 s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/;
9bfc60eb 449 s/the.local.host.name-\d+-testing/the.local.host.name-dddddddd-testing/;
151b83f8 450
1b781f48
PH
451 # File descriptor numbers may vary
452 s/^writing data block fd=\d+/writing data block fd=dddd/;
fc43746d 453 s/(running as transport filter:) fd_write=\d+ fd_read=\d+/$1 fd_write=dddd fd_read=dddd/;
1b781f48 454
151b83f8
PH
455
456 # ======== Dumpdb output ========
457 # This must be before the general date/date munging.
458 # Time data lines, which look like this:
459 # 25-Aug-2000 12:11:37 25-Aug-2000 12:11:37 26-Aug-2000 12:11:37
460 if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
461 {
462 my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
9a8a6839 463 $expired = '' if !defined $expired;
151b83f8
PH
464 my($increment) = date_seconds($date3) - date_seconds($date2);
465
466 # We used to use globally unique replacement values, but timing
467 # differences make this impossible. Just show the increment on the
468 # last one.
469
470 printf MUNGED ("first failed = time last try = time2 next try = time2 + %s%s\n",
471 $increment, $expired);
472 next;
473 }
474
475 # more_errno values in exim_dumpdb output which are times
476 s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /;
477
478
479 # ======== Dates and times ========
480
481 # Dates and times are all turned into the same value - trying to turn
482 # them into different ones cannot be done repeatedly because they are
483 # real time stamps generated while running the test. The actual date and
484 # time used was fixed when I first started running automatic Exim tests.
485
486 # Date/time in header lines and SMTP responses
487 s/[A-Z][a-z]{2},\s\d\d?\s[A-Z][a-z]{2}\s\d\d\d\d\s\d\d\:\d\d:\d\d\s[-+]\d{4}
488 /Tue, 2 Mar 1999 09:44:33 +0000/gx;
489
490 # Date/time in logs and in one instance of a filter test
491 s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d(\s[+-]\d\d\d\d)?/1999-03-02 09:44:33/gx;
492 s/^Logwrite\s"\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Logwrite "1999-03-02 09:44:33/gx;
493
494 # Date/time in message separators
495 s/(?:[A-Z][a-z]{2}\s){2}\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d
496 /Tue Mar 02 09:44:33 1999/gx;
497
498 # Date of message arrival in spool file as shown by -Mvh
499 s/^\d{9,10}\s0$/ddddddddd 0/;
500
501 # Date/time in mbx mailbox files
502 s/\d\d-\w\w\w-\d\d\d\d\s\d\d:\d\d:\d\d\s[-+]\d\d\d\d,/06-Sep-1999 15:52:48 +0100,/gx;
503
ea49d0e1 504 # Dates/times in debugging output for writing retry records
151b83f8
PH
505 if (/^ first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/)
506 {
507 my($next) = $3 - $2;
508 $_ = " first failed=dddd last try=dddd next try=+$next $4\n";
509 }
c816d124 510 s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\d)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/;
148e1ac6 511 s/^(\s*)received_time=\d+ diff=\d+ timeout=(\d+)/$1received_time=tttt diff=tttt timeout=$2/;
151b83f8
PH
512
513 # Time to retry may vary
ea49d0e1
PH
514 s/time to retry = \S+/time to retry = tttt/;
515 s/retry record exists: age=\S+/retry record exists: age=ttt/;
727071f8 516 s/failing_interval=\S+ message_age=\S+/failing_interval=ttt message_age=ttt/;
151b83f8
PH
517
518 # Date/time in exim -bV output
519 s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g;
520
1cc59d37 521 # Time on queue tolerance
74377a62 522 s/(QT|D)=1s/$1=0s/;
1cc59d37 523
f3f065bb
PH
524 # Eximstats heading
525 s/Exim\sstatistics\sfrom\s\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\sto\s
526 \d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Exim statistics from <time> to <time>/x;
527
7f8794a2
JH
528 # Treat ECONNRESET the same as ECONNREFUSED. At least some systems give
529 # us the former on a new connection.
530 s/(could not connect to .*: Connection) reset by peer$/$1 refused/;
151b83f8 531
6bf5d8f2
PP
532 # ======== TLS certificate algorithms ========
533 # Test machines might have various different TLS library versions supporting
534 # different protocols; can't rely upon TLS 1.2's AES256-GCM-SHA384, so we
535 # treat the standard algorithms the same.
536 # So far, have seen:
d7e464f4 537 # TLSv1:AES128-GCM-SHA256:128
6bf5d8f2 538 # TLSv1:AES256-SHA:256
ce42f3ed 539 # TLSv1.1:AES256-SHA:256
6bf5d8f2 540 # TLSv1.2:AES256-GCM-SHA384:256
1508acb8 541 # TLSv1.2:DHE-RSA-AES256-SHA:256
75fe387d 542 # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
6bf5d8f2
PP
543 # We also need to handle the ciphersuite without the TLS part present, for
544 # client-ssl's output. We also see some older forced ciphersuites, but
545 # negotiating TLS 1.2 instead of 1.0.
546 # Mail headers (...), log-lines X=..., client-ssl output ...
547 # (and \b doesn't match between ' ' and '(' )
548
25ae05f8 549 s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.[12]:/$1TLSv1:/xg;
d7e464f4
JH
550 s/\bAES128-GCM-SHA256:128\b/AES256-SHA:256/g;
551 s/\bAES128-GCM-SHA256\b/AES256-SHA/g;
6bf5d8f2 552 s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
1508acb8 553 s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
6bf5d8f2 554
4cc77633
HSHR
555 # LibreSSL
556 # TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256
557 s/\bECDHE-RSA-CHACHA20-POLY1305\b/AES256-SHA/g;
558
75fe387d 559 # GnuTLS have seen:
62b56dbf
JH
560 # TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256
561 # TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128
75fe387d
PP
562 # TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical)
563 # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
564 #
565 # X=TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256
bc9a5bcb
JH
566 # X=TLS1.2:RSA_AES_256_CBC_SHA1:256
567 # X=TLS1.1:RSA_AES_256_CBC_SHA1:256
75fe387d
PP
568 # X=TLS1.0:DHE_RSA_AES_256_CBC_SHA1:256
569 # and as stand-alone cipher:
62b56dbf 570 # ECDHE-RSA-AES256-SHA
75fe387d
PP
571 # DHE-RSA-AES256-SHA256
572 # DHE-RSA-AES256-SHA
573 # picking latter as canonical simply because regex easier that way.
574 s/\bDHE_RSA_AES_128_CBC_SHA1:128/RSA_AES_256_CBC_SHA1:256/g;
62b56dbf
JH
575 s/TLS1.[012]:((EC)?DHE_)?RSA_AES_(256|128)_(CBC|GCM)_SHA(1|256|384):(256|128)/TLS1.x:xxxxRSA_AES_256_CBC_SHAnnn:256/g;
576 s/\b(ECDHE-RSA-AES256-SHA|DHE-RSA-AES256-SHA256)\b/AES256-SHA/g;
577
578 # GnuTLS library error message changes
579 s/No certificate was found/The peer did not send any certificate/g;
580#(dodgy test?) s/\(certificate verification failed\): invalid/\(gnutls_handshake\): The peer did not send any certificate./g;
581 s/\(gnutls_priority_set\): No or insufficient priorities were set/\(gnutls_handshake\): Could not negotiate a supported cipher suite/g;
582
2b4a568d
JH
583 # (this new one is a generic channel-read error, but the testsuite
584 # only hits it in one place)
c562fd30 585 s/TLS error on connection \(gnutls_handshake\): Error in the pull function\./a TLS session is required but an attempt to start TLS failed/g;
2b4a568d 586
62b56dbf 587 # (replace old with new, hoping that old only happens in one situation)
09b16492
JH
588 s/TLS error on connection to \d{1,3}(.\d{1,3}){3} \[\d{1,3}(.\d{1,3}){3}\] \(gnutls_handshake\): A TLS packet with unexpected length was received./a TLS session is required for ip4.ip4.ip4.ip4 [ip4.ip4.ip4.ip4], but an attempt to start TLS failed/g;
589 s/TLS error on connection from \[127.0.0.1\] \(recv\): A TLS packet with unexpected length was received./TLS error on connection from [127.0.0.1] (recv): The TLS connection was non-properly terminated./g;
75fe387d 590
348051ad 591 # signature algorithm names
2335af87 592 s/RSA-SHA1/RSA-SHA/;
348051ad 593
6bf5d8f2 594
eeeda78a 595 # ======== Caller's login, uid, gid, home, gecos ========
151b83f8
PH
596
597 s/\Q$parm_caller_home\E/CALLER_HOME/g; # NOTE: these must be done
598 s/\b\Q$parm_caller\E\b/CALLER/g; # in this order!
599 s/\b\Q$parm_caller_group\E\b/CALLER/g; # In case group name different
600
601 s/\beuid=$parm_caller_uid\b/euid=CALLER_UID/g;
602 s/\begid=$parm_caller_gid\b/egid=CALLER_GID/g;
603
604 s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g;
605 s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g;
606
903546d8 607 s/\bname="?$parm_caller_gecos"?/name=CALLER_GECOS/g;
eeeda78a 608
151b83f8
PH
609 # When looking at spool files with -Mvh, we will find not only the caller
610 # login, but also the uid and gid. It seems that $) in some Perls gives all
611 # the auxiliary gids as well, so don't bother checking for that.
612
613 s/^CALLER $> \d+$/CALLER UID GID/;
614
615 # There is one case where the caller's login is forced to something else,
616 # in order to test the processing of logins that contain spaces. Weird what
617 # some people do, isn't it?
618
619 s/^spaced user $> \d+$/CALLER UID GID/;
620
621
622 # ======== Exim's login ========
ebeaf996
PH
623 # For messages received by the daemon, this is in the -H file, which some
624 # tests inspect. For bounce messages, this will appear on the U= lines in
625 # logs and also after Received: and in addresses. In one pipe test it appears
626 # after "Running as:". It also appears in addresses, and in the names of lock
151b83f8
PH
627 # files.
628
629 s/U=$parm_eximuser/U=EXIMUSER/;
630 s/user=$parm_eximuser/user=EXIMUSER/;
631 s/login=$parm_eximuser/login=EXIMUSER/;
632 s/Received: from $parm_eximuser /Received: from EXIMUSER /;
633 s/Running as: $parm_eximuser/Running as: EXIMUSER/;
634 s/\b$parm_eximuser@/EXIMUSER@/;
635 s/\b$parm_eximuser\.lock\./EXIMUSER.lock./;
636
637 s/\beuid=$parm_exim_uid\b/euid=EXIM_UID/g;
638 s/\begid=$parm_exim_gid\b/egid=EXIM_GID/g;
639
640 s/\buid=$parm_exim_uid\b/uid=EXIM_UID/g;
641 s/\bgid=$parm_exim_gid\b/gid=EXIM_GID/g;
642
ebeaf996
PH
643 s/^$parm_eximuser $parm_exim_uid $parm_exim_gid/EXIMUSER EXIM_UID EXIM_GID/;
644
151b83f8
PH
645
646 # ======== General uids, gids, and pids ========
647 # Note: this must come after munges for caller's and exim's uid/gid
648
a4dc33a8
PH
649 # These are for systems where long int is 64
650 s/\buid=4294967295/uid=-1/;
651 s/\beuid=4294967295/euid=-1/;
652 s/\bgid=4294967295/gid=-1/;
653 s/\begid=4294967295/egid=-1/;
654
151b83f8
PH
655 s/\bgid=\d+/gid=gggg/;
656 s/\begid=\d+/egid=gggg/;
657 s/\bpid=\d+/pid=pppp/;
658 s/\buid=\d+/uid=uuuu/;
659 s/\beuid=\d+/euid=uuuu/;
660 s/set_process_info:\s+\d+/set_process_info: pppp/;
661 s/queue run pid \d+/queue run pid ppppp/;
662 s/process \d+ running as transport filter/process pppp running as transport filter/;
663 s/process \d+ writing to transport filter/process pppp writing to transport filter/;
664 s/reading pipe for subprocess \d+/reading pipe for subprocess pppp/;
665 s/remote delivery process \d+ ended/remote delivery process pppp ended/;
666
667 # Pid in temp file in appendfile transport
668 s"test-mail/temp\.\d+\."test-mail/temp.pppp.";
669
f3f065bb
PH
670 # Optional pid in log lines
671 s/^(\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d)(\s[+-]\d\d\d\d|)(\s\[\d+\])/
672 "$1$2 [" . new_value($3, "%s", \$next_pid) . "]"/gxe;
673
151b83f8
PH
674 # Detect a daemon stderr line with a pid and save the pid for subsequent
675 # removal from following lines.
676 $spid = $1 if /^(\s*\d+) (?:listening|LOG: MAIN|(?:daemon_smtp_port|local_interfaces) overridden by)/;
677 s/^$spid //;
678
679 # Queue runner waiting messages
680 s/waiting for children of \d+/waiting for children of pppp/;
681 s/waiting for (\S+) \(\d+\)/waiting for $1 (pppp)/;
682
e498ab40
JH
683 # The spool header file name varies with PID
684 s%^(Writing spool header file: .*/hdr).[0-9]{1,5}%$1.pppp%;
685
151b83f8
PH
686 # ======== Port numbers ========
687 # Incoming port numbers may vary, but not in daemon startup line.
688
689 s/^Port: (\d+)/"Port: " . new_value($1, "%s", \$next_port)/e;
690 s/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e;
691
692 # This handles "connection from" and the like, when the port is given
4311097e
PH
693 if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/
694 && !/\*>/ && !/Connection refused/)
151b83f8
PH
695 {
696 s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie;
697 }
698
699 # Port in host address in spool file output from -Mvh
700 s/^-host_address (.*)\.\d+/-host_address $1.9999/;
701
df613eb4
HSHR
702 if ($dynamic_socket and $dynamic_socket->opened and my $port = $dynamic_socket->sockport) {
703 s/^Connecting to 127\.0\.0\.1 port \K$port/<dynamic port>/;
704 }
705
151b83f8
PH
706
707 # ======== Local IP addresses ========
708 # The amount of space between "host" and the address in verification output
709 # depends on the length of the host name. We therefore reduce it to one space
710 # for all of them.
37acd760
JJ
711 # Also, the length of space at the end of the host line is dependent
712 # on the length of the longest line, so strip it also on otherwise
713 # un-rewritten lines like localhost
151b83f8
PH
714
715 s/^\s+host\s(\S+)\s+(\S+)/ host $1 $2/;
716 s/^\s+(host\s\S+\s\S+)\s+(port=.*)/ host $1 $2/;
717 s/^\s+(host\s\S+\s\S+)\s+(?=MX=)/ $1 /;
718 s/host\s\Q$parm_ipv4\E\s\[\Q$parm_ipv4\E\]/host ipv4.ipv4.ipv4.ipv4 [ipv4.ipv4.ipv4.ipv4]/;
719 s/host\s\Q$parm_ipv6\E\s\[\Q$parm_ipv6\E\]/host ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6 [ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6]/;
720 s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g;
48dc5470 721 s/(^|\W)\K\Q$parm_ipv6\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g;
75758eeb 722 s/\b\Q$parm_ipv4r\E\b/ip4-reverse/g;
48dc5470 723 s/(^|\W)\K\Q$parm_ipv6r\E/ip6-reverse/g;
37acd760 724 s/^(\s+host\s\S+\s+\[\S+\]) +$/$1 /;
151b83f8
PH
725
726
727 # ======== Test network IP addresses ========
728 s/(\b|_)\Q$parm_ipv4_test_net\E(?=\.\d+\.\d+\.\d+\b|_|\.rbl|\.in-addr|\.test\.again\.dns)/$1V4NET/g;
729 s/\b\Q$parm_ipv6_test_net\E(?=:[\da-f]+:[\da-f]+:[\da-f]+)/V6NET/gi;
730
731
732 # ======== IP error numbers and messages ========
733 # These vary between operating systems
734 s/Can't assign requested address/Network Error/;
735 s/Cannot assign requested address/Network Error/;
736 s/Operation timed out/Connection timed out/;
737 s/Address family not supported by protocol family/Network Error/;
738 s/Network is unreachable/Network Error/;
739 s/Invalid argument/Network Error/;
740
741 s/\(\d+\): Network/(dd): Network/;
742 s/\(\d+\): Connection refused/(dd): Connection refused/;
743 s/\(\d+\): Connection timed out/(dd): Connection timed out/;
744 s/\d+ 65 Connection refused/dd 65 Connection refused/;
745 s/\d+ 321 Connection timed out/dd 321 Connection timed out/;
746
747
748 # ======== Other error numbers ========
749 s/errno=\d+/errno=dd/g;
750
f4bb1d53
HSHR
751 # ======== System Error Messages ======
752 # depending on the underlaying file system the error message seems to differ
753 s/(?: is not a regular file)|(?: has too many links \(\d+\))/ not a regular file or too many links/;
151b83f8
PH
754
755 # ======== Output from ls ========
756 # Different operating systems use different spacing on long output
c1e49b79
PP
757 #s/ +/ /g if /^[-rwd]{10} /;
758 # (Bug 1226) SUSv3 allows a trailing printable char for modified access method control.
759 # Handle only the Gnu and MacOS space, dot, plus and at-sign. A full [[:graph:]]
760 # unfortunately matches a non-ls linefull of dashes.
761 # Allow the case where we've already picked out the file protection bits.
6f99d4d9 762 if (s/^([-d](?:[-r][-w][-SsTtx]){3})[.+@]?( +|$)/$1$2/) {
8dfac759
PP
763 s/ +/ /g;
764 }
151b83f8
PH
765
766
767 # ======== Message sizes =========
768 # Message sizes vary, owing to different logins and host names that get
769 # automatically inserted. I can't think of any way of even approximately
770 # comparing these.
771
772 s/([\s,])S=\d+\b/$1S=sss/;
773 s/:S\d+\b/:Ssss/;
774 s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout;
1f253d34 775 s/\sSIZE=\d+\b/ SIZE=ssss/;
151b83f8
PH
776 s/\ssize=\d+\b/ size=sss/ if $is_stderr;
777 s/old size = \d+\b/old size = sssss/;
778 s/message size = \d+\b/message size = sss/;
779 s/this message = \d+\b/this message = sss/;
780 s/Size of headers = \d+/Size of headers = sss/;
781 s/sum=(?!0)\d+/sum=dddd/;
3b5d5078
JH
782 s/(?<=sum=dddd )count=\d+\b/count=dd/;
783 s/(?<=sum=0 )count=\d+\b/count=dd/;
151b83f8
PH
784 s/,S is \d+\b/,S is ddddd/;
785 s/\+0100,\d+;/+0100,ddd;/;
786 s/\(\d+ bytes written\)/(ddd bytes written)/;
787 s/added '\d+ 1'/added 'ddd 1'/;
f3f065bb
PH
788 s/Received\s+\d+/Received nnn/;
789 s/Delivered\s+\d+/Delivered nnn/;
151b83f8
PH
790
791
a98e6aca
HSHR
792 # ======== Values in spool space failure message ========
793 s/space=\d+ inodes=[+-]?\d+/space=xxxxx inodes=xxxxx/;
794
795
151b83f8
PH
796 # ======== Filter sizes ========
797 # The sizes of filter files may vary because of the substitution of local
798 # filenames, logins, etc.
799
800 s/^\d+(?= bytes read from )/ssss/;
801
802
803 # ======== OpenSSL error messages ========
804 # Different releases of the OpenSSL libraries seem to give different error
805 # numbers, or handle specific bad conditions in different ways, leading to
806 # different wording in the error messages, so we cannot compare them.
807
cf0c6164
JH
808#XXX This loses any trailing "deliving unencypted to" which is unfortunate
809# but I can't work out how to deal with that.
810 s/(TLS session: \(SSL_\w+\): error:)(.*)(?!: delivering)/$1 <<detail omitted>>/;
811 s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
5f921f97 812 next if /SSL verify error: depth=0 error=certificate not trusted/;
151b83f8 813
151b83f8
PH
814 # ======== Maildir things ========
815 # timestamp output in maildir processing
816 s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g;
817
818 # maildir delivery files appearing in log lines (in cases of error)
819 s/writing to(?: file)? tmp\/\d+\.[^.]+\.(\S+)/writing to tmp\/MAILDIR.$1/;
820
821 s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/;
822
823 # Maildir file names in general
824 s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/;
825
826 # Maildirsize data
01c490df 827 while (/^\d+S,\d+C\s*$/)
151b83f8 828 {
21c28500 829 print MUNGED;
151b83f8
PH
830 while (<IN>)
831 {
832 last if !/^\d+ \d+\s*$/;
833 print MUNGED "ddd d\n";
834 }
835 last if !defined $_;
836 }
01c490df 837 last if !defined $_;
151b83f8
PH
838
839
840 # ======== Output from the "fd" program about open descriptors ========
841 # The statuses seem to be different on different operating systems, but
842 # at least we'll still be checking the number of open fd's.
843
844 s/max fd = \d+/max fd = dddd/;
845 s/status=0 RDONLY/STATUS/g;
846 s/status=1 WRONLY/STATUS/g;
847 s/status=2 RDWR/STATUS/g;
848
849
850 # ======== Contents of spool files ========
851 # A couple of tests dump the contents of the -H file. The length fields
852 # will be wrong because of different user names, etc.
853 s/^\d\d\d(?=[PFS*])/ddd/;
854
855
1bad4ba4
JH
856 # ========= Exim lookups ==================
857 # Lookups have a char which depends on the number of lookup types compiled in,
858 # in stderr output. Replace with a "0". Recognising this while avoiding
859 # other output is fragile; perhaps the debug output should be revised instead.
860 s%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
44e6236d 861
151b83f8 862 # ==========================================================
bfd86064 863 # MIME boundaries in RFC3461 DSN messages
05faa88b 864 s/\d{8,10}-eximdsn-\d+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/;
bfd86064
JH
865
866 # ==========================================================
151b83f8
PH
867 # Some munging is specific to the specific file types
868
869 # ======== stdout ========
870
871 if ($is_stdout)
872 {
f3d7df6c
PH
873 # Skip translate_ip_address and use_classresources in -bP output because
874 # they aren't always there.
151b83f8
PH
875
876 next if /translate_ip_address =/;
f3d7df6c 877 next if /use_classresources/;
151b83f8
PH
878
879 # In certain filter tests, remove initial filter lines because they just
880 # clog up by repetition.
881
882 if ($rmfiltertest)
883 {
884 next if /^(Sender\staken\sfrom|
885 Return-path\scopied\sfrom|
886 Sender\s+=|
887 Recipient\s+=)/x;
888 if (/^Testing \S+ filter/)
889 {
890 $_ = <IN>; # remove blank line
891 next;
892 }
893 }
903546d8 894
7baddd6a
JH
895 # remote IPv6 addrs vary
896 s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/;
897
903546d8 898 # openssl version variances
12373afb
JH
899 # Error lines on stdout from SSL contain process id values and file names.
900 # They also contain a source file name and line number, which may vary from
901 # release to release.
902
80940bc0 903 next if /^SSL info:/;
fc96d1e8 904 next if /SSL verify error: depth=0 error=certificate not trusted/;
ef394e8d 905 s/SSL3_READ_BYTES/ssl3_read_bytes/i;
12373afb 906 s/^\d+:error:\d+(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/;
fc4fcc34
JH
907
908 # gnutls version variances
909 next if /^Error in the pull function./;
a678496c
JH
910
911 # optional IDN2 variant conversions. Accept either IDN1 or IDN2
912 s/conversion strasse.de/conversion xn--strae-oqa.de/;
913 s/conversion: german.xn--strae-oqa.de/conversion: german.stra├če.de/;
151b83f8
PH
914 }
915
916 # ======== stderr ========
917
918 elsif ($is_stderr)
919 {
920 # The very first line of debugging output will vary
921
922 s/^Exim version .*/Exim version x.yz ..../;
923
924 # Debugging lines for Exim terminations
925
926 s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
927
928 # IP address lookups use gethostbyname() when IPv6 is not supported,
929 # and gethostbyname2() or getipnodebyname() when it is.
930
4af1b6ca 931 s/\b(gethostbyname2?|\bgetipnodebyname)(\(af=inet\))?/get[host|ipnode]byname[2]/;
151b83f8 932
f2dd649a
NM
933 # drop gnutls version strings
934 next if /GnuTLS compile-time version: \d+[\.\d]+$/;
935 next if /GnuTLS runtime version: \d+[\.\d]+$/;
936
64fa3c1f
JJ
937 # drop openssl version strings
938 next if /OpenSSL compile-time version: OpenSSL \d+[\.\da-z]+/;
939 next if /OpenSSL runtime version: OpenSSL \d+[\.\da-z]+/;
940
8f1cff48
PP
941 # drop lookups
942 next if /^Lookups \(built-in\):/;
a769a501
PP
943 next if /^Loading lookup modules from/;
944 next if /^Loaded \d+ lookup modules/;
8f1cff48
PP
945 next if /^Total \d+ lookups/;
946
bdf15279
PP
947 # drop compiler information
948 next if /^Compiler:/;
949
8f1cff48
PP
950 # and the ugly bit
951 # different libraries will have different numbers (possibly 0) of follow-up
952 # lines, indenting with more data
953 if (/^Library version:/) {
954 while (1) {
955 $_ = <IN>;
956 next if /^\s/;
957 goto RESET_AFTER_EXTRA_LINE_READ;
958 }
959 }
960
961 # drop other build-time controls emitted for debugging
962 next if /^WHITELIST_D_MACROS:/;
963 next if /^TRUSTED_CONFIG_LIST:/;
964
965 # As of Exim 4.74, we log when a setgid fails; because we invoke Exim
966 # with -be, privileges will have been dropped, so this will always
967 # be the case
42ec9880 968 next if /^changing group to \d+ failed: (Operation not permitted|Not owner)/;
8f1cff48 969
9d26b8c0
PP
970 # We might not keep this check; rather than change all the tests, just
971 # ignore it as long as it succeeds; then we only need to change the
972 # TLS tests where tls_require_ciphers has been set.
973 if (m{^changed uid/gid: calling tls_validate_require_cipher}) {
974 my $discard = <IN>;
975 next;
976 }
977 next if /^tls_validate_require_cipher child \d+ ended: status=0x0/;
978
4c04137d 979 # We invoke Exim with -D, so we hit this new message as of Exim 4.73:
43236f35 980 next if /^macros_trusted overridden to true by whitelisting/;
8f1cff48 981
151b83f8
PH
982 # We have to omit the localhost ::1 address so that all is well in
983 # the IPv4-only case.
984
985 print MUNGED "MUNGED: ::1 will be omitted in what follows\n"
986 if (/looked up these IP addresses/);
987 next if /name=localhost address=::1/;
988
f2dd649a
NM
989 # drop pdkim debugging header
990 next if /^PDKIM <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+$/;
991
151b83f8
PH
992 # Various other IPv6 lines must be omitted too
993
994 next if /using host_fake_gethostbyname for \S+ \(IPv6\)/;
995 next if /get\[host\|ipnode\]byname\[2\]\(af=inet6\)/;
996 next if /DNS lookup of \S+ \(AAAA\) using fakens/;
997 next if / in dns_ipv4_lookup?/;
998
999 if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/)
1000 {
1001 $_= <IN>; # Gets "returning DNS_NODATA"
1002 next;
1003 }
1004
1005 # Skip tls_advertise_hosts and hosts_require_tls checks when the options
1006 # are unset, because tls ain't always there.
1007
1008 next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?)
23f3dc67 1009 \sno\s\((option\sunset|end\sof\slist)\)/x;
151b83f8
PH
1010
1011 # Skip auxiliary group lists because they will vary.
1012
1013 next if /auxiliary group list:/;
1014
1015 # Skip "extracted from gecos field" because the gecos field varies
1016
1017 next if /extracted from gecos field/;
1018
1019 # Skip "waiting for data on socket" and "read response data: size=" lines
1020 # because some systems pack more stuff into packets than others.
1021
1022 next if /waiting for data on socket/;
1023 next if /read response data: size=/;
1024
1025 # If Exim is compiled with readline support but it can't find the library
1026 # to load, there will be an extra debug line. Omit it.
1027
1028 next if /failed to load readline:/;
1029
1030 # Some DBM libraries seem to make DBM files on opening with O_RDWR without
1031 # O_CREAT; other's don't. In the latter case there is some debugging output
1032 # which is not present in the former. Skip the relevant lines (there are
1033 # two of them).
1034
1035 if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/)
1036 {
1037 $_ = <IN>;
1038 next;
1039 }
1040
1041 # Some tests turn on +expand debugging to check on expansions.
1042 # Unfortunately, the Received: expansion varies, depending on whether TLS
1043 # is compiled or not. So we must remove the relevant debugging if it is.
1044
1045 if (/^condition: def:tls_cipher/)
1046 {
1047 while (<IN>) { last if /^condition: def:sender_address/; }
1048 }
1049 elsif (/^expanding: Received: /)
1050 {
1051 while (<IN>) { last if !/^\s/; }
1052 }
1053
a2550b67
JH
1054 # remote port numbers vary
1055 s/(Connection request from 127.0.0.1 port) \d{1,5}/$1 sssss/;
1056
1057 # Skip hosts_require_dane checks when the options
1058 # are unset, because dane ain't always there.
1059
1060 next if /in\shosts_require_dane\?\sno\s\(option\sunset\)/x;
1061
1062 # SUPPORT_PROXY
1063 next if /host in hosts_proxy\?/;
1064
1065 # Experimental_International
1066 next if / in smtputf8_advertise_hosts\? no \(option unset\)/;
1067
1068 # Environment cleaning
1069 next if /\w+ in keep_environment\? (yes|no)/;
1070
76003495
JH
1071 # Sizes vary with test hostname
1072 s/^cmd buf flush \d+ bytes$/cmd buf flush ddd bytes/;
1073
ddf1b11a 1074 # Spool filesystem free space changes on different systems.
ad424056 1075 s/^((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/;
ddf1b11a 1076
7373d852 1077 # Non-TLS builds have different expansions for received_header_text
340f3113 1078 if (s/(with \$received_protocol)\}\} \$\{if def:tls_cipher \{\(\$tls_cipher\)\n$/$1/)
7373d852
JH
1079 {
1080 $_ .= <IN>;
340f3113 1081 s/\s+\}\}(?=\(Exim )/\}\} /;
7373d852 1082 }
340f3113
JH
1083 if (/^ condition: def:tls_cipher$/)
1084 {
1085 <IN>; <IN>; <IN>; <IN>; <IN>; <IN>;
1086 <IN>; <IN>; <IN>; <IN>; <IN>; next;
1087 }
1088
1089 # Not all platforms build with DKIM enabled
1090 next if /^PDKIM >> Body data for hash, canonicalized/;
7373d852 1091
cd1a5fe0 1092 # Parts of DKIM-specific debug output depend on the time/date
02b41d71 1093 next if /^date:\w+,\{SP\}/;
cd1a5fe0
JH
1094 next if /^PDKIM \[[^[]+\] (Header hash|b) computed:/;
1095
ef817659 1096 # Not all platforms support TCP Fast Open, and the compile omits the check
cb340d8d 1097 if (s/\S+ in hosts_try_fastopen\? no \(option unset\)\n$//)
ef817659 1098 {
7373d852
JH
1099 $_ .= <IN>;
1100 s/ \.\.\. >>> / ... /;
30d678d5 1101 s/Address family not supported by protocol family/Network Error/;
b3200ced 1102 s/Network is unreachable/Network Error/;
ef817659
JH
1103 }
1104
8170f6f7 1105 next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/;
7373d852 1106
151b83f8
PH
1107 # When Exim is checking the size of directories for maildir, it uses
1108 # the check_dir_size() function to scan directories. Of course, the order
1109 # of the files that are obtained using readdir() varies from system to
1110 # system. We therefore buffer up debugging lines from check_dir_size()
1111 # and sort them before outputting them.
1112
1113 if (/^check_dir_size:/ || /^skipping TESTSUITE\/test-mail\//)
1114 {
1115 push @saved, $_;
1116 }
1117 else
1118 {
1119 if (@saved > 0)
1120 {
1121 print MUNGED "MUNGED: the check_dir_size lines have been sorted " .
1122 "to ensure consistency\n";
1123 @saved = sort(@saved);
1124 print MUNGED @saved;
1125 @saved = ();
1126 }
1127
1128 # Skip some lines that Exim puts out at the start of debugging output
1129 # because they will be different in different binaries.
1130
1131 print MUNGED
1132 unless (/^Berkeley DB: / ||
1133 /^Probably (?:Berkeley DB|ndbm|GDBM)/ ||
1134 /^Authenticators:/ ||
1135 /^Lookups:/ ||
1136 /^Support for:/ ||
1137 /^Routers:/ ||
1138 /^Transports:/ ||
1139 /^log selectors =/ ||
1140 /^cwd=/ ||
21c28500 1141 /^Fixed never_users:/ ||
c9fb6994 1142 /^Configure owner:/ ||
21c28500 1143 /^Size of off_t:/
151b83f8 1144 );
9d4319df
JH
1145
1146
151b83f8
PH
1147 }
1148
1149 next;
1150 }
1151
42ec9880
JH
1152 # ======== log ========
1153
1154 elsif ($is_log)
1155 {
1156 # Berkeley DB version differences
1157 next if / Berkeley DB error: /;
1158 }
1159
151b83f8
PH
1160 # ======== All files other than stderr ========
1161
1162 print MUNGED;
1163 }
1164
1165close(IN);
1166return $yield;
1167}
1168
1169
1170
1171
1172##################################################
1173# Subroutine to interact with caller #
1174##################################################
1175
1176# Arguments: [0] the prompt string
1177# [1] if there is a U in the prompt and $force_update is true
c1c469db 1178# [2] if there is a C in the prompt and $force_continue is true
2f8e6f30 1179# Returns: returns the answer
151b83f8 1180
0df394b5
HSHR
1181sub interact {
1182 my ($prompt, $have_u, $have_c) = @_;
1183
1184 print $prompt;
1185
1186 if ($have_u) {
1187 print "... update forced\n";
1188 return 'u';
1189 }
1190
1191 if ($have_c) {
1192 print "... continue forced\n";
1193 return 'c';
1194 }
1195
1196 return lc <T>;
151b83f8
PH
1197}
1198
1199
1200
c1c469db
TL
1201##################################################
1202# Subroutine to log in force_continue mode #
1203##################################################
1204
1205# In force_continue mode, we just want a terse output to a statically
1206# named logfile. If multiple files in same batch (stdout, stderr, etc)
1207# all have mismatches, it will log multiple times.
1208#
1209# Arguments: [0] the logfile to append to
1210# [1] the testno that failed
1211# Returns: nothing
1212
1213
1214
1215sub log_failure {
0df394b5
HSHR
1216 my ($logfile, $testno, $detail) = @_;
1217
1218 open(my $fh, '>>', $logfile) or return;
1219
1220 print $fh "Test $testno "
1221 . (defined $detail ? "$detail " : '')
1222 . "failed\n";
c1c469db
TL
1223}
1224
a4ecb6a7
JH
1225# Computer-readable summary results logfile
1226
1227sub log_test {
1228 my ($logfile, $testno, $resultchar) = @_;
1229
1230 open(my $fh, '>>', $logfile) or return;
1231 print $fh "$testno $resultchar\n";
1232}
1233
c1c469db 1234
151b83f8
PH
1235
1236##################################################
1237# Subroutine to compare one output file #
1238##################################################
1239
1240# When an Exim server is part of the test, its output is in separate files from
1241# an Exim client. The server data is concatenated with the client data as part
1242# of the munging operation.
1243#
1244# Arguments: [0] the name of the main raw output file
1245# [1] the name of the server raw output file or undef
1246# [2] where to put the munged copy
1247# [3] the name of the saved file
1248# [4] TRUE if this is a log file whose deliveries must be sorted
c9a55f6a 1249# [5] optionally, a custom munge command
151b83f8 1250#
a4ecb6a7
JH
1251# Returns: 0 comparison succeeded
1252# 1 comparison failed; differences to be ignored
1253# 2 comparison failed; files may have been updated (=> re-compare)
151b83f8
PH
1254#
1255# Does not return if the user replies "Q" to a prompt.
1256
1257sub check_file{
c9a55f6a 1258my($rf,$rsf,$mf,$sf,$sortfile,$extra) = @_;
151b83f8
PH
1259
1260# If there is no saved file, the raw files must either not exist, or be
1261# empty. The test ! -s is TRUE if the file does not exist or is empty.
1262
28e8a0f7
HSHR
1263# we check if there is a flavour specific file, but we remember
1264# the original file name as "generic"
1265$sf_generic = $sf;
1266$sf_flavour = "$sf_generic.$flavour";
1267$sf_current = -e $sf_flavour ? $sf_flavour : $sf_generic;
1268
1269if (! -e $sf_current)
151b83f8 1270 {
148e1ac6 1271 return 0 if (! -s $rf && (! defined $rsf || ! -s $rsf));
151b83f8
PH
1272
1273 print "\n";
1274 print "** $rf is not empty\n" if (-s $rf);
1275 print "** $rsf is not empty\n" if (defined $rsf && -s $rsf);
1276
1277 for (;;)
1278 {
0df394b5
HSHR
1279 $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
1280 tests_exit(1) if /^q?$/;
a4ecb6a7
JH
1281 if (/^c$/ && $force_continue) {
1282 log_failure($log_failed_filename, $testno, $rf);
1283 log_test($log_summary_filename, $testno, 'F') if ($force_continue);
1284 }
0aca614f
JH
1285 return 1 if /^c$/i && $rf !~ /paniclog/ && $rsf !~ /paniclog/;
1286 last if (/^[sc]$/);
151b83f8
PH
1287 }
1288
1289 foreach $f ($rf, $rsf)
1290 {
1291 if (defined $f && -s $f)
1292 {
1293 print "\n";
1294 print "------------ $f -----------\n"
1295 if (defined $rf && -s $rf && defined $rsf && -s $rsf);
bc64a74d 1296 system("$more '$f'");
151b83f8
PH
1297 }
1298 }
1299
1300 print "\n";
1301 for (;;)
1302 {
0df394b5
HSHR
1303 $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
1304 tests_exit(1) if /^q?$/;
a4ecb6a7
JH
1305 if (/^c$/ && $force_continue) {
1306 log_failure($log_failed_filename, $testno, $rf);
1307 log_test($log_summary_filename, $testno, 'F')
1308 }
1309 return 1 if /^c$/i;
151b83f8
PH
1310 last if (/^u$/i);
1311 }
1312 }
1313
2f8e6f30
HSHR
1314#### $_
1315
151b83f8
PH
1316# Control reaches here if either (a) there is a saved file ($sf), or (b) there
1317# was a request to create a saved file. First, create the munged file from any
1318# data that does exist.
1319
9edef117 1320open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
c9a55f6a 1321my($truncated) = munge($rf, $extra) if -e $rf;
4cc77633
HSHR
1322
1323# Append the raw server log, if it is non-empty
151b83f8
PH
1324if (defined $rsf && -e $rsf)
1325 {
1326 print MUNGED "\n******** SERVER ********\n";
c9a55f6a 1327 $truncated |= munge($rsf, $extra);
151b83f8
PH
1328 }
1329close(MUNGED);
1330
1331# If a saved file exists, do the comparison. There are two awkward cases:
1332#
1333# If "*** truncated ***" was found in the new file, it means that a log line
1334# was overlong, and truncated. The problem is that it may be truncated at
1335# different points on different systems, because of different user name
1336# lengths. We reload the file and the saved file, and remove lines from the new
1337# file that precede "*** truncated ***" until we reach one that matches the
1338# line that precedes it in the saved file.
1339#
1340# If $sortfile is set, we are dealing with a mainlog file where the deliveries
1341# for an individual message might vary in their order from system to system, as
1342# a result of parallel deliveries. We load the munged file and sort sequences
1343# of delivery lines.
1344
28e8a0f7 1345if (-e $sf_current)
151b83f8
PH
1346 {
1347 # Deal with truncated text items
1348
1349 if ($truncated)
1350 {
1351 my(@munged, @saved, $i, $j, $k);
1352
9edef117 1353 open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");
151b83f8
PH
1354 @munged = <MUNGED>;
1355 close(MUNGED);
28e8a0f7 1356 open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $sf_current: $!");
151b83f8
PH
1357 @saved = <SAVED>;
1358 close(SAVED);
1359
1360 $j = 0;
1361 for ($i = 0; $i < @munged; $i++)
1362 {
1363 if ($munged[$i] =~ /\*\*\* truncated \*\*\*/)
1364 {
1365 for (; $j < @saved; $j++)
1366 { last if $saved[$j] =~ /\*\*\* truncated \*\*\*/; }
1367 last if $j >= @saved; # not found in saved
1368
1369 for ($k = $i - 1; $k >= 0; $k--)
1370 { last if $munged[$k] eq $saved[$j - 1]; }
1371
1372 last if $k <= 0; # failed to find previous match
1373 splice @munged, $k + 1, $i - $k - 1;
1374 $i = $k + 1;
1375 }
1376 }
1377
9edef117 1378 open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
151b83f8
PH
1379 for ($i = 0; $i < @munged; $i++)
1380 { print MUNGED $munged[$i]; }
1381 close(MUNGED);
1382 }
1383
1384 # Deal with log sorting
1385
1386 if ($sortfile)
1387 {
1388 my(@munged, $i, $j);
1389
9edef117 1390 open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");
151b83f8
PH
1391 @munged = <MUNGED>;
1392 close(MUNGED);
1393
1394 for ($i = 0; $i < @munged; $i++)
1395 {
1396 if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/)
1397 {
1398 for ($j = $i + 1; $j < @munged; $j++)
1399 {
1400 last if $munged[$j] !~
1401 /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/;
1402 }
1403 @temp = splice(@munged, $i, $j - $i);
1404 @temp = sort(@temp);
1405 splice(@munged, $i, 0, @temp);
1406 }
1407 }
1408
1409 open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
1410 print MUNGED "**NOTE: The delivery lines in this file have been sorted.\n";
1411 for ($i = 0; $i < @munged; $i++)
1412 { print MUNGED $munged[$i]; }
1413 close(MUNGED);
1414 }
1415
1416 # Do the comparison
1417
28e8a0f7 1418 return 0 if (system("$cf '$mf' '$sf_current' >test-cf") == 0);
151b83f8
PH
1419
1420 # Handle comparison failure
1421
28e8a0f7 1422 print "** Comparison of $mf with $sf_current failed";
151b83f8
PH
1423 system("$more test-cf");
1424
1425 print "\n";
1426 for (;;)
1427 {
0df394b5
HSHR
1428 $_ = interact('Continue, Retry, Update current'
1429 . ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : '')
1430 . ' & retry, Quit? [Q] ', $force_update, $force_continue);
1431 tests_exit(1) if /^q?$/;
a4ecb6a7
JH
1432 if (/^c$/ && $force_continue) {
1433 log_failure($log_failed_filename, $testno, $sf_current);
1434 log_test($log_summary_filename, $testno, 'F')
1435 }
1436 return 1 if /^c$/i;
1437 return 2 if /^r$/i;
28e8a0f7 1438 last if (/^[us]$/i);
151b83f8
PH
1439 }
1440 }
1441
1442# Update or delete the saved file, and give the appropriate return code.
1443
1444if (-s $mf)
28e8a0f7 1445 {
a4ecb6a7
JH
1446 my $sf = /^u/i ? $sf_current : $sf_flavour;
1447 tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0;
28e8a0f7 1448 }
151b83f8 1449else
28e8a0f7 1450 {
a4ecb6a7
JH
1451 # if we deal with a flavour file, we can't delete it, because next time the generic
1452 # file would be used again
1453 if ($sf_current eq $sf_flavour) {
1454 open(FOO, ">$sf_current");
1455 close(FOO);
1456 }
1457 else {
1458 tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current);
1459 }
28e8a0f7 1460 }
151b83f8 1461
a4ecb6a7 1462return 2;
151b83f8
PH
1463}
1464
1465
1466
1467##################################################
c9a55f6a
JH
1468# Custom munges
1469# keyed by name of munge; value is a ref to a hash
1470# which is keyed by file, value a string to look for.
1471# Usable files are:
1472# paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail
1473# Search strings starting with 's' do substitutions;
1474# with '/' do line-skips.
74377a62 1475# Triggered by a scriptfile line "munge <name>"
c9a55f6a
JH
1476##################################################
1477$munges =
1478 { 'dnssec' =>
cf407cb6 1479 { 'stderr' => '/^Reverse DNS security status: unverified\n/' },
c9a55f6a
JH
1480
1481 'gnutls_unexpected' =>
cf407cb6 1482 { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./' },
c9a55f6a
JH
1483
1484 'gnutls_handshake' =>
cf407cb6 1485 { 'mainlog' => 's/\(gnutls_handshake\): Error in the push function/\(gnutls_handshake\): A TLS packet with unexpected length was received/' },
c9a55f6a 1486
74377a62 1487 'optional_events' =>
cf407cb6 1488 { 'stdout' => '/event_action =/' },
74377a62
JH
1489
1490 'optional_ocsp' =>
cf407cb6
JH
1491 { 'stderr' => '/127.0.0.1 in hosts_requ(ire|est)_ocsp/' },
1492
79547a5a
JH
1493 'optional_cert_hostnames' =>
1494 { 'stderr' => '/in tls_verify_cert_hostnames\? no/' },
1495
ac9a0d91
JH
1496 'loopback' =>
1497 { 'stdout' => 's/[[](127\.0\.0\.1|::1)]/[IP_LOOPBACK_ADDR]/' },
1498
35deab6a
JH
1499 'scanfile_size' =>
1500 { 'stdout' => 's/(Content-length:) \d\d\d/$1 ddd/' },
1501
846430d9
JH
1502 'delay_1500' =>
1503 { 'stderr' => 's/(1[5-9]|23\d)\d\d msec/ssss msec/' },
1504
b3ef41c9
JH
1505 'tls_anycipher' =>
1506 { 'mainlog' => 's/ X=TLS\S+ / X=TLS_proto_and_cipher /' },
1507
ae9d18bc 1508 'debug_pid' =>
b1cf8494 1509 { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d{1,5}/ppppp/g' },
ae9d18bc 1510
d658adda
JH
1511 'optional_dsn_info' =>
1512 { 'mail' => '/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/'
6636495c
JH
1513 },
1514
06685b44 1515 'optional_config' =>
4dce3152
JH
1516 { 'stdout' => '/^(
1517 dkim_(canon|domain|private_key|selector|sign_headers|strict)
1518 |gnutls_require_(kx|mac|protocols)
1519 |hosts_(requ(est|ire)|try)_(dane|ocsp)
1520 |hosts_(avoid|nopass|require|verify_avoid)_tls
06685b44 1521 |socks_proxy
4dce3152
JH
1522 |tls_[^ ]*
1523 )($|[ ]=)/x' },
79c904e1 1524
6636495c 1525 'sys_bindir' =>
7329ca93 1526 { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' },
d658adda 1527
a0418528
JH
1528 'sync_check_data' =>
1529 { 'mainlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/',
1530 'rejectlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/'},
1531
b0d68adc 1532 'debuglog_stdout' =>
398f9af3 1533 { 'stdout' => 's/^\d\d:\d\d:\d\d\s+\d+ //;
b0d68adc
JH
1534 s/Process \d+ is ready for new message/Process pppp is ready for new message/'
1535 },
74ba91b1
JH
1536
1537 'timeout_errno' => # actual errno differs Solaris vs. Linux
1538 { 'mainlog' => 's/(host deferral .* errno) <\d+> /$1 <EEE> /' },
c9a55f6a
JH
1539 };
1540
1541
a4ecb6a7
JH
1542sub max {
1543 my ($a, $b) = @_;
1544 return $a if ($a > $b);
1545 return $b;
1546}
1547
c9a55f6a 1548##################################################
151b83f8
PH
1549# Subroutine to check the output of a test #
1550##################################################
1551
1552# This function is called when the series of subtests is complete. It makes
c9a55f6a 1553# use of check_file(), whose arguments are:
151b83f8
PH
1554#
1555# [0] the name of the main raw output file
1556# [1] the name of the server raw output file or undef
1557# [2] where to put the munged copy
1558# [3] the name of the saved file
1559# [4] TRUE if this is a log file whose deliveries must be sorted
c9a55f6a 1560# [5] an optional custom munge command
151b83f8 1561#
ac9a0d91 1562# Arguments: Optionally, name of a single custom munge to run.
151b83f8 1563# Returns: 0 if the output compared equal
a4ecb6a7
JH
1564# 1 if comparison failed; differences to be ignored
1565# 2 if re-run needed (files may have been updated)
151b83f8
PH
1566
1567sub check_output{
c9a55f6a 1568my($mungename) = $_[0];
151b83f8 1569my($yield) = 0;
c9a55f6a 1570my($munge) = $munges->{$mungename} if defined $mungename;
151b83f8 1571
a4ecb6a7 1572$yield = max($yield, check_file("spool/log/paniclog",
151b83f8
PH
1573 "spool/log/serverpaniclog",
1574 "test-paniclog-munged",
c9a55f6a 1575 "paniclog/$testno", 0,
a4ecb6a7 1576 $munge->{paniclog}));
151b83f8 1577
a4ecb6a7 1578$yield = max($yield, check_file("spool/log/rejectlog",
151b83f8
PH
1579 "spool/log/serverrejectlog",
1580 "test-rejectlog-munged",
c9a55f6a 1581 "rejectlog/$testno", 0,
a4ecb6a7 1582 $munge->{rejectlog}));
151b83f8 1583
a4ecb6a7 1584$yield = max($yield, check_file("spool/log/mainlog",
151b83f8
PH
1585 "spool/log/servermainlog",
1586 "test-mainlog-munged",
c9a55f6a 1587 "log/$testno", $sortlog,
a4ecb6a7 1588 $munge->{mainlog}));
151b83f8
PH
1589
1590if (!$stdout_skip)
1591 {
a4ecb6a7 1592 $yield = max($yield, check_file("test-stdout",
151b83f8
PH
1593 "test-stdout-server",
1594 "test-stdout-munged",
c9a55f6a 1595 "stdout/$testno", 0,
a4ecb6a7 1596 $munge->{stdout}));
151b83f8
PH
1597 }
1598
1599if (!$stderr_skip)
1600 {
a4ecb6a7 1601 $yield = max($yield, check_file("test-stderr",
151b83f8
PH
1602 "test-stderr-server",
1603 "test-stderr-munged",
c9a55f6a 1604 "stderr/$testno", 0,
a4ecb6a7 1605 $munge->{stderr}));
151b83f8
PH
1606 }
1607
1608# Compare any delivered messages, unless this test is skipped.
1609
1610if (! $message_skip)
1611 {
1612 my($msgno) = 0;
1613
1614 # Get a list of expected mailbox files for this script. We don't bother with
1615 # directories, just the files within them.
1616
1617 foreach $oldmail (@oldmails)
1618 {
1619 next unless $oldmail =~ /^mail\/$testno\./;
1620 print ">> EXPECT $oldmail\n" if $debug;
1621 $expected_mails{$oldmail} = 1;
1622 }
1623
1624 # If there are any files in test-mail, compare them. Note that "." and
1625 # ".." are automatically omitted by list_files_below().
1626
1627 @mails = list_files_below("test-mail");
1628
1629 foreach $mail (@mails)
1630 {
1631 next if $mail eq "test-mail/oncelog";
1632
1633 $saved_mail = substr($mail, 10); # Remove "test-mail/"
1634 $saved_mail =~ s/^$parm_caller(\/|$)/CALLER/; # Convert caller name
1635
1636 if ($saved_mail =~ /(\d+\.[^.]+\.)/)
1637 {
1638 $msgno++;
1639 $saved_mail =~ s/(\d+\.[^.]+\.)/$msgno./gx;
1640 }
1641
1642 print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
a4ecb6a7 1643 $yield = max($yield, check_file($mail, undef, "test-mail-munged",
c9a55f6a 1644 "mail/$testno.$saved_mail", 0,
a4ecb6a7 1645 $munge->{mail}));
151b83f8
PH
1646 delete $expected_mails{"mail/$testno.$saved_mail"};
1647 }
1648
1649 # Complain if not all expected mails have been found
1650
1651 if (scalar(keys %expected_mails) != 0)
1652 {
1653 foreach $key (keys %expected_mails)
1654 { print "** no test file found for $key\n"; }
1655
1656 for (;;)
1657 {
0df394b5
HSHR
1658 $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
1659 tests_exit(1) if /^q?$/;
a4ecb6a7
JH
1660 if (/^c$/ && $force_continue) {
1661 log_failure($log_failed_filename, $testno, "missing email");
1662 log_test($log_summary_filename, $testno, 'F')
1663 }
0df394b5 1664 last if /^c$/;
151b83f8
PH
1665
1666 # For update, we not only have to unlink the file, but we must also
1667 # remove it from the @oldmails vector, as otherwise it will still be
1668 # checked for when we re-run the test.
1669
0df394b5 1670 if (/^u$/)
151b83f8
PH
1671 {
1672 foreach $key (keys %expected_mails)
1673 {
1674 my($i);
1675 tests_exit(-1, "Failed to unlink $key") if !unlink("$key");
1676 for ($i = 0; $i < @oldmails; $i++)
1677 {
1678 if ($oldmails[$i] eq $key)
1679 {
1680 splice @oldmails, $i, 1;
1681 last;
1682 }
1683 }
1684 }
1685 last;
1686 }
1687 }
1688 }
1689 }
1690
1691# Compare any remaining message logs, unless this test is skipped.
1692
1693if (! $msglog_skip)
1694 {
1695 # Get a list of expected msglog files for this test
1696
1697 foreach $oldmsglog (@oldmsglogs)
1698 {
1699 next unless $oldmsglog =~ /^$testno\./;
1700 $expected_msglogs{$oldmsglog} = 1;
1701 }
1702
1703 # If there are any files in spool/msglog, compare them. However, we have
1704 # to munge the file names because they are message ids, which are
1705 # time dependent.
1706
1707 if (opendir(DIR, "spool/msglog"))
1708 {
1709 @msglogs = sort readdir(DIR);
1710 closedir(DIR);
1711
1712 foreach $msglog (@msglogs)
1713 {
1714 next if ($msglog eq "." || $msglog eq ".." || $msglog eq "CVS");
1715 ($munged_msglog = $msglog) =~
1716 s/((?:[^\W_]{6}-){2}[^\W_]{2})
1717 /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
a4ecb6a7 1718 $yield = max($yield, check_file("spool/msglog/$msglog", undef,
c9a55f6a 1719 "test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
a4ecb6a7 1720 $munge->{msglog}));
151b83f8
PH
1721 delete $expected_msglogs{"$testno.$munged_msglog"};
1722 }
1723 }
1724
1725 # Complain if not all expected msglogs have been found
1726
1727 if (scalar(keys %expected_msglogs) != 0)
1728 {
1729 foreach $key (keys %expected_msglogs)
1730 {
1731 print "** no test msglog found for msglog/$key\n";
1732 ($msgid) = $key =~ /^\d+\.(.*)$/;
1733 foreach $cachekey (keys %cache)
1734 {
1735 if ($cache{$cachekey} eq $msgid)
1736 {
1737 print "** original msgid $cachekey\n";
1738 last;
1739 }
1740 }
1741 }
1742
1743 for (;;)
1744 {
0df394b5
HSHR
1745 $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
1746 tests_exit(1) if /^q?$/;
a4ecb6a7
JH
1747 if (/^c$/ && $force_continue) {
1748 log_failure($log_failed_filename, $testno, "missing msglog");
1749 log_test($log_summary_filename, $testno, 'F')
1750 }
0df394b5
HSHR
1751 last if /^c$/;
1752 if (/^u$/)
151b83f8
PH
1753 {
1754 foreach $key (keys %expected_msglogs)
1755 {
1756 tests_exit(-1, "Failed to unlink msglog/$key")
1757 if !unlink("msglog/$key");
1758 }
1759 last;
1760 }
1761 }
1762 }
1763 }
1764
1765return $yield;
1766}
1767
1768
1769
1770##################################################
1771# Subroutine to run one "system" command #
1772##################################################
1773
1774# We put this in a subroutine so that the command can be reflected when
1775# debugging.
1776#
1777# Argument: the command to be run
1778# Returns: nothing
1779
1780sub run_system {
050514b5
JH
1781my($cmd) = $_[0];
1782if ($debug)
1783 {
1784 my($prcmd) = $cmd;
1785 $prcmd =~ s/; /;\n>> /;
1786 print ">> $prcmd\n";
1787 }
1788system("$cmd");
151b83f8
PH
1789}
1790
1791
1792
1793##################################################
1794# Subroutine to run one script command #
1795##################################################
1796
1797# The <SCRIPT> file is open for us to read an optional return code line,
1798# followed by the command line and any following data lines for stdin. The
1799# command line can be continued by the use of \. Data lines are not continued
4c04137d 1800# in this way. In all lines, the following substitutions are made:
151b83f8
PH
1801#
1802# DIR => the current directory
1803# CALLER => the caller of this script
1804#
1805# Arguments: the current test number
1806# reference to the subtest number, holding previous value
1807# reference to the expected return code value
1808# reference to where to put the command name (for messages)
4c04137d 1809# auxiliary information returned from a previous run
151b83f8 1810#
4c04137d 1811# Returns: 0 the command was executed inline, no subprocess was run
151b83f8
PH
1812# 1 a non-exim command was run and waited for
1813# 2 an exim command was run and waited for
1814# 3 a command was run and not waited for (daemon, server, exim_lock)
1815# 4 EOF was encountered after an initial return code line
4c04137d 1816# Optionally also a second parameter, a hash-ref, with auxiliary information:
1ca9f507 1817# exim_pid: pid of a run process
c9a55f6a 1818# munge: name of a post-script results munger
151b83f8
PH
1819
1820sub run_command{
1821my($testno) = $_[0];
1822my($subtestref) = $_[1];
1823my($commandnameref) = $_[3];
1ca9f507 1824my($aux_info) = $_[4];
151b83f8
PH
1825my($yield) = 1;
1826
bc3c7bb7
HSHR
1827our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
1828
151b83f8
PH
1829if (/^(\d+)\s*$/) # Handle unusual return code
1830 {
1831 my($r) = $_[2];
1832 $$r = $1 << 8;
1833 $_ = <SCRIPT>;
1834 return 4 if !defined $_; # Missing command
1835 $lineno++;
1836 }
1837
1838chomp;
1839$wait_time = 0;
1840
1841# Handle concatenated command lines
1842
1843s/\s+$//;
1844while (substr($_, -1) eq"\\")
1845 {
1846 my($temp);
1847 $_ = substr($_, 0, -1);
1848 chomp($temp = <SCRIPT>);
1849 if (defined $temp)
1850 {
1851 $lineno++;
1852 $temp =~ s/\s+$//;
1853 $temp =~ s/^\s+//;
1854 $_ .= $temp;
1855 }
1856 }
1857
1858# Do substitutions
1859
1860do_substitute($testno);
1861if ($debug) { printf ">> $_\n"; }
1862
1863# Pass back the command name (for messages)
1864
1865($$commandnameref) = /^(\S+)/;
1866
1867# Here follows code for handling the various different commands that are
1868# supported by this script. The first group of commands are all freestanding
1869# in that they share no common code and are not followed by any data lines.
1870
1871
1872###################
1873###################
1874
1875# The "dbmbuild" command runs exim_dbmbuild. This is used both to test the
1876# utility and to make DBM files for testing DBM lookups.
1877
1878if (/^dbmbuild\s+(\S+)\s+(\S+)/)
1879 {
1880 run_system("(./eximdir/exim_dbmbuild $parm_cwd/$1 $parm_cwd/$2;" .
1881 "echo exim_dbmbuild exit code = \$?)" .
1882 ">>test-stdout");
1883 return 1;
1884 }
1885
1886
1887# The "dump" command runs exim_dumpdb. On different systems, the output for
1888# some types of dump may appear in a different order because it's just hauled
1889# out of the DBM file. We can solve this by sorting. Ignore the leading
1890# date/time, as it will be flattened later during munging.
1891
1892if (/^dump\s+(\S+)/)
1893 {
1894 my($which) = $1;
1895 my(@temp);
1896 print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
1897 open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");
a0ff7619
JH
1898 open(OUT, ">>test-stdout");
1899 print OUT "+++++++++++++++++++++++++++\n";
1900
1901 if ($which eq "retry")
151b83f8 1902 {
a0ff7619
JH
1903 $/ = "\n ";
1904 @temp = <IN>;
1905 $/ = "\n";
1906
151b83f8 1907 @temp = sort {
a0ff7619
JH
1908 my($aa) = split(' ', $a);
1909 my($bb) = split(' ', $b);
1910 return $aa cmp $bb;
151b83f8 1911 } @temp;
a0ff7619
JH
1912
1913 foreach $item (@temp)
1914 {
7f8794a2 1915 $item =~ s/^\s*(.*)\n(.*)\n?\s*$/$1\n$2/m;
a0ff7619
JH
1916 print OUT " $item\n";
1917 }
151b83f8 1918 }
a0ff7619
JH
1919 else
1920 {
1921 @temp = <IN>;
1922 if ($which eq "callout")
1923 {
1924 @temp = sort {
1925 my($aa) = substr $a, 21;
1926 my($bb) = substr $b, 21;
1927 return $aa cmp $bb;
1928 } @temp;
1929 }
1930 print OUT @temp;
1931 }
1932
1933 close(IN);
151b83f8
PH
1934 close(OUT);
1935 return 1;
1936 }
1937
1938
4cc77633
HSHR
1939# verbose comments start with ###
1940if (/^###\s/) {
1941 for my $file (qw(test-stdout test-stderr test-stderr-server test-stdout-server)) {
1942 open my $fh, '>>', $file or die "Can't open >>$file: $!\n";
1943 say {$fh} $_;
1944 }
1945 return 0;
1946}
151b83f8 1947
9edef117 1948# The "echo" command is a way of writing comments to the screen.
151b83f8
PH
1949if (/^echo\s+(.*)$/)
1950 {
1951 print "$1\n";
1952 return 0;
1953 }
1954
1955
1956# The "exim_lock" command runs exim_lock in the same manner as "server",
1957# but it doesn't use any input.
1958
1959if (/^exim_lock\s+(.*)$/)
1960 {
1961 $cmd = "./eximdir/exim_lock $1 >>test-stdout";
1962 $server_pid = open SERVERCMD, "|$cmd" ||
1963 tests_exit(-1, "Failed to run $cmd\n");
1964
1965 # This gives the process time to get started; otherwise the next
1966 # process may not find it there when it expects it.
1967
6588a918 1968 select(undef, undef, undef, 0.1);
151b83f8
PH
1969 return 3;
1970 }
1971
1972
1973# The "exinext" command runs exinext
1974
1975if (/^exinext\s+(.*)/)
1976 {
1977 run_system("(./eximdir/exinext " .
1978 "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
1979 "-C $parm_cwd/test-config $1;" .
1980 "echo exinext exit code = \$?)" .
1981 ">>test-stdout");
1982 return 1;
1983 }
1984
1985
f3f065bb
PH
1986# The "exigrep" command runs exigrep on the current mainlog
1987
1988if (/^exigrep\s+(.*)/)
1989 {
1990 run_system("(./eximdir/exigrep " .
1991 "$1 $parm_cwd/spool/log/mainlog;" .
1992 "echo exigrep exit code = \$?)" .
1993 ">>test-stdout");
1994 return 1;
1995 }
1996
1997
1998# The "eximstats" command runs eximstats on the current mainlog
1999
2000if (/^eximstats\s+(.*)/)
2001 {
2002 run_system("(./eximdir/eximstats " .
2003 "$1 $parm_cwd/spool/log/mainlog;" .
2004 "echo eximstats exit code = \$?)" .
2005 ">>test-stdout");
2006 return 1;
2007 }
2008
2009
151b83f8
PH
2010# The "gnutls" command makes a copy of saved GnuTLS parameter data in the
2011# spool directory, to save Exim from re-creating it each time.
2012
2013if (/^gnutls/)
2014 {
83e2f8a2
PP
2015 my $gen_fn = "spool/gnutls-params-$gnutls_dh_bits_normal";
2016 run_system "sudo cp -p aux-fixed/gnutls-params $gen_fn;" .
2017 "sudo chown $parm_eximuser:$parm_eximgroup $gen_fn;" .
2018 "sudo chmod 0400 $gen_fn";
151b83f8
PH
2019 return 1;
2020 }
2021
2022
2023# The "killdaemon" command should ultimately follow the starting of any Exim
2024# daemon with the -bd option. We kill with SIGINT rather than SIGTERM to stop
2025# it outputting "Terminated" to the terminal when not in the background.
2026
2027if (/^killdaemon/)
2028 {
1ca9f507
PP
2029 my $return_extra = {};
2030 if (exists $aux_info->{exim_pid})
2031 {
2032 $pid = $aux_info->{exim_pid};
2033 $return_extra->{exim_pid} = undef;
2034 print ">> killdaemon: recovered pid $pid\n" if $debug;
3ff2360f
JH
2035 if ($pid)
2036 {
ed54e8ae 2037 run_system("sudo /bin/kill -INT $pid");
3ff2360f
JH
2038 wait;
2039 }
1ca9f507
PP
2040 } else {
2041 $pid = `cat $parm_cwd/spool/exim-daemon.*`;
3ff2360f
JH
2042 if ($pid)
2043 {
ed54e8ae 2044 run_system("sudo /bin/kill -INT $pid");
3ff2360f
JH
2045 close DAEMONCMD; # Waits for process
2046 }
1ca9f507 2047 }
3ff2360f 2048 run_system("sudo /bin/rm -f spool/exim-daemon.*");
1ca9f507 2049 return (1, $return_extra);
151b83f8
PH
2050 }
2051
2052
2053# The "millisleep" command is like "sleep" except that its argument is in
2054# milliseconds, thus allowing for a subsecond sleep, which is, in fact, all it
2055# is used for.
2056
2057elsif (/^millisleep\s+(.*)$/)
2058 {
2059 select(undef, undef, undef, $1/1000);
2060 return 0;
2061 }
2062
2063
c9a55f6a
JH
2064# The "munge" command selects one of a hardwired set of test-result modifications
2065# to be made before result compares are run agains the golden set. This lets
2066# us account for test-system dependent things which only affect a few, but known,
2067# test-cases.
2068# Currently only the last munge takes effect.
2069
2070if (/^munge\s+(.*)$/)
2071 {
2072 return (0, { munge => $1 });
2073 }
2074
2075
151b83f8
PH
2076# The "sleep" command does just that. For sleeps longer than 1 second we
2077# tell the user what's going on.
2078
2079if (/^sleep\s+(.*)$/)
2080 {
2081 if ($1 == 1)
2082 {
2083 sleep(1);
2084 }
2085 else
2086 {
2087 printf(" Test %d sleep $1 ", $$subtestref);
2088 for (1..$1)
2089 {
2090 print ".";
2091 sleep(1);
2092 }
2093 printf("\r Test %d $cr", $$subtestref);
2094 }
2095 return 0;
2096 }
2097
2098
2099# Various Unix management commands are recognized
2100
21c28500 2101if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ ||
4e192008 2102 /^sudo\s(rmdir|rm|mv|chown|chmod)\s/)
151b83f8
PH
2103 {
2104 run_system("$_ >>test-stdout 2>>test-stderr");
2105 return 1;
2106 }
2107
2108
2109
2110###################
2111###################
2112
2113# The next group of commands are also freestanding, but they are all followed
2114# by data lines.
2115
2116
2117# The "server" command starts up a script-driven server that runs in parallel
2118# with the following exim command. Therefore, we want to run a subprocess and
2119# not yet wait for it to complete. The waiting happens after the next exim
2120# command, triggered by $server_pid being non-zero. The server sends its output
2121# to a different file. The variable $server_opts, if not empty, contains
2122# options to disable IPv4 or IPv6 if necessary.
b9d9c5a2 2123# This works because "server" swallows its stdin before waiting for a connection.
151b83f8
PH
2124
2125if (/^server\s+(.*)$/)
2126 {
f41e0506
JH
2127 $pidfile = "$parm_cwd/aux-var/server-daemon.pid";
2128 $cmd = "./bin/server $server_opts -oP $pidfile $1 >>test-stdout-server";
151b83f8
PH
2129 print ">> $cmd\n" if ($debug);
2130 $server_pid = open SERVERCMD, "|$cmd" || tests_exit(-1, "Failed to run $cmd");
2131 SERVERCMD->autoflush(1);
2132 print ">> Server pid is $server_pid\n" if $debug;
2133 while (<SCRIPT>)
2134 {
2135 $lineno++;
2136 last if /^\*{4}\s*$/;
2137 print SERVERCMD;
2138 }
2139 print SERVERCMD "++++\n"; # Send end to server; can't send EOF yet
2140 # because close() waits for the process.
2141
f41e0506 2142 # Interlock the server startup; otherwise the next
151b83f8 2143 # process may not find it there when it expects it.
f41e0506 2144 while (! stat("$pidfile") ) { select(undef, undef, undef, 0.3); }
151b83f8
PH
2145 return 3;
2146 }
2147
2148
2149# The "write" command is a way of creating files of specific sizes for
2150# buffering tests, or containing specific data lines from within the script
2151# (rather than hold lots of little files). The "catwrite" command does the
2152# same, but it also copies the lines to test-stdout.
2153
2154if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/)
2155 {
2156 my($cat) = defined $1;
2157 @sizes = ();
2158 @sizes = split /\s+/, $3 if defined $3;
2159 open FILE, ">$2" || tests_exit(-1, "Failed to open \"$2\": $!");
2160
2161 if ($cat)
2162 {
2163 open CAT, ">>test-stdout" ||
2164 tests_exit(-1, "Failed to open test-stdout: $!");
2165 print CAT "==========\n";
2166 }
2167
2168 if (scalar @sizes > 0)
2169 {
2170 # Pre-data
2171
2172 while (<SCRIPT>)
2173 {
2174 $lineno++;
2175 last if /^\+{4}\s*$/;
2176 print FILE;
2177 print CAT if $cat;
2178 }
2179
2180 # Sized data
2181
2182 while (scalar @sizes > 0)
2183 {
2184 ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
9a8a6839 2185 $leadin = '' if !defined $leadin;
151b83f8
PH
2186 $leadin =~ s/_/ /g;
2187 $len -= length($leadin) + 1;
2188 while ($count-- > 0)
2189 {
2190 print FILE $leadin, "a" x $len, "\n";
2191 print CAT $leadin, "a" x $len, "\n" if $cat;
2192 }
2193 }
2194 }
2195
2196 # Post data, or only data if no sized data
2197
2198 while (<SCRIPT>)
2199 {
2200 $lineno++;
2201 last if /^\*{4}\s*$/;
2202 print FILE;
2203 print CAT if $cat;
2204 }
2205 close FILE;
2206
2207 if ($cat)
2208 {
2209 print CAT "==========\n";
2210 close CAT;
2211 }
2212
2213 return 0;
2214 }
2215
2216
2217###################
2218###################
2219
2220# From this point on, script commands are implemented by setting up a shell
2221# command in the variable $cmd. Shared code to run this command and handle its
2222# input and output follows.
2223
cfc54830
PH
2224# The "client", "client-gnutls", and "client-ssl" commands run a script-driven
2225# program that plays the part of an email client. We also have the availability
2226# of running Perl for doing one-off special things. Note that all these
2227# commands expect stdin data to be supplied.
151b83f8 2228
cfc54830 2229if (/^client/ || /^(sudo\s+)?perl\b/)
151b83f8
PH
2230 {
2231 s"client"./bin/client";
2232 $cmd = "$_ >>test-stdout 2>>test-stderr";
2233 }
2234
2235# For the "exim" command, replace the text "exim" with the path for the test
2236# binary, plus -D options to pass over various parameters, and a -C option for
2237# the testing configuration file. When running in the test harness, Exim does
2238# not drop privilege when -C and -D options are present. To run the exim
2239# command as root, we use sudo.
2240
bc3c7bb7 2241elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/)
151b83f8 2242 {
4c7220eb 2243 $args = $6;
9a8a6839
HSHR
2244 my($envset) = (defined $1)? $1 : '';
2245 my($sudo) = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":'') : '';
2246 my($special)= (defined $5)? $5 : '';
151b83f8
PH
2247 $wait_time = (defined $2)? $2 : 0;
2248
2249 # Return 2 rather than 1 afterwards
2250
2251 $yield = 2;
2252
2253 # Update the test number
2254
2255 $$subtestref = $$subtestref + 1;
2256 printf(" Test %d $cr", $$subtestref);
2257
2258 # Copy the configuration file, making the usual substitutions.
2259
2260 open (IN, "$parm_cwd/confs/$testno") ||
2261 tests_exit(-1, "Couldn't open $parm_cwd/confs/$testno: $!\n");
2262 open (OUT, ">test-config") ||
2263 tests_exit(-1, "Couldn't open test-config: $!\n");
2264 while (<IN>)
2265 {
2266 do_substitute($testno);
2267 print OUT;
2268 }
2269 close(IN);
2270 close(OUT);
2271
2272 # The string $msg1 in args substitutes the message id of the first
2273 # message on the queue, and so on. */
2274
2275 if ($args =~ /\$msg/)
2276 {
562a0e6f
HSHR
2277 my @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
2278 "-DEXIM_PATH=$parm_cwd/eximdir/exim",
2279 -C => "$parm_cwd/test-config");
2280 print ">> Getting queue list from:\n>> @listcmd\n" if $debug;
b402f294
HSHR
2281 # We need the message ids sorted in ascending order.
2282 # Message id is: <timestamp>-<pid>-<fractional-time>. On some systems (*BSD) the
2283 # PIDs are randomized, so sorting just the whole PID doesn't work.
2284 # We do the Schartz' transformation here (sort on
2285 # <timestamp><fractional-time>). Thanks to Kirill Miazine
562a0e6f
HSHR
2286 my @msglist =
2287 map { $_->[1] } # extract the values
2288 sort { $a->[0] cmp $b->[0] } # sort by key
2289 map { [join('.' => (split /-/, $_)[0,2]) => $_] } # key (timestamp.fractional-time) => value(message_id)
2290 map { /^\s*\d+[smhdw]\s+\S+\s+(\S+)/ } `@listcmd` or tests_exit(-1, "No output from `exim -bp` (@listcmd)\n");
151b83f8
PH
2291
2292 # Done backwards just in case there are more than 9
2293
25adc2a8 2294 for (my $i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; }
3ff2360f
JH
2295 if ( $args =~ /\$msg\d/ )
2296 {
8334b9b8
TL
2297 tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n")
2298 unless $force_continue;
3ff2360f 2299 }
151b83f8
PH
2300 }
2301
2302 # If -d is specified in $optargs, remove it from $args; i.e. let
2303 # the command line for runtest override. Then run Exim.
2304
2305 $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/;
2306
9a8a6839 2307 my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : '';
2c9f7ff8
JH
2308
2309 $cmd = "$envset$sudo$opt_valgrind" .
2310 "$parm_cwd/eximdir/exim$special$optargs " .
151b83f8
PH
2311 "-DEXIM_PATH=$parm_cwd/eximdir/exim$special " .
2312 "-C $parm_cwd/test-config $args " .
2313 ">>test-stdout 2>>test-stderr";
151b83f8
PH
2314 # If the command is starting an Exim daemon, we run it in the same
2315 # way as the "server" command above, that is, we don't want to wait
2316 # for the process to finish. That happens when "killdaemon" is obeyed later
2317 # in the script. We also send the stderr output to test-stderr-server. The
2318 # daemon has its log files put in a different place too (by configuring with
2319 # log_file_path). This requires the directory to be set up in advance.
2320 #
2321 # There are also times when we want to run a non-daemon version of Exim
2322 # (e.g. a queue runner) with the server configuration. In this case,
2323 # we also define -DNOTDAEMON.
2324
2325 if ($cmd =~ /\s-DSERVER=server\s/ && $cmd !~ /\s-DNOTDAEMON\s/)
2326 {
2327 if ($debug) { printf ">> daemon: $cmd\n"; }
050514b5 2328 run_system("sudo mkdir spool/log 2>/dev/null");
151b83f8
PH
2329 run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log");
2330
2331 # Before running the command, convert the -bd option into -bdf so that an
2332 # Exim daemon doesn't double fork. This means that when we wait close
1b781f48
PH
2333 # DAEMONCMD, it waits for the correct process. Also, ensure that the pid
2334 # file is written to the spool directory, in case the Exim binary was
2335 # built with PID_FILE_PATH pointing somewhere else.
151b83f8 2336
f41e0506
JH
2337 if ($cmd =~ /\s-oP\s/)
2338 {
2339 ($pidfile = $cmd) =~ s/^.*-oP ([^ ]+).*$/$1/;
2340 $cmd =~ s!\s-bd\s! -bdf !;
2341 }
2342 else
2343 {
2344 $pidfile = "$parm_cwd/spool/exim-daemon.pid";
2345 $cmd =~ s!\s-bd\s! -bdf -oP $pidfile !;
2346 }
151b83f8
PH
2347 print ">> |${cmd}-server\n" if ($debug);
2348 open DAEMONCMD, "|${cmd}-server" || tests_exit(-1, "Failed to run $cmd");
2349 DAEMONCMD->autoflush(1);
2350 while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input
f41e0506
JH
2351
2352 # Interlock with daemon startup
109b7eb1
JH
2353 for (my $count = 0; ! stat("$pidfile") && $count < 30; $count++ )
2354 { select(undef, undef, undef, 0.3); }
151b83f8
PH
2355 return 3; # Don't wait
2356 }
1ca9f507
PP
2357 elsif ($cmd =~ /\s-DSERVER=wait:(\d+)\s/)
2358 {
df613eb4
HSHR
2359
2360 # The port and the $dynamic_socket was already allocated while parsing the
2361 # script file, where -DSERVER=wait:PORT_DYNAMIC was encountered.
2362
1ca9f507
PP
2363 my $listen_port = $1;
2364 if ($debug) { printf ">> wait-mode daemon: $cmd\n"; }
050514b5 2365 run_system("sudo mkdir spool/log 2>/dev/null");
1ca9f507
PP
2366 run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log");
2367
1ca9f507
PP
2368 my $pid = fork();
2369 if (not defined $pid) { die "** fork failed: $!\n" }
2370 if (not $pid) {
2371 close(STDIN);
df613eb4
HSHR
2372 open(STDIN, '<&', $dynamic_socket) or die "** dup sock to stdin failed: $!\n";
2373 close($dynamic_socket);
1ca9f507
PP
2374 print "[$$]>> ${cmd}-server\n" if ($debug);
2375 exec "exec ${cmd}-server";
df613eb4 2376 die "Can't exec ${cmd}-server: $!\n";
1ca9f507
PP
2377 }
2378 while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input
2379 select(undef, undef, undef, 0.3); # Let the daemon get going
2380 return (3, { exim_pid => $pid }); # Don't wait
2381 }
151b83f8
PH
2382 }
2383
bdf36f7c
JH
2384# The "background" command is run but not waited-for, like exim -DSERVER=server.
2385# One script line is read and fork-exec'd. The PID is stored for a later
2386# killdaemon.
2387
2388elsif (/^background$/)
2389 {
2390 my $line;
2391# $pidfile = "$parm_cwd/aux-var/server-daemon.pid";
2392
2393 $_ = <SCRIPT>; $lineno++;
2394 chomp;
2395 $line = $_;
2396 if ($debug) { printf ">> daemon: $line >>test-stdout 2>>test-stderr\n"; }
2397
2398 my $pid = fork();
2399 if (not defined $pid) { die "** fork failed: $!\n" }
2400 if (not $pid) {
2401 print "[$$]>> ${line}\n" if ($debug);
2402 close(STDIN);
2403 open(STDIN, "<", "test-stdout");
2404 close(STDOUT);
2405 open(STDOUT, ">>", "test-stdout");
2406 close(STDERR);
2407 open(STDERR, ">>", "test-stderr-server");
2408 exec "exec ${line}";
2409 exit(1);
2410 }
2411
2412# open(my $fh, ">", $pidfile) ||
2413# tests_exit(-1, "Failed to open $pidfile: $!");
2414# printf($fh, "%d\n", $pid);
2415# close($fh);
2416
2417 while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input
2418 select(undef, undef, undef, 0.3); # Let the daemon get going
2419 return (3, { exim_pid => $pid }); # Don't wait
2420 }
2421
2422
151b83f8
PH
2423
2424# Unknown command
2425
2426else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); }
2427
2428
2429# Run the command, with stdin connected to a pipe, and write the stdin data
2430# to it, with appropriate substitutions. If a line ends with \NONL\, chop off
2431# the terminating newline (and the \NONL\). If the command contains
2432# -DSERVER=server add "-server" to the command, where it will adjoin the name
2433# for the stderr file. See comment above about the use of -DSERVER.
2434
9a8a6839 2435$stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : '';
151b83f8
PH
2436print ">> |${cmd}${stderrsuffix}\n" if ($debug);
2437open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
2438
2439CMD->autoflush(1);
2440while (<SCRIPT>)
2441 {
2442 $lineno++;
2443 last if /^\*{4}\s*$/;
2444 do_substitute($testno);
2445 if (/^(.*)\\NONL\\\s*$/) { print CMD $1; } else { print CMD; }
2446 }
2447
2448# For timeout tests, wait before closing the pipe; we expect a
2449# SIGPIPE error in this case.
2450
2451if ($wait_time > 0)
2452 {
2453 printf(" Test %d sleep $wait_time ", $$subtestref);
2454 while ($wait_time-- > 0)
2455 {
2456 print ".";
2457 sleep(1);
2458 }
2459 printf("\r Test %d $cr", $$subtestref);
2460 }
2461
2462$sigpipehappened = 0;
2463close CMD; # Waits for command to finish
2464return $yield; # Ran command and waited
2465}
2466
2467
2468
2469
2470###############################################################################
2471###############################################################################
2472
d63a9563 2473# Here begins the Main Program ...
151b83f8
PH
2474
2475###############################################################################
2476###############################################################################
2477
2478
2479autoflush STDOUT 1;
2480print "Exim tester $testversion\n";
2481
26ab1da3
HSHR
2482# extend the PATH with .../sbin
2483# we map all (.../bin) to (.../sbin:.../bin)
2484$ENV{PATH} = do {
2485 my %seen = map { $_, 1 } split /:/, $ENV{PATH};
25adc2a8
HSHR
2486 join ':' => map { m{(.*)/bin$}
2487 ? ( $seen{"$1/sbin"} ? () : ("$1/sbin"), $_)
2488 : ($_) }
26ab1da3
HSHR
2489 split /:/, $ENV{PATH};
2490};
151b83f8
PH
2491
2492##################################################
650ececb
PP
2493# Some tests check created file modes #
2494##################################################
2495
2496umask 022;
2497
2498
2499##################################################
151b83f8
PH
2500# Check for the "less" command #
2501##################################################
2502
d63a9563 2503$more = 'more' if system('which less >/dev/null 2>&1') != 0;
151b83f8
PH
2504
2505
2506
2507##################################################
151b83f8
PH
2508# See if an Exim binary has been given #
2509##################################################
2510
2511# If the first character of the first argument is '/', the argument is taken
1c143d9d
HSHR
2512# as the path to the binary. If the first argument does not start with a
2513# '/' but exists in the file system, it's assumed to be the Exim binary.
151b83f8 2514
151b83f8
PH
2515
2516##################################################
2517# Sort out options and which tests are to be run #
2518##################################################
2519
2520# There are a few possible options for the test script itself; after these, any
2521# options are passed on to Exim calls within the tests. Typically, this is used
2522# to turn on Exim debugging while setting up a test.
2523
ffe0a357
HSHR
2524GetOptions(
2525 'debug' => sub { $debug = 1; $cr = "\n" },
2526 'diff' => sub { $cf = 'diff -u' },
2527 'continue' => sub { $force_continue = 1; $more = 'cat' },
2528 'update' => \$force_update,
2529 'ipv4!' => \$have_ipv4,
2530 'ipv6!' => \$have_ipv6,
2531 'keep' => \$save_output,
2532 'slow' => \$slow,
2533 'valgrind' => \$valgrind,
2534 'flavor|flavour=s' => \$flavour,
2535 'help' => sub { pod2usage(-exit => 0) },
2536 'man' => sub {
2537 pod2usage(
2538 -exit => 0,
2539 -verbose => 2,
2540 -noperldoc => system('perldoc -V 2>/dev/null 1>&2')
2541 );
2542 },
2543) or pod2usage;
2544
2545($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);
2546print "Exim binary is `$parm_exim'\n" if defined $parm_exim;
151b83f8
PH
2547
2548# Any subsequent arguments are a range of test numbers.
2549
9b25e4a9 2550if (@ARGV)
151b83f8 2551 {
9b25e4a9
HSHR
2552 $test_end = $test_start = shift;
2553 $test_end = shift if @ARGV;
2554 $test_end = ($test_start >= 9000)? TEST_SPECIAL_TOP : TEST_TOP
2555 if $test_end eq '+';
151b83f8
PH
2556 die "** Test numbers out of order\n" if ($test_end < $test_start);
2557 }
ffe0a357
HSHR
2558
2559##################################################
2560# Check for sudo access to root #
2561##################################################
2562
2563print "You need to have sudo access to root to run these tests. Checking ...\n";
2564if (system('sudo true >/dev/null') != 0)
2565 {
2566 die "** Test for sudo failed: testing abandoned.\n";
2567 }
2568else
2569 {
2570 print "Test for sudo OK\n";
2571 }
2572
2573
151b83f8
PH
2574
2575
2576##################################################
2577# Make the command's directory current #
2578##################################################
2579
2580# After doing so, we find its absolute path name.
2581
2582$cwd = $0;
2583$cwd = '.' if ($cwd !~ s|/[^/]+$||);
2584chdir($cwd) || die "** Failed to chdir to \"$cwd\": $!\n";
2585$parm_cwd = Cwd::getcwd();
2586
2587
2588##################################################
2589# Search for an Exim binary to test #
2590##################################################
2591
2592# If an Exim binary hasn't been provided, try to find one. We can handle the
2593# case where exim-testsuite is installed alongside Exim source directories. For
2594# PH's private convenience, if there's a directory just called "exim4", that
2595# takes precedence; otherwise exim-snapshot takes precedence over any numbered
2596# releases.
2597
151b83f8
PH
2598# If $parm_exim is still empty, ask the caller
2599
9a8a6839 2600if ($parm_exim eq '')
151b83f8
PH
2601 {
2602 print "** Did not find an Exim binary to test\n";
2603 for ($i = 0; $i < 5; $i++)
2604 {
2605 my($trybin);
2606 print "** Enter pathname for Exim binary: ";
2607 chomp($trybin = <STDIN>);
2608 if (-e $trybin)
2609 {
2610 $parm_exim = $trybin;
2611 last;
2612 }
2613 else
2614 {
2615 print "** $trybin does not exist\n";
2616 }
2617 }
9a8a6839 2618 die "** Too many tries\n" if $parm_exim eq '';
151b83f8
PH
2619 }
2620
2621
2622
2623##################################################
2624# Find what is in the binary #
2625##################################################
2626
5f122889
PP
2627# deal with TRUSTED_CONFIG_LIST restrictions
2628unlink("$parm_cwd/test-config") if -e "$parm_cwd/test-config";
72acdf0f
JH
2629open (IN, "$parm_cwd/confs/0000") ||
2630 tests_exit(-1, "Couldn't open $parm_cwd/confs/0000: $!\n");
2631open (OUT, ">test-config") ||
2632 tests_exit(-1, "Couldn't open test-config: $!\n");
2633while (<IN>) { print OUT; }
2634close(IN);
2635close(OUT);
5f122889
PP
2636
2637print("Probing with config file: $parm_cwd/test-config\n");
0e1cd284 2638
109ad60f
HSHR
2639my $eximinfo = "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd -bP exim_user exim_group";
2640chomp(my @eximinfo = `$eximinfo 2>&1`);
0e1cd284
HSHR
2641die "$0: Can't run $eximinfo\n" if $? == -1;
2642
2643warn 'Got ' . $?>>8 . " from $eximinfo\n" if $?;
109ad60f 2644foreach (@eximinfo)
151b83f8 2645 {
c039ce61
HSHR
2646 if (my ($version) = /^Exim version (\S+)/) {
2647 my $git = `git describe --dirty=-XX --match 'exim-4*'`;
2648 if (defined $git and $? == 0) {
2649 chomp $git;
2650 $version =~ s/^\d+\K\./_/;
2651 $git =~ s/^exim-//i;
2652 $git =~ s/.*-\Kg([[:xdigit:]]+(?:-XX)?)/$1/;
fefe59d9
HSHR
2653 print <<___
2654
2655*** Version mismatch
2656*** Exim binary: $version
2657*** Git : $git
2658
2659___
c039ce61
HSHR
2660 if not $version eq $git;
2661 }
2662 }
151b83f8
PH
2663 $parm_eximuser = $1 if /^exim_user = (.*)$/;
2664 $parm_eximgroup = $1 if /^exim_group = (.*)$/;
32ca7e2d 2665 $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/;
c9fb6994
HSHR
2666 ($parm_configure_owner, $parm_configure_group) = ($1, $2)
2667 if /^Configure owner:\s*(\d+):(\d+)/;
0df394b5 2668 print if /wrong owner/;
151b83f8 2669 }
151b83f8 2670
109ad60f
HSHR
2671if (not defined $parm_eximuser) {
2672 die <<XXX, map { "|$_\n" } @eximinfo;
2673Unable to extract exim_user from binary.
2674Check if Exim refused to run; if so, consider:
2675 TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS
2676If debug permission denied, are you in the exim group?
2677Failing to get information from binary.
2678Output from $eximinfo:
2679XXX
2680
2681}
2682
2683if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
2684else { $parm_exim_uid = getpwnam($parm_eximuser); }
151b83f8
PH
2685
2686if (defined $parm_eximgroup)
2687 {
2688 if ($parm_eximgroup =~ /^\d+$/) { $parm_exim_gid = $parm_eximgroup; }
2689 else { $parm_exim_gid = getgrnam($parm_eximgroup); }
2690 }
2691
32ca7e2d
HSHR
2692# check the permissions on the TRUSTED_CONFIG_LIST
2693if (defined $parm_trusted_config_list)
2694 {
2695 die "TRUSTED_CONFIG_LIST: $parm_trusted_config_list: $!\n"
2696 if not -f $parm_trusted_config_list;
2697
2698 die "TRUSTED_CONFIG_LIST $parm_trusted_config_list must not be world writable!\n"
2699 if 02 & (stat _)[2];
2700
2701 die sprintf "TRUSTED_CONFIG_LIST: $parm_trusted_config_list %d is group writable, but not owned by group '%s' or '%s'.\n",
2702 (stat _)[1],
2703 scalar(getgrgid 0), scalar(getgrgid $>)
2704 if (020 & (stat _)[2]) and not ((stat _)[5] == $> or (stat _)[5] == 0);
2705
2706 die sprintf "TRUSTED_CONFIG_LIST: $parm_trusted_config_list is not owned by user '%s' or '%s'.\n",
2707 scalar(getpwuid 0), scalar(getpwuid $>)
2708 if (not (-o _ or (stat _)[4] == 0));
2709
2710 open(TCL, $parm_trusted_config_list) or die "Can't open $parm_trusted_config_list: $!\n";
2711 my $test_config = getcwd() . '/test-config';
2712 die "Can't find '$test_config' in TRUSTED_CONFIG_LIST $parm_trusted_config_list."
2713 if not grep { /^$test_config$/ } <TCL>;
2714 }
2715else
2716 {
2717 die "Unable to check the TRUSTED_CONFIG_LIST, seems to be empty?\n";
2718 }
2719
c9fb6994
HSHR
2720die "CONFIGURE_OWNER ($parm_configure_owner) does not match the user invoking $0 ($>)\n"
2721 if $parm_configure_owner != $>;
2722
2723die "CONFIGURE_GROUP ($parm_configure_group) does not match the group invoking $0 ($))\n"
2724 if 0020 & (stat "$parm_cwd/test-config")[2]
2725 and $parm_configure_group != $);
2726
2727
b6a0dbb2 2728open(EXIMINFO, "$parm_exim -d-all+transport -bV -C $parm_cwd/test-config -DDIR=$parm_cwd |") ||
151b83f8
PH
2729 die "** Cannot run $parm_exim: $!\n";
2730
2731print "-" x 78, "\n";
2732
2733while (<EXIMINFO>)
2734 {
2735 my(@temp);
2736
b6a0dbb2 2737 if (/^(Exim|Library) version/) { print; }
151b83f8 2738
21c28500
PH
2739 elsif (/^Size of off_t: (\d+)/)
2740 {
e1b3d58d 2741 print;
21c28500 2742 $have_largefiles = 1 if $1 > 4;
e1b3d58d
JJ
2743 die "** Size of off_t > 32 which seems improbable, not running tests\n"
2744 if ($1 > 32);
21c28500
PH
2745 }
2746
2747 elsif (/^Support for: (.*)/)
151b83f8
PH
2748 {
2749 print;
2750 @temp = split /(\s+)/, $1;
2751 push(@temp, ' ');
2752 %parm_support = @temp;
2753 }
2754
33191679 2755 elsif (/^Lookups \(built-in\): (.*)/)
151b83f8
PH
2756 {
2757 print;
2758 @temp = split /(\s+)/, $1;
2759 push(@temp, ' ');
2760 %parm_lookups = @temp;
2761 }
2762
21c28500 2763 elsif (/^Authenticators: (.*)/)
151b83f8
PH
2764 {
2765 print;
2766 @temp = split /(\s+)/, $1;
2767 push(@temp, ' ');
2768 %parm_authenticators = @temp;
2769 }
2770
21c28500 2771 elsif (/^Routers: (.*)/)
151b83f8
PH
2772 {
2773 print;
2774 @temp = split /(\s+)/, $1;
2775 push(@temp, ' ');
2776 %parm_routers = @temp;
2777 }
2778
2779 # Some transports have options, e.g. appendfile/maildir. For those, ensure
2780 # that the basic transport name is set, and then the name with each of the
2781 # options.
2782
21c28500 2783 elsif (/^Transports: (.*)/)
151b83f8
PH
2784 {
2785 print;
2786 @temp = split /(\s+)/, $1;
2787 my($i,$k);
2788 push(@temp, ' ');
2789 %parm_transports = @temp;
2790 foreach $k (keys %parm_transports)
2791 {
2792 if ($k =~ "/")
2793 {
2794 @temp = split /\//, $k;
9a8a6839 2795 $parm_transports{$temp[0]} = " ";
151b83f8
PH
2796 for ($i = 1; $i < @temp; $i++)
2797 { $parm_transports{"$temp[0]/$temp[$i]"} = " "; }
2798 }
2799 }
2800 }
2801 }
2802close(EXIMINFO);
2803print "-" x 78, "\n";
2804
5f122889 2805unlink("$parm_cwd/test-config");
151b83f8
PH
2806
2807##################################################
2808# Check for SpamAssassin and ClamAV #
2809##################################################
2810
2811# These are crude tests. If they aren't good enough, we'll have to improve
2812# them, for example by actually passing a message through spamc or clamscan.
2813
9a8a6839 2814if (defined $parm_support{Content_Scanning})
151b83f8 2815 {
3ff2360f
JH
2816 my $sock = new FileHandle;
2817
151b83f8
PH
2818 if (system("spamc -h 2>/dev/null >/dev/null") == 0)
2819 {
151b83f8
PH
2820 print "The spamc command works:\n";
2821
2822 # This test for an active SpamAssassin is courtesy of John Jetmore.
2823 # The tests are hard coded to localhost:783, so no point in making
2824 # this test flexible like the clamav test until the test scripts are
4c04137d 2825 # changed. spamd doesn't have the nice PING/PONG protocol that
151b83f8
PH
2826 # clamd does, but it does respond to errors in an informative manner,
2827 # so use that.
2828
2829 my($sint,$sport) = ('127.0.0.1',783);
2830 eval
2831 {
2832 my $sin = sockaddr_in($sport, inet_aton($sint))
2833 or die "** Failed packing $sint:$sport\n";
3ff2360f 2834 socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
151b83f8
PH
2835 or die "** Unable to open socket $sint:$sport\n";
2836
2837 local $SIG{ALRM} =
2838 sub { die "** Timeout while connecting to socket $sint:$sport\n"; };
2839 alarm(5);
3ff2360f 2840 connect($sock, $sin)
151b83f8
PH
2841 or die "** Unable to connect to socket $sint:$sport\n";
2842 alarm(0);
2843
3ff2360f
JH
2844 select((select($sock), $| = 1)[0]);
2845 print $sock "bad command\r\n";
151b83f8
PH
2846
2847 $SIG{ALRM} =
2848 sub { die "** Timeout while reading from socket $sint:$sport\n"; };
2849 alarm(10);
3ff2360f 2850 my $res = <$sock>;
151b83f8
PH
2851 alarm(0);
2852
2853 $res =~ m|^SPAMD/|
2854 or die "** Did not get SPAMD from socket $sint:$sport. "
2855 ."It said: $res\n";
2856 };
2857 alarm(0);
2858 if($@)
2859 {
2860 print " $@";
2861 print " Assume SpamAssassin (spamd) is not running\n";
2862 }
2863 else
2864 {
9a8a6839 2865 $parm_running{SpamAssassin} = ' ';
151b83f8
PH
2866 print " SpamAssassin (spamd) seems to be running\n";
2867 }
2868 }
2869 else
2870 {
2871 print "The spamc command failed: assume SpamAssassin (spamd) is not running\n";
2872 }
2873
2874 # For ClamAV, we need to find the clamd socket for use in the Exim
2875 # configuration. Search for the clamd configuration file.
2876
2877 if (system("clamscan -h 2>/dev/null >/dev/null") == 0)
2878 {
2879 my($f, $clamconf, $test_prefix);
2880
2881 print "The clamscan command works";
2882
2883 $test_prefix = $ENV{EXIM_TEST_PREFIX};
9a8a6839 2884 $test_prefix = '' if !defined $test_prefix;
151b83f8
PH
2885
2886 foreach $f ("$test_prefix/etc/clamd.conf",
2887 "$test_prefix/usr/local/etc/clamd.conf",
9a8a6839 2888 "$test_prefix/etc/clamav/clamd.conf", '')
151b83f8
PH
2889 {
2890 if (-e $f)
2891 {
2892 $clamconf = $f;
2893 last;
2894 }
2895 }
2896
11b3bc4d
PH
2897 # Read the ClamAV configuration file and find the socket interface.
2898
9a8a6839 2899 if ($clamconf ne '')
151b83f8 2900 {
11b3bc4d 2901 my $socket_domain;
151b83f8
PH
2902 open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
2903 while (<IN>)
2904 {
2905 if (/^LocalSocket\s+(.*)/)
2906 {
2907 $parm_clamsocket = $1;
11b3bc4d 2908 $socket_domain = AF_UNIX;
151b83f8
PH
2909 last;
2910 }
11b3bc4d
PH
2911 if (/^TCPSocket\s+(\d+)/)
2912 {
2913 if (defined $parm_clamsocket)
2914 {
2915 $parm_clamsocket .= " $1";
2916 $socket_domain = AF_INET;
2917 last;
2918 }
2919 else
2920 {
2921 $parm_clamsocket = " $1";
2922 }
2923 }
2924 elsif (/^TCPAddr\s+(\S+)/)
2925 {
2926 if (defined $parm_clamsocket)
2927 {
2928 $parm_clamsocket = $1 . $parm_clamsocket;
2929 $socket_domain = AF_INET;
2930 last;
2931 }
2932 else
2933 {
2934 $parm_clamsocket = $1;
2935 }
2936 }
151b83f8
PH
2937 }
2938 close(IN);
11b3bc4d
PH
2939
2940 if (defined $socket_domain)
151b83f8
PH
2941 {
2942 print ":\n The clamd socket is $parm_clamsocket\n";
2943 # This test for an active ClamAV is courtesy of Daniel Tiefnig.
2944 eval
2945 {
11b3bc4d
PH
2946 my $socket;
2947 if ($socket_domain == AF_UNIX)
2948 {
2949 $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n";
2950 }
2951 elsif ($socket_domain == AF_INET)
2952 {
2953 my ($ca_host, $ca_port) = split(/\s+/,$parm_clamsocket);
2954 my $ca_hostent = gethostbyname($ca_host) or die "** Failed to get raw address for host '$ca_host'\n";
2955 $socket = sockaddr_in($ca_port, $ca_hostent) or die "** Failed packing '$parm_clamsocket'\n";
2956 }
2957 else
2958 {
2959 die "** Unknown socket domain '$socket_domain' (should not happen)\n";
2960 }
3ff2360f 2961 socket($sock, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n";
151b83f8
PH
2962 local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; };
2963 alarm(5);
3ff2360f 2964 connect($sock, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n";
151b83f8
PH
2965 alarm(0);
2966
3ff2360f
JH
2967 my $ofh = select $sock; $| = 1; select $ofh;
2968 print $sock "PING\n";
151b83f8
PH
2969
2970 $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; };
2971 alarm(10);
3ff2360f 2972 my $res = <$sock>;
151b83f8
PH
2973 alarm(0);
2974
2975 $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n";
2976 };
2977 alarm(0);
2978
2979 if($@)
2980 {
520de300 2981 print " $@";
151b83f8
PH
2982 print " Assume ClamAV is not running\n";
2983 }
2984 else
2985 {
9a8a6839 2986 $parm_running{ClamAV} = ' ';
151b83f8
PH
2987 print " ClamAV seems to be running\n";
2988 }
2989 }
2990 else
2991 {
11b3bc4d 2992 print ", but the socket for clamd could not be determined\n";
151b83f8
PH
2993 print "Assume ClamAV is not running\n";
2994 }
2995 }
2996
2997 else
2998 {
2999 print ", but I can't find a configuration for clamd\n";
3000 print "Assume ClamAV is not running\n";
3001 }
3002 }
3003 }
3004
3005
3006##################################################
bdf36f7c
JH
3007# Check for redis #
3008##################################################
9a8a6839 3009if (defined $parm_lookups{redis})
bdf36f7c
JH
3010 {
3011 if (system("redis-server -v 2>/dev/null >/dev/null") == 0)
3012 {
3013 print "The redis-server command works\n";
9a8a6839 3014 $parm_running{redis} = ' ';
bdf36f7c
JH
3015 }
3016 else
3017 {
3018 print "The redis-server command failed: assume Redis not installed\n";
3019 }
3020 }
3021
3022##################################################
151b83f8
PH
3023# Test for the basic requirements #
3024##################################################
3025
3026# This test suite assumes that Exim has been built with at least the "usual"
3027# set of routers, transports, and lookups. Ensure that this is so.
3028
9a8a6839 3029$missing = '';
151b83f8 3030
9a8a6839 3031$missing .= " Lookup: lsearch\n" if (!defined $parm_lookups{lsearch});
151b83f8 3032
9a8a6839
HSHR
3033$missing .= " Router: accept\n" if (!defined $parm_routers{accept});
3034$missing .= " Router: dnslookup\n" if (!defined $parm_routers{dnslookup});
3035$missing .= " Router: manualroute\n" if (!defined $parm_routers{manualroute});
3036$missing .= " Router: redirect\n" if (!defined $parm_routers{redirect});
151b83f8 3037
9a8a6839
HSHR
3038$missing .= " Transport: appendfile\n" if (!defined $parm_transports{appendfile});
3039$missing .= " Transport: autoreply\n" if (!defined $parm_transports{autoreply});
3040$missing .= " Transport: pipe\n" if (!defined $parm_transports{pipe});
3041$missing .= " Transport: smtp\n" if (!defined $parm_transports{smtp});
151b83f8 3042
9a8a6839 3043if ($missing ne '')
151b83f8
PH
3044 {
3045 print "\n";
3046 print "** Many features can be included or excluded from Exim binaries.\n";
3047 print "** This test suite requires that Exim is built to contain a certain\n";
3048 print "** set of basic facilities. It seems that some of these are missing\n";
3049 print "** from the binary that is under test, so the test cannot proceed.\n";
3050 print "** The missing facilities are:\n";
3051 print "$missing";
3052 die "** Test script abandoned\n";
3053 }
3054
3055
3056##################################################
3057# Check for the auxiliary programs #
3058##################################################
3059
3060# These are always required:
3061
3062for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
3063 "fakens", "iefbr14", "server")
3064 {
9a8a6839
HSHR
3065 next if ($prog eq "client-ssl" && !defined $parm_support{OpenSSL});
3066 next if ($prog eq "client-gnutls" && !defined $parm_support{GnuTLS});
151b83f8
PH
3067 if (!-e "bin/$prog")
3068 {
3069 print "\n";
3070 print "** bin/$prog does not exist. Have you run ./configure and make?\n";
3071 die "** Test script abandoned\n";
3072 }
3073 }
3074
3075# If the "loaded" binary is missing, we cut out tests for ${dlfunc. It isn't
3076# compiled on systems where we don't know how to. However, if Exim does not
3077# have that functionality compiled, we needn't bother.
3078
3079$dlfunc_deleted = 0;
9a8a6839 3080if (defined $parm_support{Expand_dlfunc} && !-e 'bin/loaded')
151b83f8 3081 {
9a8a6839 3082 delete $parm_support{Expand_dlfunc};
151b83f8
PH
3083 $dlfunc_deleted = 1;
3084 }
3085
3086
3087##################################################
3088# Find environmental details #
3089##################################################
3090
3091# Find the caller of this program.
3092
3093($parm_caller,$pwpw,$parm_caller_uid,$parm_caller_gid,$pwquota,$pwcomm,
eeeda78a 3094 $parm_caller_gecos, $parm_caller_home) = getpwuid($>);
151b83f8
PH
3095
3096$pwpw = $pwpw; # Kill Perl warnings
3097$pwquota = $pwquota;
3098$pwcomm = $pwcomm;
151b83f8
PH
3099
3100$parm_caller_group = getgrgid($parm_caller_gid);
3101
42ec9880 3102print "Program caller is $parm_caller ($parm_caller_uid), whose group is $parm_caller_group ($parm_caller_gid)\n";
151b83f8
PH
3103print "Home directory is $parm_caller_home\n";
3104
5f122889
PP
3105unless (defined $parm_eximgroup)
3106 {
3107 print "Unable to derive \$parm_eximgroup.\n";
3108 die "** ABANDONING.\n";
3109 }
3110
151b83f8
PH
3111print "You need to be in the Exim group to run these tests. Checking ...";
3112
3113if (`groups` =~ /\b\Q$parm_eximgroup\E\b/)
3114 {
3115 print " OK\n";
3116 }
3117else
3118 {
3119 print "\nOh dear, you are not in the Exim group.\n";
3120 die "** Testing abandoned.\n";
3121 }
3122
3123# Find this host's IP addresses - there may be many, of course, but we keep
3124# one of each type (IPv4 and IPv6).
3125
bb660b56
HSHR
3126open(IFCONFIG, '-|', (grep { -x "$_/ip" } split /:/, $ENV{PATH}) ? 'ip address' : 'ifconfig -a')
3127 or die "** Cannot run 'ip address' or 'ifconfig -a'\n";
d63a9563 3128while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>))
151b83f8 3129 {
8bcf5607 3130 if (not $parm_ipv4 and /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
151b83f8 3131 {
d63a9563
HSHR
3132 next if $1 =~ /^(?:127|10)\./;
3133 $parm_ipv4 = $1;
151b83f8
PH
3134 }
3135
d63a9563 3136 if (not $parm_ipv6 and /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)(?:\/\d+)/i)
151b83f8 3137 {
d63a9563
HSHR
3138 next if $1 eq '::1' or $1 =~ /^fe80/i;
3139 $parm_ipv6 = $1;
151b83f8
PH
3140 }
3141 }
3142close(IFCONFIG);
3143
3144# Use private IP addresses if there are no public ones.
3145
151b83f8
PH
3146# If either type of IP address is missing, we need to set the value to
3147# something other than empty, because that wrecks the substitutions. The value
3148# is reflected, so use a meaningful string. Set appropriate options for the
3149# "server" command. In practice, however, many tests assume 127.0.0.1 is
3150# available, so things will go wrong if there is no IPv4 address. The lack
3151# of IPV4 or IPv6 can be simulated by command options, which force $have_ipv4
3152# and $have_ipv6 false.
3153
d63a9563 3154if (not $parm_ipv4)
151b83f8
PH
3155 {
3156 $have_ipv4 = 0;
3157 $parm_ipv4 = "<no IPv4 address found>";
3158 $server_opts .= " -noipv4";
3159 }
3160elsif ($have_ipv4 == 0)
3161 {
3162 $parm_ipv4 = "<IPv4 testing disabled>";
3163 $server_opts .= " -noipv4";
3164 }
3165else
3166 {
9a8a6839 3167 $parm_running{IPv4} = " ";
151b83f8
PH
3168 }
3169
d63a9563 3170if (not $parm_ipv6)
151b83f8
PH
3171 {
3172 $have_ipv6 = 0;
3173 $parm_ipv6 = "<no IPv6 address found>";
3174 $server_opts .= " -noipv6";
9a8a6839 3175 delete($parm_support{IPv6});
151b83f8
PH
3176 }
3177elsif ($have_ipv6 == 0)
3178 {
3179 $parm_ipv6 = "<IPv6 testing disabled>";
3180 $server_opts .= " -noipv6";
9a8a6839 3181 delete($parm_support{IPv6});
151b83f8 3182 }
9a8a6839 3183elsif (!defined $parm_support{IPv6})
151b83f8
PH
3184 {
3185 $have_ipv6 = 0;
3186 $parm_ipv6 = "<no IPv6 support in Exim binary>";
3187 $server_opts .= " -noipv6";
3188 }
3189else
3190 {
9a8a6839 3191 $parm_running{IPv6} = " ";
151b83f8
PH
3192 }
3193
3194print "IPv4 address is $parm_ipv4\n";
3195print "IPv6 address is $parm_ipv6\n";
3196
75758eeb
PH
3197# For munging test output, we need the reversed IP addresses.
3198
9a8a6839 3199$parm_ipv4r = ($parm_ipv4 !~ /^\d/)? '' :
75758eeb
PH
3200 join(".", reverse(split /\./, $parm_ipv4));
3201
1b781f48 3202$parm_ipv6r = $parm_ipv6; # Appropriate if not in use
75758eeb
PH
3203if ($parm_ipv6 =~ /^[\da-f]/)
3204 {
3205 my(@comps) = split /:/, $parm_ipv6;
3206 my(@nibbles);
3207 foreach $comp (@comps)
3208 {
3209 push @nibbles, sprintf("%lx", hex($comp) >> 8);
3210 push @nibbles, sprintf("%lx", hex($comp) & 0xff);
3211 }
3212 $parm_ipv6r = join(".", reverse(@nibbles));
3213 }
3214
151b83f8
PH
3215# Find the host name, fully qualified.
3216
3217chomp($temp = `hostname`);
d36e39d7 3218die "'hostname' didn't return anything\n" unless defined $temp and length $temp;
32c5107f
JH
3219if ($temp =~ /\./)
3220 {
3221 $parm_hostname = $temp;
3222 }
3223else
3224 {
3225 $parm_hostname = (gethostbyname($temp))[0];
3226 $parm_hostname = "no.host.name.found" unless defined $parm_hostname and length $parm_hostname;
3227 }
151b83f8
PH
3228print "Hostname is $parm_hostname\n";
3229
3230if ($parm_hostname !~ /\./)
3231 {
3232 print "\n*** Host name is not fully qualified: this may cause problems ***\n\n";
3233 }
3234
05e0ef26
TL
3235if ($parm_hostname =~ /[[:upper:]]/)
3236 {
3237 print "\n*** Host name has upper case characters: this may cause problems ***\n\n";
3238 }
3239
151b83f8
PH
3240
3241
3242##################################################
3243# Create a testing version of Exim #
3244##################################################
3245
3246# We want to be able to run Exim with a variety of configurations. Normally,
3247# the use of -C to change configuration causes Exim to give up its root
3248# privilege (unless the caller is exim or root). For these tests, we do not
3249# want this to happen. Also, we want Exim to know that it is running in its
3250# test harness.
3251
3252# We achieve this by copying the binary and patching it as we go. The new
3253# binary knows it is a testing copy, and it allows -C and -D without loss of
3254# privilege. Clearly, this file is dangerous to have lying around on systems
3255# where there are general users with login accounts. To protect against this,
3256# we put the new binary in a special directory that is accessible only to the
3257# caller of this script, who is known to have sudo root privilege from the test
3258# that was done above. Furthermore, we ensure that the binary is deleted at the
3259# end of the test. First ensure the directory exists.
3260
050514b5
JH
3261if (-d "eximdir")
3262 { unlink "eximdir/exim"; } # Just in case
3263else
3264 {
3265 mkdir("eximdir", 0710) || die "** Unable to mkdir $parm_cwd/eximdir: $!\n";
3266 system("sudo chgrp $parm_eximgroup eximdir");
3267 }
151b83f8
PH
3268
3269# The construction of the patched binary must be done as root, so we use
3270# a separate script. As well as indicating that this is a test-harness binary,
3271# the version number is patched to "x.yz" so that its length is always the
3272# same. Otherwise, when it appears in Received: headers, it affects the length
3273# of the message, which breaks certain comparisons.
3274
3275die "** Unable to make patched exim: $!\n"
3276 if (system("sudo ./patchexim $parm_exim") != 0);
3277
3278# From this point on, exits from the program must go via the subroutine
3279# tests_exit(), so that suitable cleaning up can be done when required.
3280# Arrange to catch interrupting signals, to assist with this.
3281
9a8a6839
HSHR
3282$SIG{INT} = \&inthandler;
3283$SIG{PIPE} = \&pipehandler;
151b83f8
PH
3284
3285# For some tests, we need another copy of the binary that is setuid exim rather
3286# than root.
3287
050514b5 3288system("sudo cp eximdir/exim eximdir/exim_exim;" .
151b83f8
PH
3289 "sudo chown $parm_eximuser eximdir/exim_exim;" .
3290 "sudo chgrp $parm_eximgroup eximdir/exim_exim;" .
050514b5 3291 "sudo chmod 06755 eximdir/exim_exim");
151b83f8
PH
3292
3293
3294##################################################
3295# Make copies of utilities we might need #
3296##################################################
3297
3298# Certain of the tests make use of some of Exim's utilities. We do not need
3299# to be root to copy these.
3300
1ca9f507 3301($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?;
151b83f8
PH
3302
3303$dbm_build_deleted = 0;
9a8a6839 3304if (defined $parm_lookups{dbm} &&
151b83f8
PH
3305 system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
3306 {
9a8a6839 3307 delete $parm_lookups{dbm};
151b83f8
PH
3308 $dbm_build_deleted = 1;
3309 }
3310
3311if (system("cp $parm_exim_dir/exim_dumpdb eximdir") != 0)
3312 {
3313 tests_exit(-1, "Failed to make a copy of exim_dumpdb: $!");
3314 }
3315
3316if (system("cp $parm_exim_dir/exim_lock eximdir") != 0)
3317 {
3318 tests_exit(-1, "Failed to make a copy of exim_lock: $!");
3319 }
3320
3321if (system("cp $parm_exim_dir/exinext eximdir") != 0)
3322 {
3323 tests_exit(-1, "Failed to make a copy of exinext: $!");
3324 }
3325
f3f065bb
PH
3326if (system("cp $parm_exim_dir/exigrep eximdir") != 0)
3327 {
3328 tests_exit(-1, "Failed to make a copy of exigrep: $!");
3329 }
3330
3331if (system("cp $parm_exim_dir/eximstats eximdir") != 0)
3332 {
3333 tests_exit(-1, "Failed to make a copy of eximstats: $!");
3334 }
3335
151b83f8
PH
3336
3337##################################################
3338# Check that the Exim user can access stuff #
3339##################################################
3340
3341# We delay this test till here so that we can check access to the actual test
3342# binary. This will be needed when Exim re-exec's itself to do deliveries.
3343
3344print "Exim user is $parm_eximuser ($parm_exim_uid)\n";
3345print "Exim group is $parm_eximgroup ($parm_exim_gid)\n";
a56f166d
JJ
3346
3347if ($parm_caller_uid eq $parm_exim_uid) {
3348 tests_exit(-1, "Exim user ($parm_eximuser,$parm_exim_uid) cannot be "
3349 ."the same as caller ($parm_caller,$parm_caller_uid)");
3350}
b43517ed
JH
3351if ($parm_caller_gid eq $parm_exim_gid) {
3352 tests_exit(-1, "Exim group ($parm_eximgroup,$parm_exim_gid) cannot be "
3353 ."the same as caller's ($parm_caller) group as it confuses "
3354 ."results analysis");
3355}
a56f166d 3356
151b83f8
PH
3357print "The Exim user needs access to the test suite directory. Checking ...";
3358
3359if (($rc = system("sudo bin/checkaccess $parm_cwd/eximdir/exim $parm_eximuser $parm_eximgroup")) != 0)
3360 {
3361 my($why) = "unknown failure $rc";
3362 $rc >>= 8;
3363 $why = "Couldn't find user \"$parm_eximuser\"" if $rc == 1;
3364 $why = "Couldn't find group \"$parm_eximgroup\"" if $rc == 2;
3365 $why = "Couldn't read auxiliary group list" if $rc == 3;
3366 $why = "Couldn't get rid of auxiliary groups" if $rc == 4;
3367 $why = "Couldn't set gid" if $rc == 5;
3368 $why = "Couldn't set uid" if $rc == 6;
3369 $why = "Couldn't open \"$parm_cwd/eximdir/exim\"" if $rc == 7;
3370 print "\n** $why\n";
3371 tests_exit(-1, "$parm_eximuser cannot access the test suite directory");
3372 }
3373else
3374 {
3375 print " OK\n";
3376 }
3377
9b25e4a9
HSHR
3378tests_exit(-1, "Failed to unlink $log_summary_filename: $!")
3379 if not unlink($log_summary_filename) and -e $log_summary_filename;
151b83f8
PH
3380
3381##################################################
3382# Create a list of available tests #
3383##################################################
3384
3385# The scripts directory contains a number of subdirectories whose names are
3386# of the form 0000-xxxx, 1100-xxxx, 2000-xxxx, etc. Each set of tests apart
3387# from the first requires certain optional features to be included in the Exim
3388# binary. These requirements are contained in a file called "REQUIRES" within
3389# the directory. We scan all these tests, discarding those that cannot be run
3390# because the current binary does not support the right facilities, and also
3391# those that are outside the numerical range selected.
3392
28e8a0f7 3393print "\nTest range is $test_start to $test_end (flavour $flavour)\n";
151b83f8
PH
3394print "Omitting \${dlfunc expansion tests (loadable module not present)\n"
3395 if $dlfunc_deleted;
3396print "Omitting dbm tests (unable to copy exim_dbmbuild)\n"
3397 if $dbm_build_deleted;
3398
9e146c9f 3399
9b25e4a9
HSHR
3400my @test_dirs = grep { not /^CVS$/ } map { basename $_ } glob 'scripts/*'
3401 or die tests_exit(-1, "Failed to find test scripts in 'scripts/*`: $!");
9e146c9f
PH
3402
3403# Scan for relevant tests
3404
9b25e4a9 3405DIR: for ($i = 0; $i < @test_dirs; $i++)
151b83f8
PH
3406 {
3407 my($testdir) = $test_dirs[$i];
3408 my($wantthis) = 1;
3409
151b83f8
PH
3410 print ">>Checking $testdir\n" if $debug;
3411
3412 # Skip this directory if the first test is equal or greater than the first
3413 # test in the next directory.
3414
9b25e4a9 3415 next DIR if ($i < @test_dirs - 1) &&
151b83f8
PH
3416 ($test_start >= substr($test_dirs[$i+1], 0, 4));
3417
3418 # No need to carry on if the end test is less than the first test in this
3419 # subdirectory.
3420
9b25e4a9 3421 last DIR if $test_end < substr($testdir, 0, 4);
151b83f8
PH
3422
3423 # Check requirements, if any.
3424
9b25e4a9 3425 if (open(my $requires, "scripts/$testdir/REQUIRES"))
151b83f8 3426 {
9b25e4a9 3427 while (<$requires>)
151b83f8
PH
3428 {
3429 next if /^\s*$/;
3430 s/\s+$//;
3431 if (/^support (.*)$/)
3432 {
3433 if (!defined $parm_support{$1}) { $wantthis = 0; last; }
3434 }
3435 elsif (/^running (.*)$/)
3436 {
3437 if (!defined $parm_running{$1}) { $wantthis = 0; last; }
3438 }
3439 elsif (/^lookup (.*)$/)
3440 {
3441 if (!defined $parm_lookups{$1}) { $wantthis = 0; last; }
3442 }
3443 elsif (/^authenticators? (.*)$/)
3444 {
3445 if (!defined $parm_authenticators{$1}) { $wantthis = 0; last; }
3446 }
3447 elsif (/^router (.*)$/)
3448 {
3449 if (!defined $parm_routers{$1}) { $wantthis = 0; last; }
3450 }
3451 elsif (/^transport (.*)$/)
3452 {
3453 if (!defined $parm_transports{$1}) { $wantthis = 0; last; }
3454 }
3455 else
3456 {
3457 tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\"");
3458 }
3459 }
151b83f8
PH
3460 }
3461 else
3462 {
3463 tests_exit(-1, "Failed to open \"scripts/$testdir/REQUIRES\": $!")
3464 unless $!{ENOENT};
3465 }
3466
3467 # Loop if we do not want the tests in this subdirectory.
3468
3469 if (!$wantthis)
3470 {
3471 chomp;
3472 print "Omitting tests in $testdir (missing $_)\n";
151b83f8
PH
3473 }
3474
3475 # We want the tests from this subdirectory, provided they are in the
3476 # range that was selected.
3477
9b25e4a9
HSHR
3478 @testlist = map { basename $_ } glob "scripts/$testdir/*";
3479 tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!")
3480 if not @testlist;
151b83f8
PH
3481
3482 foreach $test (@testlist)
3483 {
a4ecb6a7
JH
3484 next if ($test !~ /^\d{4}(?:\.\d+)?$/);
3485 if (!$wantthis || $test < $test_start || $test > $test_end)
3486 {
3487 log_test($log_summary_filename, $test, '.');
3488 }
3489 else
3490 {
3491 push @test_list, "$testdir/$test";
3492 }
151b83f8
PH
3493 }
3494 }
3495
3496print ">>Test List: @test_list\n", if $debug;
3497
3498
3499##################################################
3500# Munge variable auxiliary data #
3501##################################################
3502
3503# Some of the auxiliary data files have to refer to the current testing
3504# directory and other parameter data. The generic versions of these files are
3505# stored in the aux-var-src directory. At this point, we copy each of them
3506# to the aux-var directory, making appropriate substitutions. There aren't very
3507# many of them, so it's easiest just to do this every time. Ensure the mode
3508# is standardized, as this path is used as a test for the ${stat: expansion.
3509
3510# A similar job has to be done for the files in the dnszones-src directory, to
3511# make the fake DNS zones for testing. Most of the zone files are copied to
3512# files of the same name, but db.ipv4.V4NET and db.ipv6.V6NET use the testing
3513# networks that are defined by parameter.
3514
3515foreach $basedir ("aux-var", "dnszones")
3516 {
3517 system("sudo rm -rf $parm_cwd/$basedir");
3518 mkdir("$parm_cwd/$basedir", 0777);
3519 chmod(0755, "$parm_cwd/$basedir");
3520
3521 opendir(AUX, "$parm_cwd/$basedir-src") ||
3522 tests_exit(-1, "Failed to opendir $parm_cwd/$basedir-src: $!");
3523 my(@filelist) = readdir(AUX);
3524 close(AUX);
3525
3526 foreach $file (@filelist)
3527 {
3528 my($outfile) = $file;
3529 next if $file =~ /^\./;
3530
3531 if ($file eq "db.ip4.V4NET")
3532 {
3533 $outfile = "db.ip4.$parm_ipv4_test_net";
3534 }
3535 elsif ($file eq "db.ip6.V6NET")
3536 {
3537 my(@nibbles) = reverse(split /\s*/, $parm_ipv6_test_net);
3538 $" = '.';
3539 $outfile = "db.ip6.@nibbles";
3540 $" = ' ';
3541 }
3542
3543 print ">>Copying $basedir-src/$file to $basedir/$outfile\n" if $debug;
3544 open(IN, "$parm_cwd/$basedir-src/$file") ||
3545 tests_exit(-1, "Failed to open $parm_cwd/$basedir-src/$file: $!");
3546 open(OUT, ">$parm_cwd/$basedir/$outfile") ||
3547 tests_exit(-1, "Failed to open $parm_cwd/$basedir/$outfile: $!");
3548 while (<IN>)
3549 {
3550 do_substitute(0);
3551 print OUT;
3552 }
3553 close(IN);
3554 close(OUT);
3555 }
3556 }
3557
d40f27c3
JH
3558# Set a user's shell, distinguishable from /bin/sh
3559
9a8a6839
HSHR
3560symlink('/bin/sh' => 'aux-var/sh');
3561$ENV{SHELL} = $parm_shell = "$parm_cwd/aux-var/sh";
151b83f8
PH
3562
3563##################################################
3564# Create fake DNS zones for this host #
3565##################################################
3566
3567# There are fixed zone files for 127.0.0.1 and ::1, but we also want to be
3568# sure that there are forward and reverse registrations for this host, using
3569# its real IP addresses. Dynamically created zone files achieve this.
3570
3571if ($have_ipv4 || $have_ipv6)
3572 {
3573 my($shortname,$domain) = $parm_hostname =~ /^([^.]+)(.*)/;
3574 open(OUT, ">$parm_cwd/dnszones/db$domain") ||
3575 tests_exit(-1, "Failed to open $parm_cwd/dnszones/db$domain: $!");
3576 print OUT "; This is a dynamically constructed fake zone file.\n" .
3577 "; The following line causes fakens to return PASS_ON\n" .
3578 "; for queries that it cannot answer\n\n" .
3579 "PASS ON NOT FOUND\n\n";
3580 print OUT "$shortname A $parm_ipv4\n" if $have_ipv4;
3581 print OUT "$shortname AAAA $parm_ipv6\n" if $have_ipv6;
3582 print OUT "\n; End\n";
3583 close(OUT);
3584 }
3585
3586if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1")
3587 {
3588 my(@components) = $parm_ipv4 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
3589 open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") ||
3590 tests_exit(-1,
3591 "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!");
3592 print OUT "; This is a dynamically constructed fake zone file.\n" .
3593 "; The zone is $components[0].in-addr.arpa.\n\n" .
3594 "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n" .
3595 "; End\n";
3596 close(OUT);
3597 }
3598
3599if ($have_ipv6 && $parm_ipv6 ne "::1")
3600 {
6f99d4d9
JH
3601 my($exp_v6) = $parm_ipv6;
3602 $exp_v6 =~ s/[^:]//g;
3603 if ( $parm_ipv6 =~ /^([^:].+)::$/ ) {
3604 $exp_v6 = $1 . ':0' x (9-length($exp_v6));
3605 } elsif ( $parm_ipv6 =~ /^(.+)::(.+)$/ ) {
3606 $exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2;
3607 } elsif ( $parm_ipv6 =~ /^::(.+[^:])$/ ) {
3608 $exp_v6 = '0:' x (9-length($exp_v6)) . $1;
d37842eb
TL
3609 } else {
3610 $exp_v6 = $parm_ipv6;
6f99d4d9
JH
3611 }
3612 my(@components) = split /:/, $exp_v6;
151b83f8 3613 my(@nibbles) = reverse (split /\s*/, shift @components);
9a8a6839 3614 my($sep) = '';
151b83f8
PH
3615
3616 $" = ".";
3617 open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||
3618 tests_exit(-1,
3619 "Failed to open $parm_cwd/dnszones/db.ip6.@nibbles: $!");
3620 print OUT "; This is a dynamically constructed fake zone file.\n" .
3621 "; The zone is @nibbles.ip6.arpa.\n\n";
3622
3623 @components = reverse @components;
3624 foreach $c (@components)
3625 {
3626 $c = "0$c" until $c =~ /^..../;
3627 @nibbles = reverse(split /\s*/, $c);
3628 print OUT "$sep@nibbles";
3629 $sep = ".";
3630 }
3631
3632 print OUT " PTR $parm_hostname.\n\n; End\n";
3633 close(OUT);
3634 $" = " ";
3635 }
3636
3637
3638
3639##################################################
3640# Create lists of mailboxes and message logs #
3641##################################################
3642
3643# We use these lists to check that a test has created the expected files. It
3644# should be faster than looking for the file each time. For mailboxes, we have
3645# to scan a complete subtree, in order to handle maildirs. For msglogs, there
3646# is just a flat list of files.
3647
3648@oldmails = list_files_below("mail");
3649opendir(DIR, "msglog") || tests_exit(-1, "Failed to opendir msglog: $!");
3650@oldmsglogs = readdir(DIR);
3651closedir(DIR);
3652
3653
3654
3655##################################################
3656# Run the required tests #
3657##################################################
3658
3659# Each test script contains a number of tests, separated by a line that
3660# contains ****. We open input from the terminal so that we can read responses
3661# to prompts.
3662
0b9ead6d
HSHR
3663if (not $force_continue) {
3664 # runtest needs to interact if we're not in continue
3665 # mode. It does so by communicate to /dev/tty
9b25e4a9
HSHR
3666 open(T, '<', '/dev/tty') or tests_exit(-1, "Failed to open /dev/tty: $!");
3667 print "\nPress RETURN to run the tests: ";
3668 <T>;
0b9ead6d
HSHR
3669}
3670
151b83f8 3671
151b83f8
PH
3672foreach $test (@test_list)
3673 {
9b25e4a9
HSHR
3674 state $lasttestdir = '';
3675
3676 local $lineno = 0;
3677 local $commandno = 0;
3678 local $subtestno = 0;
3679 local $sortlog = 0;
3680
28e8a0f7 3681 (local $testno = $test) =~ s|.*/||;
151b83f8 3682
9b25e4a9
HSHR
3683 # Leaving traces in the process table and in the environment
3684 # gives us a chance to identify hanging processes (exim daemons)
3685 local $0 = "[runtest $testno]";
3686 local $ENV{EXIM_TEST_NUMBER} = $testno;
3687
3688 my $gnutls = 0;
3689 my $docheck = 1;
3690 my $thistestdir = substr($test, 0, -5);
151b83f8 3691
df613eb4
HSHR
3692 $dynamic_socket->close() if $dynamic_socket;
3693
151b83f8
PH
3694 if ($lasttestdir ne $thistestdir)
3695 {
3696 $gnutls = 0;
3697 if (-s "scripts/$thistestdir/REQUIRES")
3698 {
9b25e4a9 3699 my $indent = '';
151b83f8 3700 print "\n>>> The following tests require: ";
9b25e4a9
HSHR
3701 open(my $requires, '<', "scripts/$thistestdir/REQUIRES") ||
3702 tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $!");
3703 while (<$requires>)
151b83f8
PH
3704 {
3705 $gnutls = 1 if /^support GnuTLS/;
3706 print $indent, $_;
3707 $indent = ">>> ";
3708 }
151b83f8 3709 }
9b25e4a9 3710 $lasttestdir = $thistestdir;
151b83f8 3711 }
151b83f8
PH
3712
3713 # Remove any debris in the spool directory and the test-mail directory
3714 # and also the files for collecting stdout and stderr. Then put back
3715 # the test-mail directory for appendfile deliveries.
3716
3717 system "sudo /bin/rm -rf spool test-*";
3718 system "mkdir test-mail 2>/dev/null";
3719
3720 # A privileged Exim will normally make its own spool directory, but some of
3721 # the tests run in unprivileged modes that don't always work if the spool
3722 # directory isn't already there. What is more, we want anybody to be able
3723 # to read it in order to find the daemon's pid.
3724