2 # We use env, because in some environments of our build farm
3 # the Perl 5.010 interpreter is only reachable via $PATH
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. #
14 # Implementation started: 03 August 2005 by Philip Hazel #
15 # Placed in the Exim CVS: 06 February 2006 #
16 ###############################################################################
20 use feature 'state'; # included in 5.010
31 use FindBin qw'$RealBin';
33 use lib "$RealBin/lib";
36 use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####');
38 use constant TEST_TOP => 8999;
39 use constant TEST_SPECIAL_TOP => 9999;
42 # Start by initializing some global variables
44 chomp(my $testversion = `git describe --always --dirty 2>&1` || '<unknown>');
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*
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
52 my $gnutls_dh_bits_normal = 2236;
54 my $cf = 'bin/cf -exact';
58 my $f = Exim::Runtest::flavour() // '';
59 (grep { $f eq $_ } Exim::Runtest::flavours()) ? $f : 'FOO';
61 my $force_continue = 0;
63 my $log_failed_filename = 'failed-summary.log';
64 my $log_summary_filename = 'run-summary.log';
65 my $more = 'less -XF';
74 my $have_largefiles = 0;
77 my $test_end = TEST_TOP;
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
92 my $parm_ipv4_test_net = 224;
93 my $parm_ipv6_test_net = 'ff00';
95 # Port numbers are currently hard-wired
97 my $parm_port_n = 1223; # Nothing listening on this port
98 my $parm_port_s = 1224; # Used for the "server" command
99 my $parm_port_d = 1225; # Used for the Exim daemon
100 my $parm_port_d2 = 1226; # Additional for daemon
101 my $parm_port_d3 = 1227; # Additional for daemon
102 my $parm_port_d4 = 1228; # Additional for daemon
103 my $dynamic_socket; # allocated later for PORT_DYNAMIC
105 # Find a suiteable group name for test (currently only 0001
106 # uses a group name. A numeric group id would do
107 my $parm_mailgroup = Exim::Runtest::mailgroup('mail');
109 # Manually set locale
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};
115 my ($parm_configure_owner, $parm_configure_group);
116 my ($parm_ipv4, $parm_ipv6);
119 ###############################################################################
120 ###############################################################################
122 # Define a number of subroutines
124 ###############################################################################
125 ###############################################################################
128 ##################################################
130 ##################################################
132 sub pipehandler { $sigpipehappened = 1; }
134 sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); }
137 ##################################################
138 # Do global macro substitutions #
139 ##################################################
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.
147 s?\bCALLER\b?$parm_caller?g;
148 s?\bCALLERGROUP\b?$parm_caller_group?g;
149 s?\bCALLER_UID\b?$parm_caller_uid?g;
150 s?\bCALLER_GID\b?$parm_caller_gid?g;
151 s?\bCLAMSOCKET\b?$parm_clamsocket?g;
152 s?\bDIR/?$parm_cwd/?g;
153 s?\bEXIMGROUP\b?$parm_eximgroup?g;
154 s?\bEXIMUSER\b?$parm_eximuser?g;
155 s?\bHOSTIPV4\b?$parm_ipv4?g;
156 s?\bHOSTIPV6\b?$parm_ipv6?g;
157 s?\bHOSTNAME\b?$parm_hostname?g;
158 s?\bPORT_D\b?$parm_port_d?g;
159 s?\bPORT_D2\b?$parm_port_d2?g;
160 s?\bPORT_D3\b?$parm_port_d3?g;
161 s?\bPORT_D4\b?$parm_port_d4?g;
162 s?\bPORT_N\b?$parm_port_n?g;
163 s?\bPORT_S\b?$parm_port_s?g;
164 s?\bTESTNUM\b?$_[0]?g;
165 s?(\b|_)V4NET([\._])?$1$parm_ipv4_test_net$2?g;
166 s?\bV6NET:?$parm_ipv6_test_net:?g;
167 s?\bPORT_DYNAMIC\b?$dynamic_socket->sockport()?eg;
168 s?\bMAILGROUP\b?$parm_mailgroup?g;
172 ##################################################
173 # Any state to be preserved across tests #
174 ##################################################
179 ##################################################
180 # Subroutine to tidy up and exit #
181 ##################################################
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.
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
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
200 if (exists $TEST_STATE->{exim_pid})
202 $pid = $TEST_STATE->{exim_pid};
203 print "Tidyup: killing wait-mode daemon pid=$pid\n";
204 system("sudo kill -INT $pid");
207 if (opendir(DIR, "spool"))
209 my(@spools) = sort readdir(DIR);
211 foreach $spool (@spools)
213 next if $spool !~ /^exim-daemon./;
214 open(PID, "spool/$spool") || die "** Failed to open \"spool/$spool\": $!\n";
217 print "Tidyup: killing daemon pid=$pid\n";
218 system("sudo rm -f spool/$spool; sudo kill -INT $pid");
222 { die "** Failed to opendir(\"spool\"): $!\n" unless $!{ENOENT}; }
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.
229 system("sudo /bin/rm -rf ./spool test-* ./dnszones/*")
230 if ($rc == 0 && !$save_output);
232 system("sudo /bin/rm -rf ./eximdir/*")
235 print "\nYou were in test $test at the end there.\n\n" if defined $test;
236 exit $rc if ($rc >= 0);
237 die "** runtest error: $_[1]\n";
242 ##################################################
243 # Subroutines used by the munging subroutine #
244 ##################################################
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.
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
255 my($oldid, $base, $sequence) = @_;
256 my($newid) = $cache{$oldid};
257 if (! defined $newid)
259 $newid = sprintf($base, $$sequence++);
260 $cache{$oldid} = $newid;
266 # This is used while munging the output from exim_dumpdb.
267 # May go wrong across DST changes.
270 my($day,$month,$year,$hour,$min,$sec) =
271 $_[0] =~ /^(\d\d)-(\w\w\w)-(\d{4})\s(\d\d):(\d\d):(\d\d)/;
273 if ($month =~ /Jan/) {$mon = 0;}
274 elsif($month =~ /Feb/) {$mon = 1;}
275 elsif($month =~ /Mar/) {$mon = 2;}
276 elsif($month =~ /Apr/) {$mon = 3;}
277 elsif($month =~ /May/) {$mon = 4;}
278 elsif($month =~ /Jun/) {$mon = 5;}
279 elsif($month =~ /Jul/) {$mon = 6;}
280 elsif($month =~ /Aug/) {$mon = 7;}
281 elsif($month =~ /Sep/) {$mon = 8;}
282 elsif($month =~ /Oct/) {$mon = 9;}
283 elsif($month =~ /Nov/) {$mon = 10;}
284 elsif($month =~ /Dec/) {$mon = 11;}
285 return timelocal($sec,$min,$hour,$day,$mon,$year);
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
294 return $a cmp $b if ($a !~ /^\d+\.H\d/ || $b !~ /^\d+\.H\d/);
295 my($x1,$y1) = $a =~ /^(\d+)\.H(\d+)/;
296 my($x2,$y2) = $b =~ /^(\d+)\.H(\d+)/;
297 return ($x1 != $x2)? ($x1 <=> $x2) : ($y1 <=> $y2);
302 ##################################################
303 # Subroutine list files below a directory #
304 ##################################################
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
310 sub list_files_below {
315 opendir(DIR, $dir) || tests_exit(-1, "Failed to open $dir: $!");
316 @sublist = sort maildirsort readdir(DIR);
319 foreach $file (@sublist)
321 next if $file eq "." || $file eq ".." || $file eq "CVS";
323 { @yield = (@yield, list_files_below("$dir/$file")); }
325 { push @yield, "$dir/$file"; }
333 ##################################################
334 # Munge a file before comparing #
335 ##################################################
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.
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.
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.
361 open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!");
363 my($is_log) = $file =~ /log/;
364 my($is_stdout) = $file =~ /stdout/;
365 my($is_stderr) = $file =~ /stderr/;
366 my($is_mail) = $file =~ /mail/;
370 $date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}";
372 # Pattern for matching pids at start of stderr lines; initially something
375 $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
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
383 RESET_AFTER_EXTRA_LINE_READ:
387 next if $extra =~ m%^/% && eval $extra;
388 eval $extra if $extra =~ m/^s/;
391 # Check for "*** truncated ***"
392 $yield = 1 if /\*\*\* truncated \*\*\*/;
394 # Replace the name of this host
395 s/\Q$parm_hostname\E/the.local.host.name/g;
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;
400 # The name of the shell may vary
401 s/\s\Q$parm_shell\E\b/ ENV_SHELL/;
403 # Replace the path to the testsuite directory
404 s?\Q$parm_cwd\E?TESTSUITE?g;
406 # Replace the Exim version number (may appear in various places)
407 # patchexim should have fixed this for us
408 #s/(Exim) \d+\.\d+[\w_-]*/$1 x.yz/i;
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;
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/;
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/;
422 # Challenges in SPA authentication
423 s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/;
426 s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; # Old form
427 s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g; # New form
429 # There are differences in error messages between OpenSSL versions
430 s/SSL_CTX_set_cipher_list/SSL_connect/;
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/;
435 # This message sometimes has a different number of seconds
436 s/forced fail after \d seconds/forced fail after d seconds/;
438 # This message may contain a different DBM library name
439 s/Failed to open \S+( \([^\)]+\))? file/Failed to open DBM file/;
441 # The message for a non-listening FIFO varies
442 s/:[^:]+: while opening named pipe/: Error: while opening named pipe/;
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+/;
447 # Random local part in callout cache testing
448 s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/;
449 s/the.local.host.name-\d+-testing/the.local.host.name-dddddddd-testing/;
451 # File descriptor numbers may vary
452 s/^writing data block fd=\d+/writing data block fd=dddd/;
453 s/(running as transport filter:) fd_write=\d+ fd_read=\d+/$1 fd_write=dddd fd_read=dddd/;
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*$/)
462 my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
463 $expired = '' if !defined $expired;
464 my($increment) = date_seconds($date3) - date_seconds($date2);
466 # We used to use globally unique replacement values, but timing
467 # differences make this impossible. Just show the increment on the
470 printf MUNGED ("first failed = time last try = time2 next try = time2 + %s%s\n",
471 $increment, $expired);
475 # more_errno values in exim_dumpdb output which are times
476 s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /;
479 # ======== Dates and times ========
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.
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;
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;
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;
498 # Date of message arrival in spool file as shown by -Mvh
499 s/^\d{9,10}\s0$/ddddddddd 0/;
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;
504 # Dates/times in debugging output for writing retry records
505 if (/^ first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/)
508 $_ = " first failed=dddd last try=dddd next try=+$next $4\n";
510 s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\d)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/;
511 s/^(\s*)received_time=\d+ diff=\d+ timeout=(\d+)/$1received_time=tttt diff=tttt timeout=$2/;
513 # Time to retry may vary
514 s/time to retry = \S+/time to retry = tttt/;
515 s/retry record exists: age=\S+/retry record exists: age=ttt/;
516 s/failing_interval=\S+ message_age=\S+/failing_interval=ttt message_age=ttt/;
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;
521 # Time on queue tolerance
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;
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/;
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.
537 # TLSv1:AES128-GCM-SHA256:128
538 # TLSv1:AES256-SHA:256
539 # TLSv1.1:AES256-SHA:256
540 # TLSv1.2:AES256-GCM-SHA384:256
541 # TLSv1.2:DHE-RSA-AES256-SHA:256
542 # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
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 '(' )
549 s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.[12]:/$1TLSv1:/xg;
550 s/\bAES128-GCM-SHA256:128\b/AES256-SHA:256/g;
551 s/\bAES128-GCM-SHA256\b/AES256-SHA/g;
552 s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
553 s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
556 # TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256
557 s/\bECDHE-RSA-CHACHA20-POLY1305\b/AES256-SHA/g;
560 # TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256
561 # TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128
562 # TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical)
563 # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
565 # X=TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256
566 # X=TLS1.2:RSA_AES_256_CBC_SHA1:256
567 # X=TLS1.1:RSA_AES_256_CBC_SHA1:256
568 # X=TLS1.0:DHE_RSA_AES_256_CBC_SHA1:256
569 # and as stand-alone cipher:
570 # ECDHE-RSA-AES256-SHA
571 # DHE-RSA-AES256-SHA256
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;
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;
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;
583 # (this new one is a generic channel-read error, but the testsuite
584 # only hits it in one place)
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;
587 # (replace old with new, hoping that old only happens in one situation)
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;
591 # signature algorithm names
595 # ======== Caller's login, uid, gid, home, gecos ========
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
601 s/\beuid=$parm_caller_uid\b/euid=CALLER_UID/g;
602 s/\begid=$parm_caller_gid\b/egid=CALLER_GID/g;
604 s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g;
605 s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g;
607 s/\bname="?$parm_caller_gecos"?/name=CALLER_GECOS/g;
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.
613 s/^CALLER $> \d+$/CALLER UID GID/;
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?
619 s/^spaced user $> \d+$/CALLER UID GID/;
622 # ======== Exim's login ========
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
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./;
637 s/\beuid=$parm_exim_uid\b/euid=EXIM_UID/g;
638 s/\begid=$parm_exim_gid\b/egid=EXIM_GID/g;
640 s/\buid=$parm_exim_uid\b/uid=EXIM_UID/g;
641 s/\bgid=$parm_exim_gid\b/gid=EXIM_GID/g;
643 s/^$parm_eximuser $parm_exim_uid $parm_exim_gid/EXIMUSER EXIM_UID EXIM_GID/;
646 # ======== General uids, gids, and pids ========
647 # Note: this must come after munges for caller's and exim's uid/gid
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/;
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/;
667 # Pid in temp file in appendfile transport
668 s"test-mail/temp\.\d+\."test-mail/temp.pppp.";
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;
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)/;
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)/;
683 # The spool header file name varies with PID
684 s%^(Writing spool header file: .*/hdr).[0-9]{1,5}%$1.pppp%;
686 # ======== Port numbers ========
687 # Incoming port numbers may vary, but not in daemon startup line.
689 s/^Port: (\d+)/"Port: " . new_value($1, "%s", \$next_port)/e;
690 s/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e;
692 # This handles "connection from" and the like, when the port is given
693 if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/
694 && !/\*>/ && !/Connection refused/)
696 s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie;
699 # Port in host address in spool file output from -Mvh
700 s/^-host_address (.*)\.\d+/-host_address $1.9999/;
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>/;
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
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
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;
721 s/(^|\W)\K\Q$parm_ipv6\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g;
722 s/\b\Q$parm_ipv4r\E\b/ip4-reverse/g;
723 s/(^|\W)\K\Q$parm_ipv6r\E/ip6-reverse/g;
724 s/^(\s+host\s\S+\s+\[\S+\]) +$/$1 /;
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;
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/;
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/;
748 # ======== Other error numbers ========
749 s/errno=\d+/errno=dd/g;
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/;
755 # ======== Output from ls ========
756 # Different operating systems use different spacing on long output
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.
762 if (s/^([-d](?:[-r][-w][-SsTtx]){3})[.+@]?( +|$)/$1$2/) {
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
772 s/([\s,])S=\d+\b/$1S=sss/;
774 s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout;
775 s/\sSIZE=\d+\b/ SIZE=ssss/;
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/;
782 s/(?<=sum=dddd )count=\d+\b/count=dd/;
783 s/(?<=sum=0 )count=\d+\b/count=dd/;
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'/;
788 s/Received\s+\d+/Received nnn/;
789 s/Delivered\s+\d+/Delivered nnn/;
792 # ======== Values in spool space failure message ========
793 s/space=\d+ inodes=[+-]?\d+/space=xxxxx inodes=xxxxx/;
796 # ======== Filter sizes ========
797 # The sizes of filter files may vary because of the substitution of local
798 # filenames, logins, etc.
800 s/^\d+(?= bytes read from )/ssss/;
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.
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>>/;
812 next if /SSL verify error: depth=0 error=certificate not trusted/;
814 # ======== Maildir things ========
815 # timestamp output in maildir processing
816 s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g;
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/;
821 s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/;
823 # Maildir file names in general
824 s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/;
827 while (/^\d+S,\d+C\s*$/)
832 last if !/^\d+ \d+\s*$/;
833 print MUNGED "ddd d\n";
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.
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;
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/;
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;
862 # ==========================================================
863 # MIME boundaries in RFC3461 DSN messages
864 s/\d{8,10}-eximdsn-\d+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/;
866 # ==========================================================
867 # Some munging is specific to the specific file types
869 # ======== stdout ========
873 # Skip translate_ip_address and use_classresources in -bP output because
874 # they aren't always there.
876 next if /translate_ip_address =/;
877 next if /use_classresources/;
879 # In certain filter tests, remove initial filter lines because they just
880 # clog up by repetition.
884 next if /^(Sender\staken\sfrom|
885 Return-path\scopied\sfrom|
888 if (/^Testing \S+ filter/)
890 $_ = <IN>; # remove blank line
895 # remote IPv6 addrs vary
896 s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/;
898 # openssl version variances
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.
903 next if /^SSL info:/;
904 next if /SSL verify error: depth=0 error=certificate not trusted/;
905 s/SSL3_READ_BYTES/ssl3_read_bytes/i;
906 s/^\d+:error:\d+(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/;
908 # gnutls version variances
909 next if /^Error in the pull function./;
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/;
916 # ======== stderr ========
920 # The very first line of debugging output will vary
922 s/^Exim version .*/Exim version x.yz ..../;
924 # Debugging lines for Exim terminations
926 s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
928 # IP address lookups use gethostbyname() when IPv6 is not supported,
929 # and gethostbyname2() or getipnodebyname() when it is.
931 s/\b(gethostbyname2?|\bgetipnodebyname)(\(af=inet\))?/get[host|ipnode]byname[2]/;
933 # drop gnutls version strings
934 next if /GnuTLS compile-time version: \d+[\.\d]+$/;
935 next if /GnuTLS runtime version: \d+[\.\d]+$/;
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]+/;
942 next if /^Lookups \(built-in\):/;
943 next if /^Loading lookup modules from/;
944 next if /^Loaded \d+ lookup modules/;
945 next if /^Total \d+ lookups/;
947 # drop compiler information
948 next if /^Compiler:/;
951 # different libraries will have different numbers (possibly 0) of follow-up
952 # lines, indenting with more data
953 if (/^Library version:/) {
957 goto RESET_AFTER_EXTRA_LINE_READ;
961 # drop other build-time controls emitted for debugging
962 next if /^WHITELIST_D_MACROS:/;
963 next if /^TRUSTED_CONFIG_LIST:/;
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
968 next if /^changing group to \d+ failed: (Operation not permitted|Not owner)/;
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}) {
977 next if /^tls_validate_require_cipher child \d+ ended: status=0x0/;
979 # We invoke Exim with -D, so we hit this new message as of Exim 4.73:
980 next if /^macros_trusted overridden to true by whitelisting/;
982 # We have to omit the localhost ::1 address so that all is well in
983 # the IPv4-only case.
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/;
989 # drop pdkim debugging header
990 next if /^PDKIM <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+$/;
992 # Various other IPv6 lines must be omitted too
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?/;
999 if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/)
1001 $_= <IN>; # Gets "returning DNS_NODATA"
1005 # Skip tls_advertise_hosts and hosts_require_tls checks when the options
1006 # are unset, because tls ain't always there.
1008 next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?)
1009 \sno\s\((option\sunset|end\sof\slist)\)/x;
1011 # Skip auxiliary group lists because they will vary.
1013 next if /auxiliary group list:/;
1015 # Skip "extracted from gecos field" because the gecos field varies
1017 next if /extracted from gecos field/;
1019 # Skip "waiting for data on socket" and "read response data: size=" lines
1020 # because some systems pack more stuff into packets than others.
1022 next if /waiting for data on socket/;
1023 next if /read response data: size=/;
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.
1028 next if /failed to load readline:/;
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
1035 if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/)
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.
1045 if (/^condition: def:tls_cipher/)
1047 while (<IN>) { last if /^condition: def:sender_address/; }
1049 elsif (/^expanding: Received: /)
1051 while (<IN>) { last if !/^\s/; }
1054 # remote port numbers vary
1055 s/(Connection request from 127.0.0.1 port) \d{1,5}/$1 sssss/;
1057 # Skip hosts_require_dane checks when the options
1058 # are unset, because dane ain't always there.
1060 next if /in\shosts_require_dane\?\sno\s\(option\sunset\)/x;
1063 next if /host in hosts_proxy\?/;
1065 # Experimental_International
1066 next if / in smtputf8_advertise_hosts\? no \(option unset\)/;
1068 # Environment cleaning
1069 next if /\w+ in keep_environment\? (yes|no)/;
1071 # Sizes vary with test hostname
1072 s/^cmd buf flush \d+ bytes$/cmd buf flush ddd bytes/;
1074 # Spool filesystem free space changes on different systems.
1075 s/^((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/;
1077 # Non-TLS builds have different expansions for received_header_text
1078 if (s/(with \$received_protocol)\}\} \$\{if def:tls_cipher \{\(\$tls_cipher\)\n$/$1/)
1081 s/\s+\}\}(?=\(Exim )/\}\} /;
1083 if (/^ condition: def:tls_cipher$/)
1085 <IN>; <IN>; <IN>; <IN>; <IN>; <IN>;
1086 <IN>; <IN>; <IN>; <IN>; <IN>; next;
1089 # Not all platforms build with DKIM enabled
1090 next if /^PDKIM >> Body data for hash, canonicalized/;
1092 # Parts of DKIM-specific debug output depend on the time/date
1093 next if /^date:\w+,\{SP\}/;
1094 next if /^PDKIM \[[^[]+\] (Header hash|b) computed:/;
1096 # Not all platforms support TCP Fast Open, and the compile omits the check
1097 if (s/\S+ in hosts_try_fastopen\? no \(option unset\)\n$//)
1100 s/ \.\.\. >>> / ... /;
1101 s/Address family not supported by protocol family/Network Error/;
1102 s/Network is unreachable/Network Error/;
1105 next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/;
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.
1113 if (/^check_dir_size:/ || /^skipping TESTSUITE\/test-mail\//)
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;
1128 # Skip some lines that Exim puts out at the start of debugging output
1129 # because they will be different in different binaries.
1132 unless (/^Berkeley DB: / ||
1133 /^Probably (?:Berkeley DB|ndbm|GDBM)/ ||
1134 /^Authenticators:/ ||
1139 /^log selectors =/ ||
1141 /^Fixed never_users:/ ||
1142 /^Configure owner:/ ||
1152 # ======== log ========
1156 # Berkeley DB version differences
1157 next if / Berkeley DB error: /;
1160 # ======== All files other than stderr ========
1172 ##################################################
1173 # Subroutine to interact with caller #
1174 ##################################################
1176 # Arguments: [0] the prompt string
1177 # [1] if there is a U in the prompt and $force_update is true
1178 # [2] if there is a C in the prompt and $force_continue is true
1179 # Returns: returns the answer
1182 my ($prompt, $have_u, $have_c) = @_;
1187 print "... update forced\n";
1192 print "... continue forced\n";
1201 ##################################################
1202 # Subroutine to log in force_continue mode #
1203 ##################################################
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.
1209 # Arguments: [0] the logfile to append to
1210 # [1] the testno that failed
1216 my ($logfile, $testno, $detail) = @_;
1218 open(my $fh, '>>', $logfile) or return;
1220 print $fh "Test $testno "
1221 . (defined $detail ? "$detail " : '')
1225 # Computer-readable summary results logfile
1228 my ($logfile, $testno, $resultchar) = @_;
1230 open(my $fh, '>>', $logfile) or return;
1231 print $fh "$testno $resultchar\n";
1236 ##################################################
1237 # Subroutine to compare one output file #
1238 ##################################################
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.
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
1249 # [5] optionally, a custom munge command
1251 # Returns: 0 comparison succeeded
1252 # 1 comparison failed; differences to be ignored
1253 # 2 comparison failed; files may have been updated (=> re-compare)
1255 # Does not return if the user replies "Q" to a prompt.
1258 my($rf,$rsf,$mf,$sf,$sortfile,$extra) = @_;
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.
1263 # we check if there is a flavour specific file, but we remember
1264 # the original file name as "generic"
1266 $sf_flavour = "$sf_generic.$flavour";
1267 $sf_current = -e $sf_flavour ? $sf_flavour : $sf_generic;
1269 if (! -e $sf_current)
1271 return 0 if (! -s $rf && (! defined $rsf || ! -s $rsf));
1274 print "** $rf is not empty\n" if (-s $rf);
1275 print "** $rsf is not empty\n" if (defined $rsf && -s $rsf);
1279 $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
1280 tests_exit(1) if /^q?$/;
1281 if (/^c$/ && $force_continue) {
1282 log_failure($log_failed_filename, $testno, $rf);
1283 log_test($log_summary_filename, $testno, 'F') if ($force_continue);
1285 return 1 if /^c$/i && $rf !~ /paniclog/ && $rsf !~ /paniclog/;
1289 foreach $f ($rf, $rsf)
1291 if (defined $f && -s $f)
1294 print "------------ $f -----------\n"
1295 if (defined $rf && -s $rf && defined $rsf && -s $rsf);
1296 system("$more '$f'");
1303 $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
1304 tests_exit(1) if /^q?$/;
1305 if (/^c$/ && $force_continue) {
1306 log_failure($log_failed_filename, $testno, $rf);
1307 log_test($log_summary_filename, $testno, 'F')
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.
1320 open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
1321 my($truncated) = munge($rf, $extra) if -e $rf;
1323 # Append the raw server log, if it is non-empty
1324 if (defined $rsf && -e $rsf)
1326 print MUNGED "\n******** SERVER ********\n";
1327 $truncated |= munge($rsf, $extra);
1331 # If a saved file exists, do the comparison. There are two awkward cases:
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.
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.
1347 # Deal with truncated text items
1351 my(@munged, @saved, $i, $j, $k);
1353 open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");
1356 open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $sf_current: $!");
1361 for ($i = 0; $i < @munged; $i++)
1363 if ($munged[$i] =~ /\*\*\* truncated \*\*\*/)
1365 for (; $j < @saved; $j++)
1366 { last if $saved[$j] =~ /\*\*\* truncated \*\*\*/; }
1367 last if $j >= @saved; # not found in saved
1369 for ($k = $i - 1; $k >= 0; $k--)
1370 { last if $munged[$k] eq $saved[$j - 1]; }
1372 last if $k <= 0; # failed to find previous match
1373 splice @munged, $k + 1, $i - $k - 1;
1378 open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
1379 for ($i = 0; $i < @munged; $i++)
1380 { print MUNGED $munged[$i]; }
1384 # Deal with log sorting
1388 my(@munged, $i, $j);
1390 open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");
1394 for ($i = 0; $i < @munged; $i++)
1396 if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/)
1398 for ($j = $i + 1; $j < @munged; $j++)
1400 last if $munged[$j] !~
1401 /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/;
1403 @temp = splice(@munged, $i, $j - $i);
1404 @temp = sort(@temp);
1405 splice(@munged, $i, 0, @temp);
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]; }
1418 return 0 if (system("$cf '$mf' '$sf_current' >test-cf") == 0);
1420 # Handle comparison failure
1422 print "** Comparison of $mf with $sf_current failed";
1423 system("$more test-cf");
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?$/;
1432 if (/^c$/ && $force_continue) {
1433 log_failure($log_failed_filename, $testno, $sf_current);
1434 log_test($log_summary_filename, $testno, 'F')
1438 last if (/^[us]$/i);
1442 # Update or delete the saved file, and give the appropriate return code.
1446 my $sf = /^u/i ? $sf_current : $sf_flavour;
1447 tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0;
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");
1458 tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current);
1467 ##################################################
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.
1472 # paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail
1473 # Search strings starting with 's' do substitutions;
1474 # with '/' do line-skips.
1475 # Triggered by a scriptfile line "munge <name>"
1476 ##################################################
1479 { 'stderr' => '/^Reverse DNS security status: unverified\n/' },
1481 'gnutls_unexpected' =>
1482 { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./' },
1484 'gnutls_handshake' =>
1485 { 'mainlog' => 's/\(gnutls_handshake\): Error in the push function/\(gnutls_handshake\): A TLS packet with unexpected length was received/' },
1487 'optional_events' =>
1488 { 'stdout' => '/event_action =/' },
1491 { 'stderr' => '/127.0.0.1 in hosts_requ(ire|est)_ocsp/' },
1493 'optional_cert_hostnames' =>
1494 { 'stderr' => '/in tls_verify_cert_hostnames\? no/' },
1497 { 'stdout' => 's/[[](127\.0\.0\.1|::1)]/[IP_LOOPBACK_ADDR]/' },
1500 { 'stdout' => 's/(Content-length:) \d\d\d/$1 ddd/' },
1503 { 'stderr' => 's/(1[5-9]|23\d)\d\d msec/ssss msec/' },
1506 { 'mainlog' => 's/ X=TLS\S+ / X=TLS_proto_and_cipher /' },
1509 { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d{1,5}/ppppp/g' },
1511 'optional_dsn_info' =>
1512 { 'mail' => '/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/'
1515 'optional_config' =>
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
1526 { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' },
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>/'},
1532 'debuglog_stdout' =>
1533 { 'stdout' => 's/^\d\d:\d\d:\d\d\s+\d+ //;
1534 s/Process \d+ is ready for new message/Process pppp is ready for new message/'
1537 'timeout_errno' => # actual errno differs Solaris vs. Linux
1538 { 'mainlog' => 's/(host deferral .* errno) <\d+> /$1 <EEE> /' },
1544 return $a if ($a > $b);
1548 ##################################################
1549 # Subroutine to check the output of a test #
1550 ##################################################
1552 # This function is called when the series of subtests is complete. It makes
1553 # use of check_file(), whose arguments are:
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
1560 # [5] an optional custom munge command
1562 # Arguments: Optionally, name of a single custom munge to run.
1563 # Returns: 0 if the output compared equal
1564 # 1 if comparison failed; differences to be ignored
1565 # 2 if re-run needed (files may have been updated)
1568 my($mungename) = $_[0];
1570 my($munge) = $munges->{$mungename} if defined $mungename;
1572 $yield = max($yield, check_file("spool/log/paniclog",
1573 "spool/log/serverpaniclog",
1574 "test-paniclog-munged",
1575 "paniclog/$testno", 0,
1576 $munge->{paniclog}));
1578 $yield = max($yield, check_file("spool/log/rejectlog",
1579 "spool/log/serverrejectlog",
1580 "test-rejectlog-munged",
1581 "rejectlog/$testno", 0,
1582 $munge->{rejectlog}));
1584 $yield = max($yield, check_file("spool/log/mainlog",
1585 "spool/log/servermainlog",
1586 "test-mainlog-munged",
1587 "log/$testno", $sortlog,
1588 $munge->{mainlog}));
1592 $yield = max($yield, check_file("test-stdout",
1593 "test-stdout-server",
1594 "test-stdout-munged",
1595 "stdout/$testno", 0,
1601 $yield = max($yield, check_file("test-stderr",
1602 "test-stderr-server",
1603 "test-stderr-munged",
1604 "stderr/$testno", 0,
1608 # Compare any delivered messages, unless this test is skipped.
1610 if (! $message_skip)
1614 # Get a list of expected mailbox files for this script. We don't bother with
1615 # directories, just the files within them.
1617 foreach $oldmail (@oldmails)
1619 next unless $oldmail =~ /^mail\/$testno\./;
1620 print ">> EXPECT $oldmail\n" if $debug;
1621 $expected_mails{$oldmail} = 1;
1624 # If there are any files in test-mail, compare them. Note that "." and
1625 # ".." are automatically omitted by list_files_below().
1627 @mails = list_files_below("test-mail");
1629 foreach $mail (@mails)
1631 next if $mail eq "test-mail/oncelog";
1633 $saved_mail = substr($mail, 10); # Remove "test-mail/"
1634 $saved_mail =~ s/^$parm_caller(\/|$)/CALLER/; # Convert caller name
1636 if ($saved_mail =~ /(\d+\.[^.]+\.)/)
1639 $saved_mail =~ s/(\d+\.[^.]+\.)/$msgno./gx;
1642 print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
1643 $yield = max($yield, check_file($mail, undef, "test-mail-munged",
1644 "mail/$testno.$saved_mail", 0,
1646 delete $expected_mails{"mail/$testno.$saved_mail"};
1649 # Complain if not all expected mails have been found
1651 if (scalar(keys %expected_mails) != 0)
1653 foreach $key (keys %expected_mails)
1654 { print "** no test file found for $key\n"; }
1658 $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
1659 tests_exit(1) if /^q?$/;
1660 if (/^c$/ && $force_continue) {
1661 log_failure($log_failed_filename, $testno, "missing email");
1662 log_test($log_summary_filename, $testno, 'F')
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.
1672 foreach $key (keys %expected_mails)
1675 tests_exit(-1, "Failed to unlink $key") if !unlink("$key");
1676 for ($i = 0; $i < @oldmails; $i++)
1678 if ($oldmails[$i] eq $key)
1680 splice @oldmails, $i, 1;
1691 # Compare any remaining message logs, unless this test is skipped.
1695 # Get a list of expected msglog files for this test
1697 foreach $oldmsglog (@oldmsglogs)
1699 next unless $oldmsglog =~ /^$testno\./;
1700 $expected_msglogs{$oldmsglog} = 1;
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
1707 if (opendir(DIR, "spool/msglog"))
1709 @msglogs = sort readdir(DIR);
1712 foreach $msglog (@msglogs)
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;
1718 $yield = max($yield, check_file("spool/msglog/$msglog", undef,
1719 "test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
1721 delete $expected_msglogs{"$testno.$munged_msglog"};
1725 # Complain if not all expected msglogs have been found
1727 if (scalar(keys %expected_msglogs) != 0)
1729 foreach $key (keys %expected_msglogs)
1731 print "** no test msglog found for msglog/$key\n";
1732 ($msgid) = $key =~ /^\d+\.(.*)$/;
1733 foreach $cachekey (keys %cache)
1735 if ($cache{$cachekey} eq $msgid)
1737 print "** original msgid $cachekey\n";
1745 $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
1746 tests_exit(1) if /^q?$/;
1747 if (/^c$/ && $force_continue) {
1748 log_failure($log_failed_filename, $testno, "missing msglog");
1749 log_test($log_summary_filename, $testno, 'F')
1754 foreach $key (keys %expected_msglogs)
1756 tests_exit(-1, "Failed to unlink msglog/$key")
1757 if !unlink("msglog/$key");
1770 ##################################################
1771 # Subroutine to run one "system" command #
1772 ##################################################
1774 # We put this in a subroutine so that the command can be reflected when
1777 # Argument: the command to be run
1785 $prcmd =~ s/; /;\n>> /;
1786 print ">> $prcmd\n";
1793 ##################################################
1794 # Subroutine to run one script command #
1795 ##################################################
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
1800 # in this way. In all lines, the following substitutions are made:
1802 # DIR => the current directory
1803 # CALLER => the caller of this script
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)
1809 # auxiliary information returned from a previous run
1811 # Returns: 0 the command was executed inline, no subprocess was run
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
1816 # Optionally also a second parameter, a hash-ref, with auxiliary information:
1817 # exim_pid: pid of a run process
1818 # munge: name of a post-script results munger
1821 my($testno) = $_[0];
1822 my($subtestref) = $_[1];
1823 my($commandnameref) = $_[3];
1824 my($aux_info) = $_[4];
1827 our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
1829 if (/^(\d+)\s*$/) # Handle unusual return code
1834 return 4 if !defined $_; # Missing command
1841 # Handle concatenated command lines
1844 while (substr($_, -1) eq"\\")
1847 $_ = substr($_, 0, -1);
1848 chomp($temp = <SCRIPT>);
1860 do_substitute($testno);
1861 if ($debug) { printf ">> $_\n"; }
1863 # Pass back the command name (for messages)
1865 ($$commandnameref) = /^(\S+)/;
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.
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.
1878 if (/^dbmbuild\s+(\S+)\s+(\S+)/)
1880 run_system("(./eximdir/exim_dbmbuild $parm_cwd/$1 $parm_cwd/$2;" .
1881 "echo exim_dbmbuild exit code = \$?)" .
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.
1892 if (/^dump\s+(\S+)/)
1896 print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
1897 open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");
1898 open(OUT, ">>test-stdout");
1899 print OUT "+++++++++++++++++++++++++++\n";
1901 if ($which eq "retry")
1908 my($aa) = split(' ', $a);
1909 my($bb) = split(' ', $b);
1913 foreach $item (@temp)
1915 $item =~ s/^\s*(.*)\n(.*)\n?\s*$/$1\n$2/m;
1916 print OUT " $item\n";
1922 if ($which eq "callout")
1925 my($aa) = substr $a, 21;
1926 my($bb) = substr $b, 21;
1939 # verbose comments start with ###
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";
1948 # The "echo" command is a way of writing comments to the screen.
1949 if (/^echo\s+(.*)$/)
1956 # The "exim_lock" command runs exim_lock in the same manner as "server",
1957 # but it doesn't use any input.
1959 if (/^exim_lock\s+(.*)$/)
1961 $cmd = "./eximdir/exim_lock $1 >>test-stdout";
1962 $server_pid = open SERVERCMD, "|$cmd" ||
1963 tests_exit(-1, "Failed to run $cmd\n");
1965 # This gives the process time to get started; otherwise the next
1966 # process may not find it there when it expects it.
1968 select(undef, undef, undef, 0.1);
1973 # The "exinext" command runs exinext
1975 if (/^exinext\s+(.*)/)
1977 run_system("(./eximdir/exinext " .
1978 "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
1979 "-C $parm_cwd/test-config $1;" .
1980 "echo exinext exit code = \$?)" .
1986 # The "exigrep" command runs exigrep on the current mainlog
1988 if (/^exigrep\s+(.*)/)
1990 run_system("(./eximdir/exigrep " .
1991 "$1 $parm_cwd/spool/log/mainlog;" .
1992 "echo exigrep exit code = \$?)" .
1998 # The "eximstats" command runs eximstats on the current mainlog
2000 if (/^eximstats\s+(.*)/)
2002 run_system("(./eximdir/eximstats " .
2003 "$1 $parm_cwd/spool/log/mainlog;" .
2004 "echo eximstats exit code = \$?)" .
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.
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";
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.
2029 my $return_extra = {};
2030 if (exists $aux_info->{exim_pid})
2032 $pid = $aux_info->{exim_pid};
2033 $return_extra->{exim_pid} = undef;
2034 print ">> killdaemon: recovered pid $pid\n" if $debug;
2037 run_system("sudo /bin/kill -INT $pid");
2041 $pid = `cat $parm_cwd/spool/exim-daemon.*`;
2044 run_system("sudo /bin/kill -INT $pid");
2045 close DAEMONCMD; # Waits for process
2048 run_system("sudo /bin/rm -f spool/exim-daemon.*");
2049 return (1, $return_extra);
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
2057 elsif (/^millisleep\s+(.*)$/)
2059 select(undef, undef, undef, $1/1000);
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,
2068 # Currently only the last munge takes effect.
2070 if (/^munge\s+(.*)$/)
2072 return (0, { munge => $1 });
2076 # The "sleep" command does just that. For sleeps longer than 1 second we
2077 # tell the user what's going on.
2079 if (/^sleep\s+(.*)$/)
2087 printf(" Test %d sleep $1 ", $$subtestref);
2093 printf("\r Test %d $cr", $$subtestref);
2099 # Various Unix management commands are recognized
2101 if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ ||
2102 /^sudo\s(rmdir|rm|mv|chown|chmod)\s/)
2104 run_system("$_ >>test-stdout 2>>test-stderr");
2113 # The next group of commands are also freestanding, but they are all followed
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.
2123 # This works because "server" swallows its stdin before waiting for a connection.
2125 if (/^server\s+(.*)$/)
2127 $pidfile = "$parm_cwd/aux-var/server-daemon.pid";
2128 $cmd = "./bin/server $server_opts -oP $pidfile $1 >>test-stdout-server";
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;
2136 last if /^\*{4}\s*$/;
2139 print SERVERCMD "++++\n"; # Send end to server; can't send EOF yet
2140 # because close() waits for the process.
2142 # Interlock the server startup; otherwise the next
2143 # process may not find it there when it expects it.
2144 while (! stat("$pidfile") ) { select(undef, undef, undef, 0.3); }
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.
2154 if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/)
2156 my($cat) = defined $1;
2158 @sizes = split /\s+/, $3 if defined $3;
2159 open FILE, ">$2" || tests_exit(-1, "Failed to open \"$2\": $!");
2163 open CAT, ">>test-stdout" ||
2164 tests_exit(-1, "Failed to open test-stdout: $!");
2165 print CAT "==========\n";
2168 if (scalar @sizes > 0)
2175 last if /^\+{4}\s*$/;
2182 while (scalar @sizes > 0)
2184 ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
2185 $leadin = '' if !defined $leadin;
2187 $len -= length($leadin) + 1;
2188 while ($count-- > 0)
2190 print FILE $leadin, "a" x $len, "\n";
2191 print CAT $leadin, "a" x $len, "\n" if $cat;
2196 # Post data, or only data if no sized data
2201 last if /^\*{4}\s*$/;
2209 print CAT "==========\n";
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.
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.
2229 if (/^client/ || /^(sudo\s+)?perl\b/)
2231 s"client"./bin/client";
2232 $cmd = "$_ >>test-stdout 2>>test-stderr";
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.
2241 elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/)
2244 my($envset) = (defined $1)? $1 : '';
2245 my($sudo) = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":'') : '';
2246 my($special)= (defined $5)? $5 : '';
2247 $wait_time = (defined $2)? $2 : 0;
2249 # Return 2 rather than 1 afterwards
2253 # Update the test number
2255 $$subtestref = $$subtestref + 1;
2256 printf(" Test %d $cr", $$subtestref);
2258 # Copy the configuration file, making the usual substitutions.
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");
2266 do_substitute($testno);
2272 # The string $msg1 in args substitutes the message id of the first
2273 # message on the queue, and so on. */
2275 if ($args =~ /\$msg/)
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;
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
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");
2292 # Done backwards just in case there are more than 9
2294 for (my $i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; }
2295 if ( $args =~ /\$msg\d/ )
2297 tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n")
2298 unless $force_continue;
2302 # If -d is specified in $optargs, remove it from $args; i.e. let
2303 # the command line for runtest override. Then run Exim.
2305 $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/;
2307 my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : '';
2309 $cmd = "$envset$sudo$opt_valgrind" .
2310 "$parm_cwd/eximdir/exim$special$optargs " .
2311 "-DEXIM_PATH=$parm_cwd/eximdir/exim$special " .
2312 "-C $parm_cwd/test-config $args " .
2313 ">>test-stdout 2>>test-stderr";
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.
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.
2325 if ($cmd =~ /\s-DSERVER=server\s/ && $cmd !~ /\s-DNOTDAEMON\s/)
2327 if ($debug) { printf ">> daemon: $cmd\n"; }
2328 run_system("sudo mkdir spool/log 2>/dev/null");
2329 run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log");
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
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.
2337 if ($cmd =~ /\s-oP\s/)
2339 ($pidfile = $cmd) =~ s/^.*-oP ([^ ]+).*$/$1/;
2340 $cmd =~ s!\s-bd\s! -bdf !;
2344 $pidfile = "$parm_cwd/spool/exim-daemon.pid";
2345 $cmd =~ s!\s-bd\s! -bdf -oP $pidfile !;
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
2352 # Interlock with daemon startup
2353 for (my $count = 0; ! stat("$pidfile") && $count < 30; $count++ )
2354 { select(undef, undef, undef, 0.3); }
2355 return 3; # Don't wait
2357 elsif ($cmd =~ /\s-DSERVER=wait:(\d+)\s/)
2360 # The port and the $dynamic_socket was already allocated while parsing the
2361 # script file, where -DSERVER=wait:PORT_DYNAMIC was encountered.
2363 my $listen_port = $1;
2364 if ($debug) { printf ">> wait-mode daemon: $cmd\n"; }
2365 run_system("sudo mkdir spool/log 2>/dev/null");
2366 run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log");
2369 if (not defined $pid) { die "** fork failed: $!\n" }
2372 open(STDIN, '<&', $dynamic_socket) or die "** dup sock to stdin failed: $!\n";
2373 close($dynamic_socket);
2374 print "[$$]>> ${cmd}-server\n" if ($debug);
2375 exec "exec ${cmd}-server";
2376 die "Can't exec ${cmd}-server: $!\n";
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
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
2388 elsif (/^background$/)
2391 # $pidfile = "$parm_cwd/aux-var/server-daemon.pid";
2393 $_ = <SCRIPT>; $lineno++;
2396 if ($debug) { printf ">> daemon: $line >>test-stdout 2>>test-stderr\n"; }
2399 if (not defined $pid) { die "** fork failed: $!\n" }
2401 print "[$$]>> ${line}\n" if ($debug);
2403 open(STDIN, "<", "test-stdout");
2405 open(STDOUT, ">>", "test-stdout");
2407 open(STDERR, ">>", "test-stderr-server");
2408 exec "exec ${line}";
2412 # open(my $fh, ">", $pidfile) ||
2413 # tests_exit(-1, "Failed to open $pidfile: $!");
2414 # printf($fh, "%d\n", $pid);
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
2426 else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); }
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.
2435 $stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : '';
2436 print ">> |${cmd}${stderrsuffix}\n" if ($debug);
2437 open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
2443 last if /^\*{4}\s*$/;
2444 do_substitute($testno);
2445 if (/^(.*)\\NONL\\\s*$/) { print CMD $1; } else { print CMD; }
2448 # For timeout tests, wait before closing the pipe; we expect a
2449 # SIGPIPE error in this case.
2453 printf(" Test %d sleep $wait_time ", $$subtestref);
2454 while ($wait_time-- > 0)
2459 printf("\r Test %d $cr", $$subtestref);
2462 $sigpipehappened = 0;
2463 close CMD; # Waits for command to finish
2464 return $yield; # Ran command and waited
2470 ###############################################################################
2471 ###############################################################################
2473 # Here begins the Main Program ...
2475 ###############################################################################
2476 ###############################################################################
2480 print "Exim tester $testversion\n";
2482 # extend the PATH with .../sbin
2483 # we map all (.../bin) to (.../sbin:.../bin)
2485 my %seen = map { $_, 1 } split /:/, $ENV{PATH};
2486 join ':' => map { m{(.*)/bin$}
2487 ? ( $seen{"$1/sbin"} ? () : ("$1/sbin"), $_)
2489 split /:/, $ENV{PATH};
2492 ##################################################
2493 # Some tests check created file modes #
2494 ##################################################
2499 ##################################################
2500 # Check for the "less" command #
2501 ##################################################
2503 $more = 'more' if system('which less >/dev/null 2>&1') != 0;
2507 ##################################################
2508 # See if an Exim binary has been given #
2509 ##################################################
2511 # If the first character of the first argument is '/', the argument is taken
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.
2516 ##################################################
2517 # Sort out options and which tests are to be run #
2518 ##################################################
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.
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,
2533 'valgrind' => \$valgrind,
2534 'flavor|flavour=s' => \$flavour,
2535 'help' => sub { pod2usage(-exit => 0) },
2540 -noperldoc => system('perldoc -V 2>/dev/null 1>&2')
2545 ($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);
2546 print "Exim binary is `$parm_exim'\n" if defined $parm_exim;
2548 # Any subsequent arguments are a range of test numbers.
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 '+';
2556 die "** Test numbers out of order\n" if ($test_end < $test_start);
2559 ##################################################
2560 # Check for sudo access to root #
2561 ##################################################
2563 print "You need to have sudo access to root to run these tests. Checking ...\n";
2564 if (system('sudo true >/dev/null') != 0)
2566 die "** Test for sudo failed: testing abandoned.\n";
2570 print "Test for sudo OK\n";
2576 ##################################################
2577 # Make the command's directory current #
2578 ##################################################
2580 # After doing so, we find its absolute path name.
2583 $cwd = '.' if ($cwd !~ s|/[^/]+$||);
2584 chdir($cwd) || die "** Failed to chdir to \"$cwd\": $!\n";
2585 $parm_cwd = Cwd::getcwd();
2588 ##################################################
2589 # Search for an Exim binary to test #
2590 ##################################################
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
2598 # If $parm_exim is still empty, ask the caller
2600 if ($parm_exim eq '')
2602 print "** Did not find an Exim binary to test\n";
2603 for ($i = 0; $i < 5; $i++)
2606 print "** Enter pathname for Exim binary: ";
2607 chomp($trybin = <STDIN>);
2610 $parm_exim = $trybin;
2615 print "** $trybin does not exist\n";
2618 die "** Too many tries\n" if $parm_exim eq '';
2623 ##################################################
2624 # Find what is in the binary #
2625 ##################################################
2627 # deal with TRUSTED_CONFIG_LIST restrictions
2628 unlink("$parm_cwd/test-config") if -e "$parm_cwd/test-config";
2629 open (IN, "$parm_cwd/confs/0000") ||
2630 tests_exit(-1, "Couldn't open $parm_cwd/confs/0000: $!\n");
2631 open (OUT, ">test-config") ||
2632 tests_exit(-1, "Couldn't open test-config: $!\n");
2633 while (<IN>) { print OUT; }
2637 print("Probing with config file: $parm_cwd/test-config\n");
2639 my $eximinfo = "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd -bP exim_user exim_group";
2640 chomp(my @eximinfo = `$eximinfo 2>&1`);
2641 die "$0: Can't run $eximinfo\n" if $? == -1;
2643 warn 'Got ' . $?>>8 . " from $eximinfo\n" if $?;
2646 if (my ($version) = /^Exim version (\S+)/) {
2647 my $git = `git describe --dirty=-XX --match 'exim-4*'`;
2648 if (defined $git and $? == 0) {
2650 $version =~ s/^\d+\K\./_/;
2651 $git =~ s/^exim-//i;
2652 $git =~ s/.*-\Kg([[:xdigit:]]+(?:-XX)?)/$1/;
2655 *** Version mismatch
2656 *** Exim binary: $version
2660 if not $version eq $git;
2663 $parm_eximuser = $1 if /^exim_user = (.*)$/;
2664 $parm_eximgroup = $1 if /^exim_group = (.*)$/;
2665 $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/;
2666 ($parm_configure_owner, $parm_configure_group) = ($1, $2)
2667 if /^Configure owner:\s*(\d+):(\d+)/;
2668 print if /wrong owner/;
2671 if (not defined $parm_eximuser) {
2672 die <<XXX, map { "|$_\n" } @eximinfo;
2673 Unable to extract exim_user from binary.
2674 Check if Exim refused to run; if so, consider:
2675 TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS
2676 If debug permission denied, are you in the exim group?
2677 Failing to get information from binary.
2678 Output from $eximinfo:
2683 if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
2684 else { $parm_exim_uid = getpwnam($parm_eximuser); }
2686 if (defined $parm_eximgroup)
2688 if ($parm_eximgroup =~ /^\d+$/) { $parm_exim_gid = $parm_eximgroup; }
2689 else { $parm_exim_gid = getgrnam($parm_eximgroup); }
2692 # check the permissions on the TRUSTED_CONFIG_LIST
2693 if (defined $parm_trusted_config_list)
2695 die "TRUSTED_CONFIG_LIST: $parm_trusted_config_list: $!\n"
2696 if not -f $parm_trusted_config_list;
2698 die "TRUSTED_CONFIG_LIST $parm_trusted_config_list must not be world writable!\n"
2699 if 02 & (stat _)[2];
2701 die sprintf "TRUSTED_CONFIG_LIST: $parm_trusted_config_list %d is group writable, but not owned by group '%s' or '%s'.\n",
2703 scalar(getgrgid 0), scalar(getgrgid $>)
2704 if (020 & (stat _)[2]) and not ((stat _)[5] == $> or (stat _)[5] == 0);
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));
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>;
2717 die "Unable to check the TRUSTED_CONFIG_LIST, seems to be empty?\n";
2720 die "CONFIGURE_OWNER ($parm_configure_owner) does not match the user invoking $0 ($>)\n"
2721 if $parm_configure_owner != $>;
2723 die "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 != $);
2728 open(EXIMINFO, "$parm_exim -d-all+transport -bV -C $parm_cwd/test-config -DDIR=$parm_cwd |") ||
2729 die "** Cannot run $parm_exim: $!\n";
2731 print "-" x 78, "\n";
2737 if (/^(Exim|Library) version/) { print; }
2739 elsif (/^Size of off_t: (\d+)/)
2742 $have_largefiles = 1 if $1 > 4;
2743 die "** Size of off_t > 32 which seems improbable, not running tests\n"
2747 elsif (/^Support for: (.*)/)
2750 @temp = split /(\s+)/, $1;
2752 %parm_support = @temp;
2755 elsif (/^Lookups \(built-in\): (.*)/)
2758 @temp = split /(\s+)/, $1;
2760 %parm_lookups = @temp;
2763 elsif (/^Authenticators: (.*)/)
2766 @temp = split /(\s+)/, $1;
2768 %parm_authenticators = @temp;
2771 elsif (/^Routers: (.*)/)
2774 @temp = split /(\s+)/, $1;
2776 %parm_routers = @temp;
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
2783 elsif (/^Transports: (.*)/)
2786 @temp = split /(\s+)/, $1;
2789 %parm_transports = @temp;
2790 foreach $k (keys %parm_transports)
2794 @temp = split /\//, $k;
2795 $parm_transports{$temp[0]} = " ";
2796 for ($i = 1; $i < @temp; $i++)
2797 { $parm_transports{"$temp[0]/$temp[$i]"} = " "; }
2803 print "-" x 78, "\n";
2805 unlink("$parm_cwd/test-config");
2807 ##################################################
2808 # Check for SpamAssassin and ClamAV #
2809 ##################################################
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.
2814 if (defined $parm_support{Content_Scanning})
2816 my $sock = new FileHandle;
2818 if (system("spamc -h 2>/dev/null >/dev/null") == 0)
2820 print "The spamc command works:\n";
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
2825 # changed. spamd doesn't have the nice PING/PONG protocol that
2826 # clamd does, but it does respond to errors in an informative manner,
2829 my($sint,$sport) = ('127.0.0.1',783);
2832 my $sin = sockaddr_in($sport, inet_aton($sint))
2833 or die "** Failed packing $sint:$sport\n";
2834 socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
2835 or die "** Unable to open socket $sint:$sport\n";
2838 sub { die "** Timeout while connecting to socket $sint:$sport\n"; };
2840 connect($sock, $sin)
2841 or die "** Unable to connect to socket $sint:$sport\n";
2844 select((select($sock), $| = 1)[0]);
2845 print $sock "bad command\r\n";
2848 sub { die "** Timeout while reading from socket $sint:$sport\n"; };
2854 or die "** Did not get SPAMD from socket $sint:$sport. "
2861 print " Assume SpamAssassin (spamd) is not running\n";
2865 $parm_running{SpamAssassin} = ' ';
2866 print " SpamAssassin (spamd) seems to be running\n";
2871 print "The spamc command failed: assume SpamAssassin (spamd) is not running\n";
2874 # For ClamAV, we need to find the clamd socket for use in the Exim
2875 # configuration. Search for the clamd configuration file.
2877 if (system("clamscan -h 2>/dev/null >/dev/null") == 0)
2879 my($f, $clamconf, $test_prefix);
2881 print "The clamscan command works";
2883 $test_prefix = $ENV{EXIM_TEST_PREFIX};
2884 $test_prefix = '' if !defined $test_prefix;
2886 foreach $f ("$test_prefix/etc/clamd.conf",
2887 "$test_prefix/usr/local/etc/clamd.conf",
2888 "$test_prefix/etc/clamav/clamd.conf", '')
2897 # Read the ClamAV configuration file and find the socket interface.
2899 if ($clamconf ne '')
2902 open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
2905 if (/^LocalSocket\s+(.*)/)
2907 $parm_clamsocket = $1;
2908 $socket_domain = AF_UNIX;
2911 if (/^TCPSocket\s+(\d+)/)
2913 if (defined $parm_clamsocket)
2915 $parm_clamsocket .= " $1";
2916 $socket_domain = AF_INET;
2921 $parm_clamsocket = " $1";
2924 elsif (/^TCPAddr\s+(\S+)/)
2926 if (defined $parm_clamsocket)
2928 $parm_clamsocket = $1 . $parm_clamsocket;
2929 $socket_domain = AF_INET;
2934 $parm_clamsocket = $1;
2940 if (defined $socket_domain)
2942 print ":\n The clamd socket is $parm_clamsocket\n";
2943 # This test for an active ClamAV is courtesy of Daniel Tiefnig.
2947 if ($socket_domain == AF_UNIX)
2949 $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n";
2951 elsif ($socket_domain == AF_INET)
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";
2959 die "** Unknown socket domain '$socket_domain' (should not happen)\n";
2961 socket($sock, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n";
2962 local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; };
2964 connect($sock, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n";
2967 my $ofh = select $sock; $| = 1; select $ofh;
2968 print $sock "PING\n";
2970 $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; };
2975 $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n";
2982 print " Assume ClamAV is not running\n";
2986 $parm_running{ClamAV} = ' ';
2987 print " ClamAV seems to be running\n";
2992 print ", but the socket for clamd could not be determined\n";
2993 print "Assume ClamAV is not running\n";
2999 print ", but I can't find a configuration for clamd\n";
3000 print "Assume ClamAV is not running\n";
3006 ##################################################
3008 ##################################################
3009 if (defined $parm_lookups{redis})
3011 if (system("redis-server -v 2>/dev/null >/dev/null") == 0)
3013 print "The redis-server command works\n";
3014 $parm_running{redis} = ' ';
3018 print "The redis-server command failed: assume Redis not installed\n";
3022 ##################################################
3023 # Test for the basic requirements #
3024 ##################################################
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.
3031 $missing .= " Lookup: lsearch\n" if (!defined $parm_lookups{lsearch});
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});
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});
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";
3052 die "** Test script abandoned\n";
3056 ##################################################
3057 # Check for the auxiliary programs #
3058 ##################################################
3060 # These are always required:
3062 for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
3063 "fakens", "iefbr14", "server")
3065 next if ($prog eq "client-ssl" && !defined $parm_support{OpenSSL});
3066 next if ($prog eq "client-gnutls" && !defined $parm_support{GnuTLS});
3067 if (!-e "bin/$prog")
3070 print "** bin/$prog does not exist. Have you run ./configure and make?\n";
3071 die "** Test script abandoned\n";
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.
3079 $dlfunc_deleted = 0;
3080 if (defined $parm_support{Expand_dlfunc} && !-e 'bin/loaded')
3082 delete $parm_support{Expand_dlfunc};
3083 $dlfunc_deleted = 1;
3087 ##################################################
3088 # Find environmental details #
3089 ##################################################
3091 # Find the caller of this program.
3093 ($parm_caller,$pwpw,$parm_caller_uid,$parm_caller_gid,$pwquota,$pwcomm,
3094 $parm_caller_gecos, $parm_caller_home) = getpwuid($>);
3096 $pwpw = $pwpw; # Kill Perl warnings
3097 $pwquota = $pwquota;
3100 $parm_caller_group = getgrgid($parm_caller_gid);
3102 print "Program caller is $parm_caller ($parm_caller_uid), whose group is $parm_caller_group ($parm_caller_gid)\n";
3103 print "Home directory is $parm_caller_home\n";
3105 unless (defined $parm_eximgroup)
3107 print "Unable to derive \$parm_eximgroup.\n";
3108 die "** ABANDONING.\n";
3111 print "You need to be in the Exim group to run these tests. Checking ...";
3113 if (`groups` =~ /\b\Q$parm_eximgroup\E\b/)
3119 print "\nOh dear, you are not in the Exim group.\n";
3120 die "** Testing abandoned.\n";
3123 # Find this host's IP addresses - there may be many, of course, but we keep
3124 # one of each type (IPv4 and IPv6).
3126 open(IFCONFIG, '-|', (grep { -x "$_/ip" } split /:/, $ENV{PATH}) ? 'ip address' : 'ifconfig -a')
3127 or die "** Cannot run 'ip address' or 'ifconfig -a'\n";
3128 while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>))
3130 if (not $parm_ipv4 and /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
3132 next if $1 =~ /^(?:127|10)\./;
3136 if (not $parm_ipv6 and /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)(?:\/\d+)/i)
3138 next if $1 eq '::1' or $1 =~ /^fe80/i;
3144 # Use private IP addresses if there are no public ones.
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.
3157 $parm_ipv4 = "<no IPv4 address found>";
3158 $server_opts .= " -noipv4";
3160 elsif ($have_ipv4 == 0)
3162 $parm_ipv4 = "<IPv4 testing disabled>";
3163 $server_opts .= " -noipv4";
3167 $parm_running{IPv4} = " ";
3173 $parm_ipv6 = "<no IPv6 address found>";
3174 $server_opts .= " -noipv6";
3175 delete($parm_support{IPv6});
3177 elsif ($have_ipv6 == 0)
3179 $parm_ipv6 = "<IPv6 testing disabled>";
3180 $server_opts .= " -noipv6";
3181 delete($parm_support{IPv6});
3183 elsif (!defined $parm_support{IPv6})
3186 $parm_ipv6 = "<no IPv6 support in Exim binary>";
3187 $server_opts .= " -noipv6";
3191 $parm_running{IPv6} = " ";
3194 print "IPv4 address is $parm_ipv4\n";
3195 print "IPv6 address is $parm_ipv6\n";
3197 # For munging test output, we need the reversed IP addresses.
3199 $parm_ipv4r = ($parm_ipv4 !~ /^\d/)? '' :
3200 join(".", reverse(split /\./, $parm_ipv4));
3202 $parm_ipv6r = $parm_ipv6; # Appropriate if not in use
3203 if ($parm_ipv6 =~ /^[\da-f]/)
3205 my(@comps) = split /:/, $parm_ipv6;
3207 foreach $comp (@comps)
3209 push @nibbles, sprintf("%lx", hex($comp) >> 8);
3210 push @nibbles, sprintf("%lx", hex($comp) & 0xff);
3212 $parm_ipv6r = join(".", reverse(@nibbles));
3215 # Find the host name, fully qualified.
3217 chomp($temp = `hostname`);
3218 die "'hostname' didn't return anything\n" unless defined $temp and length $temp;
3221 $parm_hostname = $temp;
3225 $parm_hostname = (gethostbyname($temp))[0];
3226 $parm_hostname = "no.host.name.found" unless defined $parm_hostname and length $parm_hostname;
3228 print "Hostname is $parm_hostname\n";
3230 if ($parm_hostname !~ /\./)
3232 print "\n*** Host name is not fully qualified: this may cause problems ***\n\n";
3235 if ($parm_hostname =~ /[[:upper:]]/)
3237 print "\n*** Host name has upper case characters: this may cause problems ***\n\n";
3242 ##################################################
3243 # Create a testing version of Exim #
3244 ##################################################
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
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.
3262 { unlink "eximdir/exim"; } # Just in case
3265 mkdir("eximdir", 0710) || die "** Unable to mkdir $parm_cwd/eximdir: $!\n";
3266 system("sudo chgrp $parm_eximgroup eximdir");
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.
3275 die "** Unable to make patched exim: $!\n"
3276 if (system("sudo ./patchexim $parm_exim") != 0);
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.
3282 $SIG{INT} = \&inthandler;
3283 $SIG{PIPE} = \&pipehandler;
3285 # For some tests, we need another copy of the binary that is setuid exim rather
3288 system("sudo cp eximdir/exim eximdir/exim_exim;" .
3289 "sudo chown $parm_eximuser eximdir/exim_exim;" .
3290 "sudo chgrp $parm_eximgroup eximdir/exim_exim;" .
3291 "sudo chmod 06755 eximdir/exim_exim");
3294 ##################################################
3295 # Make copies of utilities we might need #
3296 ##################################################
3298 # Certain of the tests make use of some of Exim's utilities. We do not need
3299 # to be root to copy these.
3301 ($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?;
3303 $dbm_build_deleted = 0;
3304 if (defined $parm_lookups{dbm} &&
3305 system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
3307 delete $parm_lookups{dbm};
3308 $dbm_build_deleted = 1;
3311 if (system("cp $parm_exim_dir/exim_dumpdb eximdir") != 0)
3313 tests_exit(-1, "Failed to make a copy of exim_dumpdb: $!");
3316 if (system("cp $parm_exim_dir/exim_lock eximdir") != 0)
3318 tests_exit(-1, "Failed to make a copy of exim_lock: $!");
3321 if (system("cp $parm_exim_dir/exinext eximdir") != 0)
3323 tests_exit(-1, "Failed to make a copy of exinext: $!");
3326 if (system("cp $parm_exim_dir/exigrep eximdir") != 0)
3328 tests_exit(-1, "Failed to make a copy of exigrep: $!");
3331 if (system("cp $parm_exim_dir/eximstats eximdir") != 0)
3333 tests_exit(-1, "Failed to make a copy of eximstats: $!");
3337 ##################################################
3338 # Check that the Exim user can access stuff #
3339 ##################################################
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.
3344 print "Exim user is $parm_eximuser ($parm_exim_uid)\n";
3345 print "Exim group is $parm_eximgroup ($parm_exim_gid)\n";
3347 if ($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)");
3351 if ($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");
3357 print "The Exim user needs access to the test suite directory. Checking ...";
3359 if (($rc = system("sudo bin/checkaccess $parm_cwd/eximdir/exim $parm_eximuser $parm_eximgroup")) != 0)
3361 my($why) = "unknown failure $rc";
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");
3378 tests_exit(-1, "Failed to unlink $log_summary_filename: $!")
3379 if not unlink($log_summary_filename) and -e $log_summary_filename;
3381 ##################################################
3382 # Create a list of available tests #
3383 ##################################################
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.
3393 print "\nTest range is $test_start to $test_end (flavour $flavour)\n";
3394 print "Omitting \${dlfunc expansion tests (loadable module not present)\n"
3396 print "Omitting dbm tests (unable to copy exim_dbmbuild)\n"
3397 if $dbm_build_deleted;
3400 my @test_dirs = grep { not /^CVS$/ } map { basename $_ } glob 'scripts/*'
3401 or die tests_exit(-1, "Failed to find test scripts in 'scripts/*`: $!");
3403 # Scan for relevant tests
3405 DIR: for ($i = 0; $i < @test_dirs; $i++)
3407 my($testdir) = $test_dirs[$i];
3410 print ">>Checking $testdir\n" if $debug;
3412 # Skip this directory if the first test is equal or greater than the first
3413 # test in the next directory.
3415 next DIR if ($i < @test_dirs - 1) &&
3416 ($test_start >= substr($test_dirs[$i+1], 0, 4));
3418 # No need to carry on if the end test is less than the first test in this
3421 last DIR if $test_end < substr($testdir, 0, 4);
3423 # Check requirements, if any.
3425 if (open(my $requires, "scripts/$testdir/REQUIRES"))
3431 if (/^support (.*)$/)
3433 if (!defined $parm_support{$1}) { $wantthis = 0; last; }
3435 elsif (/^running (.*)$/)
3437 if (!defined $parm_running{$1}) { $wantthis = 0; last; }
3439 elsif (/^lookup (.*)$/)
3441 if (!defined $parm_lookups{$1}) { $wantthis = 0; last; }
3443 elsif (/^authenticators? (.*)$/)
3445 if (!defined $parm_authenticators{$1}) { $wantthis = 0; last; }
3447 elsif (/^router (.*)$/)
3449 if (!defined $parm_routers{$1}) { $wantthis = 0; last; }
3451 elsif (/^transport (.*)$/)
3453 if (!defined $parm_transports{$1}) { $wantthis = 0; last; }
3457 tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\"");
3463 tests_exit(-1, "Failed to open \"scripts/$testdir/REQUIRES\": $!")
3467 # Loop if we do not want the tests in this subdirectory.
3472 print "Omitting tests in $testdir (missing $_)\n";
3475 # We want the tests from this subdirectory, provided they are in the
3476 # range that was selected.
3478 @testlist = map { basename $_ } glob "scripts/$testdir/*";
3479 tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!")
3482 foreach $test (@testlist)
3484 next if ($test !~ /^\d{4}(?:\.\d+)?$/);
3485 if (!$wantthis || $test < $test_start || $test > $test_end)
3487 log_test($log_summary_filename, $test, '.');
3491 push @test_list, "$testdir/$test";
3496 print ">>Test List: @test_list\n", if $debug;
3499 ##################################################
3500 # Munge variable auxiliary data #
3501 ##################################################
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.
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.
3515 foreach $basedir ("aux-var", "dnszones")
3517 system("sudo rm -rf $parm_cwd/$basedir");
3518 mkdir("$parm_cwd/$basedir", 0777);
3519 chmod(0755, "$parm_cwd/$basedir");
3521 opendir(AUX, "$parm_cwd/$basedir-src") ||
3522 tests_exit(-1, "Failed to opendir $parm_cwd/$basedir-src: $!");
3523 my(@filelist) = readdir(AUX);
3526 foreach $file (@filelist)
3528 my($outfile) = $file;
3529 next if $file =~ /^\./;
3531 if ($file eq "db.ip4.V4NET")
3533 $outfile = "db.ip4.$parm_ipv4_test_net";
3535 elsif ($file eq "db.ip6.V6NET")
3537 my(@nibbles) = reverse(split /\s*/, $parm_ipv6_test_net);
3539 $outfile = "db.ip6.@nibbles";
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: $!");
3558 # Set a user's shell, distinguishable from /bin/sh
3560 symlink('/bin/sh' => 'aux-var/sh');
3561 $ENV{SHELL} = $parm_shell = "$parm_cwd/aux-var/sh";
3563 ##################################################
3564 # Create fake DNS zones for this host #
3565 ##################################################
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.
3571 if ($have_ipv4 || $have_ipv6)
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";
3586 if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1")
3588 my(@components) = $parm_ipv4 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
3589 open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") ||
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" .
3599 if ($have_ipv6 && $parm_ipv6 ne "::1")
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;
3610 $exp_v6 = $parm_ipv6;
3612 my(@components) = split /:/, $exp_v6;
3613 my(@nibbles) = reverse (split /\s*/, shift @components);
3617 open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||
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";
3623 @components = reverse @components;
3624 foreach $c (@components)
3626 $c = "0$c" until $c =~ /^..../;
3627 @nibbles = reverse(split /\s*/, $c);
3628 print OUT "$sep@nibbles";
3632 print OUT " PTR $parm_hostname.\n\n; End\n";
3639 ##################################################
3640 # Create lists of mailboxes and message logs #
3641 ##################################################
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.
3648 @oldmails = list_files_below("mail");
3649 opendir(DIR, "msglog") || tests_exit(-1, "Failed to opendir msglog: $!");
3650 @oldmsglogs = readdir(DIR);
3655 ##################################################
3656 # Run the required tests #
3657 ##################################################
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
3663 if (not $force_continue) {
3664 # runtest needs to interact if we're not in continue
3665 # mode. It does so by communicate to /dev/tty
3666 open(T, '<', '/dev/tty') or tests_exit(-1, "Failed to open /dev/tty: $!");
3667 print "\nPress RETURN to run the tests: ";
3672 foreach $test (@test_list)
3674 state $lasttestdir = '';
3677 local $commandno = 0;
3678 local $subtestno = 0;
3681 (local $testno = $test) =~ s|.*/||;
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;
3690 my $thistestdir = substr($test, 0, -5);
3692 $dynamic_socket->close() if $dynamic_socket;
3694 if ($lasttestdir ne $thistestdir)
3697 if (-s "scripts/$thistestdir/REQUIRES")
3700 print "\n>>> The following tests require: ";
3701 open(my $requires, '<', "scripts/$thistestdir/REQUIRES") ||
3702 tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $!");
3705 $gnutls = 1 if /^support GnuTLS/;
3710 $lasttestdir = $thistestdir;
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.
3717 system "sudo /bin/rm -rf spool test-*";
3718 system "mkdir test-mail 2>/dev/null";
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.
3725 system "mkdir spool; " .
3726 "sudo chown $parm_eximuser:$parm_eximgroup spool; " .
3727 "sudo chmod 0755 spool";
3729 # Empty the cache that keeps track of things like message id mappings, and
3730 # set up the initial sequence strings.
3742 $TEST_STATE->{munge} = '';
3744 # Remove the associative arrays used to hold checked mail files and msglogs
3746 undef %expected_mails;
3747 undef %expected_msglogs;
3749 # Open the test's script
3750 open(SCRIPT, "scripts/$test") ||
3751 tests_exit(-1, "Failed to open \"scripts/$test\": $!");
3752 # Run through the script once to set variables which should be global
3755 if (/^no_message_check/) { $message_skip = 1; next; }
3756 if (/^no_msglog_check/) { $msglog_skip = 1; next; }
3757 if (/^no_stderr_check/) { $stderr_skip = 1; next; }
3758 if (/^no_stdout_check/) { $stdout_skip = 1; next; }
3759 if (/^rmfiltertest/) { $rmfiltertest = 1; next; }
3760 if (/^sortlog/) { $sortlog = 1; next; }
3761 if (/\bPORT_DYNAMIC\b/) { $dynamic_socket = Exim::Runtest::dynamic_socket(); next; }
3763 # Reset to beginning of file for per test interpreting/processing
3766 # The first line in the script must be a comment that is used to identify
3767 # the set of tests as a whole.
3771 tests_exit(-1, "Missing identifying comment at start of $test") if (!/^#/);
3772 printf("%s %s", (substr $test, 5), (substr $_, 2));
3774 # Loop for each of the subtests within the script. The variable $server_pid
3775 # is used to remember the pid of a "server" process, for which we do not
3776 # wait until we have waited for a subsequent command.
3778 local($server_pid) = 0;
3779 for ($commandno = 1; !eof SCRIPT; $commandno++)
3781 # Skip further leading comments and blank lines, handle the flag setting
3782 # commands, and deal with tests for IP support.
3787 # Could remove these variable settings because they are already
3788 # set above, but doesn't hurt to leave them here.
3789 if (/^no_message_check/) { $message_skip = 1; next; }
3790 if (/^no_msglog_check/) { $msglog_skip = 1; next; }
3791 if (/^no_stderr_check/) { $stderr_skip = 1; next; }
3792 if (/^no_stdout_check/) { $stdout_skip = 1; next; }
3793 if (/^rmfiltertest/) { $rmfiltertest = 1; next; }
3794 if (/^sortlog/) { $sortlog = 1; next; }
3796 if (/^need_largefiles/)
3798 next if $have_largefiles;
3799 print ">>> Large file support is needed for test $testno, but is not available: skipping\n";
3800 $docheck = 0; # don't check output
3801 undef $_; # pretend EOF
3808 print ">>> IPv4 is needed for test $testno, but is not available: skipping\n";
3809 $docheck = 0; # don't check output
3810 undef $_; # pretend EOF
3821 print ">>> IPv6 is needed for test $testno, but is not available: skipping\n";
3822 $docheck = 0; # don't check output
3823 undef $_; # pretend EOF
3827 if (/^need_move_frozen_messages/)
3829 next if defined $parm_support{move_frozen_messages};
3830 print ">>> move frozen message support is needed for test $testno, " .
3831 "but is not\n>>> available: skipping\n";
3832 $docheck = 0; # don't check output
3833 undef $_; # pretend EOF
3837 last unless /^(?:#(?!##\s)|\s*$)/;
3839 last if !defined $_; # Hit EOF
3841 my($subtest_startline) = $lineno;
3843 # Now run the command. The function returns 0 for an inline command,
3844 # 1 if a non-exim command was run and waited for, 2 if an exim
3845 # command was run and waited for, and 3 if a command
3846 # was run and not waited for (usually a daemon or server startup).
3848 my($commandname) = '';
3850 my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
3854 print ">> rc=$rc cmdrc=$cmdrc\n";
3855 if (defined $run_extra) {
3856 foreach my $k (keys %$run_extra) {
3857 my $v = defined $run_extra->{$k} ? qq!"$run_extra->{$k}"! : '<undef>';
3858 print ">> $k -> $v\n";
3862 $run_extra = {} unless defined $run_extra;
3863 foreach my $k (keys %$run_extra) {
3864 if (exists $TEST_STATE->{$k}) {
3865 my $nv = defined $run_extra->{$k} ? qq!"$run_extra->{$k}"! : 'removed';
3866 print ">> override of $k; was $TEST_STATE->{$k}, now $nv\n" if $debug;
3868 if (defined $run_extra->{$k}) {
3869 $TEST_STATE->{$k} = $run_extra->{$k};
3870 } elsif (exists $TEST_STATE->{$k}) {
3871 delete $TEST_STATE->{$k};
3875 # Hit EOF after an initial return code number
3877 tests_exit(-1, "Unexpected EOF in script") if ($rc == 4);
3879 # Carry on with the next command if we did not wait for this one. $rc == 0
3880 # if no subprocess was run; $rc == 3 if we started a process but did not
3883 next if ($rc == 0 || $rc == 3);
3885 # We ran and waited for a command. Check for the expected result unless
3888 if ($cmdrc != $expectrc && !$sigpipehappened)
3890 printf("** Command $commandno (\"$commandname\", starting at line $subtest_startline)\n");
3891 if (($cmdrc & 0xff) == 0)
3893 printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256);
3895 elsif (($cmdrc & 0xff00) == 0)
3896 { printf("** Killed by signal %d", $cmdrc & 255); }
3898 { printf("** Status %x", $cmdrc); }
3902 print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
3903 $_ = $force_continue ? "c" : <T>;
3904 tests_exit(1) if /^q?$/i;
3905 if (/^c$/ && $force_continue) {
3906 log_failure($log_failed_filename, $testno, "exit code unexpected");
3907 log_test($log_summary_filename, $testno, 'F')
3909 if ($force_continue)
3911 print "\nstderr tail:\n";
3912 print "===================\n";
3913 system("tail -20 test-stderr");
3914 print "===================\n";
3915 print "... continue forced\n";
3921 system("$more test-stderr");
3925 system("$more test-stdout");
3929 $retry = 1 if /^r$/i;
3933 # If the command was exim, and a listening server is running, we can now
3934 # close its input, which causes us to wait for it to finish, which is why
3935 # we didn't close it earlier.
3937 if ($rc == 2 && $server_pid != 0)
3943 if (($? & 0xff) == 0)
3944 { printf("Server return code %d for test %d starting line %d", $?/256,
3945 $testno, $subtest_startline); }
3946 elsif (($? & 0xff00) == 0)
3947 { printf("Server killed by signal %d", $? & 255); }
3949 { printf("Server status %x", $?); }
3953 print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
3954 $_ = $force_continue ? "c" : <T>;
3955 tests_exit(1) if /^q?$/i;
3956 if (/^c$/ && $force_continue) {
3957 log_failure($log_failed_filename, $testno, "exit code unexpected");
3958 log_test($log_summary_filename, $testno, 'F')
3960 print "... continue forced\n" if $force_continue;
3965 open(S, "test-stdout-server") ||
3966 tests_exit(-1, "Failed to open test-stdout-server: $!");
3971 $retry = 1 if /^r$/i;
3978 # The script has finished. Check the all the output that was generated. The
3979 # function returns 0 for a perfect pass, 1 if imperfect but ok, 2 if we should
3980 # rerun the test (the files # have been updated).
3981 # It does not return if the user responds Q to a prompt.
3986 print (("#" x 79) . "\n");
3993 my $rc = check_output($TEST_STATE->{munge});
3994 log_test($log_summary_filename, $testno, 'P') if ($rc == 0);
3997 print (" Script completed\n");
4001 print (("#" x 79) . "\n");
4008 ##################################################
4009 # Exit from the test script #
4010 ##################################################
4012 tests_exit(-1, "No runnable tests selected") if not @test_list;
4019 runtest - run the exim testsuite
4023 runtest [options] [test0 [test1]]
4027 B<runtest> runs the Exim testsuite.
4031 For legacy reasons the options are not case sensitive.
4037 This option enables the output of debug information when running the
4038 various test commands. (default: off)
4042 Use C<diff -u> for comparing the expected output with the produced
4043 output. (default: use a built-in comparation routine)
4047 Do not stop for user interaction or on errors. (default: off)
4051 Automatically update the recorded (expected) data on mismatch. (default: off)
4055 Skip IPv4 related setup and tests (default: use ipv4)
4059 Skip IPv6 related setup and tests (default: use ipv6)
4063 Keep the various output files produced during a test run. (default: don't keep)
4067 Insert some delays to compensate for a slow system. (default: off)
4071 Start Exim wrapped by I<valgrind>. (default: don't use valgrind)
4073 =item B<--flavor>|B<--flavour> I<flavour>
4075 Override the expected results for results for a specific (OS) flavour.
4083 # End of runtest script