#! /usr/bin/env perl # We use env, because in some environments of our build farm # the Perl 5.010 interpreter is only reachable via $PATH # Copyright (c) The Exim Maintainers 2024 # SPDX-License-Identifier: GPL-2.0-or-later ############################################################################### # This is the controlling script for the "new" test suite for Exim. It should # # be possible to export this suite for running on a wide variety of hosts, in # # contrast to the old suite, which was very dependent on the environment of # # Philip Hazel's desktop computer. This implementation inspects the version # # of Exim that it finds, and tests only those features that are included. The # # surrounding environment is also tested to discover what is available. See # # the README file for details of how it all works. # # # # Implementation started: 03 August 2005 by Philip Hazel # # Placed in the Exim CVS: 06 February 2006 # ############################################################################### #use strict; use v5.10.1; use warnings; use Errno; use FileHandle; use Socket; use Time::Local; use Cwd; use File::Basename; use Pod::Usage; use Getopt::Long; use FindBin qw'$RealBin'; use File::Copy; use lib "$RealBin/lib"; use Exim::Runtest; use Exim::Utils qw(uniq numerically cp); use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Smart::Comments' => '####'; use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Data::Dumper'; use constant TEST_TOP => 8999; use constant TEST_SPECIAL_TOP => 9999; # Start by initializing some global variables chomp(my $testversion = `git describe --always --dirty 2>&1` || ''); # This gets embedded in the D-H params filename, and the value comes # from asking GnuTLS for "normal", but there appears to be no way to # use certtool/... to ask what that value currently is. *sigh* # We also clamp it because of NSS interop, see addition of tls_dh_max_bits. # This value is correct as of GnuTLS 2.12.18 as clamped by tls_dh_max_bits. # normal = 2432 tls_dh_max_bits = 2236 my $gnutls_dh_bits_normal = 2236; my $cf = 'bin/cf -exact'; my $cr = "\r"; my $debug = 0; my $flavour = do { my $f = Exim::Runtest::flavour() // ''; (grep { $f eq $_ } Exim::Runtest::flavours()) ? $f : 'FOO'; }; my $force_continue = 0; my $force_update = 0; my $log_failed_filename = 'failed-summary.log'; my $log_summary_filename = 'run-summary.log'; my @more = qw'less -XF'; my $optargs = ''; my $save_output = 0; my $server_opts = ''; my $slow = 0; my $valgrind = 0; my $have_ipv4 = 1; my $have_ipv6 = 1; my $have_largefiles = 0; my @test_list = (); # Networks to use for DNS tests. We need to choose some networks that will # never be used so that there is no chance that the host on which we are # running is actually in one of the test networks. Private networks such as # the IPv4 10.0.0.0/8 network are no good because hosts may well use them. # Rather than use some unassigned numbers (that might become assigned later), # I have chosen some multicast networks, in the belief that such addresses # won't ever be assigned to hosts. This is the only place where these numbers # are defined, so it is trivially possible to change them should that ever # become necessary. my $parm_ipv4_test_net = 224; my $parm_ipv6_test_net = 'ff00'; # Port numbers are currently hard-wired my $parm_port_n = 1223; # Nothing listening on this port my $parm_port_s = 1224; # Used for the "server" command my $parm_port_d = 1225; # Used for the Exim daemon my $parm_port_d2 = 1226; # Additional for daemon my $parm_port_d3 = 1227; # Additional for daemon my $parm_port_d4 = 1228; # Additional for daemon my $dynamic_socket; # allocated later for PORT_DYNAMIC # Find a suiteable group name for test (currently only 0001 # uses a group name. A numeric group id would do my $parm_mailgroup = Exim::Runtest::mailgroup('mail'); # Manually set locale $ENV{LC_ALL} = 'C'; # In some environments USER does not exist, but we need it for some test(s) $ENV{USER} = getpwuid($>) if not exists $ENV{USER}; my ($parm_configure_owner, $parm_configure_group); my ($parm_ipv4, $parm_ipv6, $parm_ipv6_stripped); my $parm_hostname; # Convenience for regex' # for tighter, see https://metacpan.org/dist/IO-Socket-IP/source/lib/IO/Socket/IP.pm#L37 my $re_ipv4 = qr/\d{1,3}(?:\.\d{1,3}){3}/; my $re_6g = qr/[[:xdigit:]]{1,4}/; my $re_6s = qr/${re_6g}:/; my $re_ipv6 = qr/${re_6s}{0,7}${re_6g}(?:::${re_6s}{0,5}${re_6g})?/; my $re_ip = qr/(?:${re_ipv4}|${re_ipv6})/; ############################################################################### ############################################################################### # Define a number of subroutines ############################################################################### ############################################################################### ################################################## # Handle signals # ################################################## sub pipehandler { $sigpipehappened = 1; } sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); } ################################################## # Do global macro substitutions # ################################################## # This function is applied to configurations, command lines and data lines in # scripts, and to lines in the files of the aux-var-src and the dnszones-src # directory. It takes one argument: the current test number, or zero when # setting up files before running any tests. sub do_substitute{ s?\bCALLER\b?$parm_caller?g; s?\bCALLERGROUP\b?$parm_caller_group?g; s?\bCALLER_UID\b?$parm_caller_uid?g; s?\bCALLER_GID\b?$parm_caller_gid?g; s?\bCLAMSOCKET\b?$parm_clamsocket?g; s?\bDIR/?$parm_cwd/?g; s?\bEXIMGROUP\b?$parm_eximgroup?g; s?\bEXIMUSER\b?$parm_eximuser?g; s?\bHOSTIPV4\b?$parm_ipv4?g; s?\bHOSTIPV6\b?$parm_ipv6?g; s?\bHOSTNAME\b?$parm_hostname?g; s?\bPORT_D\b?$parm_port_d?g; s?\bPORT_D2\b?$parm_port_d2?g; s?\bPORT_D3\b?$parm_port_d3?g; s?\bPORT_D4\b?$parm_port_d4?g; s?\bPORT_N\b?$parm_port_n?g; s?\bPORT_S\b?$parm_port_s?g; s?\bTESTNUM\b?$_[0]?g; s?(\b|_)V4NET([\._])?$1$parm_ipv4_test_net$2?g; s?\bV6NET:?$parm_ipv6_test_net:?g; s?\bPORT_DYNAMIC\b?$dynamic_socket->sockport()?eg; s?\bMAILGROUP\b?$parm_mailgroup?g; } ################################################## # Any state to be preserved across tests # ################################################## my $TEST_STATE = {}; ################################################## # Subroutine to tidy up and exit # ################################################## # In all cases, we check for any Exim daemons that have been left running, and # kill them. Then remove all the spool data, test output, and the modified Exim # binary if we are ending normally. # Arguments: # $_[0] = 0 for a normal exit; full cleanup done # $_[0] > 0 for an error exit; no files cleaned up # $_[0] < 0 for a "die" exit; $_[1] contains a message sub tests_exit{ my($rc) = $_[0]; my($spool); # Search for daemon pid files and kill the daemons. We kill with SIGINT rather # than SIGTERM to stop it outputting "Terminated" to the terminal when not in # the background. if (exists $TEST_STATE->{exim_pid}) { $pid = $TEST_STATE->{exim_pid}; print "Tidyup: killing wait-mode daemon pid=$pid\n"; system("sudo kill -INT $pid"); } if (opendir(DIR, "spool")) { my(@spools) = sort readdir(DIR); closedir(DIR); foreach $spool (@spools) { next if $spool !~ /^exim-daemon./; open(PID, "spool/$spool") || die "** Failed to open \"spool/$spool\": $!\n"; chomp($pid = ); close(PID); print "Tidyup: killing daemon pid=$pid\n"; system("sudo rm -f spool/$spool; sudo kill -INT $pid"); } } else { die "** Failed to opendir(\"spool\"): $!\n" unless $!{ENOENT}; } # Close the terminal input and remove the test files if all went well, unless # the option to save them is set. Always remove the patched Exim binary. Then # exit normally, or die. close(T); system("sudo /bin/rm -rf ./spool test-* ./dnszones/*") if ($rc == 0 && !$save_output); system("sudo /bin/rm -rf ./eximdir/*") if (!$save_output); print "\nYou were in test $test at the end there.\n\n" if defined $test; exit $rc if ($rc >= 0); die "** runtest error: $_[1]\n"; } ################################################## # Subroutines used by the munging subroutine # ################################################## # This function is used for things like message ids, where we want to generate # more than one value, but keep a consistent mapping throughout. # # Arguments: # $oldid the value from the file # $base a base string into which we insert a sequence # $sequence the address of the current sequence counter sub new_value { my($oldid, $base, $sequence) = @_; my($newid) = $cache{$oldid}; print ">> replace $oldid -> $newid\n" if ($debug && defined $newid); if (! defined $newid) { $newid = sprintf($base, $$sequence++); print ">> new $oldid -> $newid\n" if $debug; $cache{$oldid} = $newid; } return $newid; } # This is used while munging the output from exim_dumpdb. # May go wrong across DST changes. sub date_seconds { my($day,$month,$year,$hour,$min,$sec) = $_[0] =~ /^(\d\d)-(\w\w\w)-(\d{4})\s(\d\d):(\d\d):(\d\d)/; my($mon); if ($month =~ /Jan/) {$mon = 0;} elsif($month =~ /Feb/) {$mon = 1;} elsif($month =~ /Mar/) {$mon = 2;} elsif($month =~ /Apr/) {$mon = 3;} elsif($month =~ /May/) {$mon = 4;} elsif($month =~ /Jun/) {$mon = 5;} elsif($month =~ /Jul/) {$mon = 6;} elsif($month =~ /Aug/) {$mon = 7;} elsif($month =~ /Sep/) {$mon = 8;} elsif($month =~ /Oct/) {$mon = 9;} elsif($month =~ /Nov/) {$mon = 10;} elsif($month =~ /Dec/) {$mon = 11;} return timelocal($sec,$min,$hour,$day,$mon,$year); } # This is a subroutine to sort maildir files into time-order. The second field # is the microsecond field, and may vary in length, so must be compared # numerically. sub maildirsort { return $a cmp $b if ($a !~ /^\d+\.H\d/ || $b !~ /^\d+\.H\d/); my($x1,$y1) = $a =~ /^(\d+)\.H(\d+)/; my($x2,$y2) = $b =~ /^(\d+)\.H(\d+)/; return ($x1 != $x2)? ($x1 <=> $x2) : ($y1 <=> $y2); } ################################################## # Subroutine list files below a directory # ################################################## # This is used to build up a list of expected mail files below a certain path # in the directory tree. It has to be recursive in order to deal with multiple # maildir mailboxes. sub list_files_below { my($dir) = $_[0]; my(@yield) = (); my(@sublist, $file); opendir(DIR, $dir) || tests_exit(-1, "Failed to open $dir: $!"); @sublist = sort maildirsort readdir(DIR); closedir(DIR); foreach $file (@sublist) { next if $file eq "." || $file eq ".." || $file eq "CVS"; if (-d "$dir/$file") { @yield = (@yield, list_files_below("$dir/$file")); } else { push @yield, "$dir/$file"; } } return @yield; } ################################################## # Munge a file before comparing # ################################################## # The pre-processing turns all dates, times, Exim versions, message ids, and so # on into standard values, so that the compare works. Perl's substitution with # an expression provides a neat way to do some of these changes. # We keep a global associative array for repeatedly turning the same values # into the same standard values throughout the data from a single test. # Message ids get this treatment (can't be made reliable for times), and # times in dumped retry databases are also handled in a special way, as are # incoming port numbers and PIDs. # On entry to the subroutine, the file to write to is already opened with the # name MUNGED. The input file name is the only argument to the subroutine. # Certain actions are taken only when the name contains "stderr", "stdout", # or "log". The yield of the function is 1 if a line matching "*** truncated # ***" is encountered; otherwise it is 0. sub munge { my($file) = $_[0]; my($extra) = $_[1]; my($yield) = 0; my(@saved) = (); local $_; open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!"); my($is_log) = $file =~ /log/; my($is_stdout) = $file =~ /stdout/; my($is_stderr) = $file =~ /stderr/; my($is_mail) = $file =~ /mail/; # Date pattern $date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}"; # Debug time & pid $time_pid = "(?:\\d{2}:\\d{2}:\\d{2}\\s+\\d+\\s)"; # Pattern for matching pids at start of stderr lines; initially something # that won't match. $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # Scan the file and make the changes. Near the bottom there are some changes # that are specific to certain file types, though there are also some of those # inline too. LINE: while() { RESET_AFTER_EXTRA_LINE_READ: if ($munge_skip) { # Munging is a no-op, except for exim_msgdate specials. # Useful when testing exim_msgdate so that # we compare unmunged dates and message-ids. s%^localhost \d+ from message-id != given number \d+ at \K/.+(?=/test/eximdir/exim_msgdate line 387.$)%DIR%; print MUNGED; next; } # Custom munges if ($extra) { next if $extra =~ m%^/% && eval $extra; eval $extra if $extra =~ m/^s/; eval substr($extra, 1) if $extra =~ m/^R/; } # Check for "*** truncated ***" $yield = 1 if /\*\*\* truncated \*\*\*/; # Replace the name of this host s/\Q$parm_hostname\E/the.local.host.name/g; # But convert "name=the.local.host address=127.0.0.1" to use "localhost" s/name=the\.local\.host address=127\.0\.0\.1/name=localhost address=127.0.0.1/g; # The name of the shell may vary s/\s\Q$parm_shell\E\b/ ENV_SHELL/; # Replace the path to the testsuite directory s?\Q$parm_cwd\E?TESTSUITE?g; # Replace the Exim version number (may appear in various places) # patchexim should have fixed this for us #s/Exim \K\d+[._]\d+[\w_-]*/x.yz/i; # Replace Exim message ids by a unique series. # Both old and new formats, with separate replace series, for now. s/(\d[^\W_]{5}-[^\W_]{6}-[^\W_]{2}) /new_value($1, "10Hm%s-0005vi-00", \$next_msgid_old)/egx; s/(\d[^\W_]{5}-[^\W_]{11}-[^\W_]{4}) /new_value($1, "10Hm%s-000000005vi-0000", \$next_msgid)/egx; # The names of lock files appear in some error and debug messages s/\.lock(\.[-\w]+)+(\.[\da-f]+){2}/.lock.test.ex.dddddddd.pppppppp/; # Unless we are in an IPv6 test, replace IPv4 and/or IPv6 in "listening on # port" message, because it is not always the same. s/port (\d+) \([^)]+\)/port $1/g if !$is_ipv6test && m/listening for SMTP(S?) on port/; # Challenges in SPA authentication s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/; # PRVS values s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; # Old form s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g; # New form # There are differences in error messages between OpenSSL versions s/SSL_CTX_set_cipher_list/SSL_connect/; s/error=\Kauthority and subject key identifier mismatch/self signed certificate/; s/error=\Kself-signed certificate/self signed certificate/; # One error test in expansions mentions base 62 or 36 s/is not a base (36|62) number/is not a base 36\/62 number/; # This message sometimes has a different number of seconds s/forced fail after \d seconds/forced fail after d seconds/; # This message may contain a different DBM library name s/Failed to open \S+( \([^\)]+\))? file/Failed to open hintsdb file/; # The message for a non-listening FIFO varies s/:[^:]+: while opening named pipe/: Error: while opening named pipe/; # Debugging output of lists of hosts may have different sort keys s/^\s*\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\K\S+/xx/; # Random local part in callout cache testing s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/; s/the.local.host.name-\d+-testing/the.local.host.name-dddddddd-testing/; # File descriptor numbers may vary s/^writing data block fd=\d+/writing data block fd=dddd/; s/(running as transport filter:) fd_write=\d+ fd_read=\d+/$1 fd_write=dddd fd_read=dddd/; # ======== Dumpdb output ======== # This must be before the general date/date munging. # Time data lines, which look like this: # 25-Aug-2000 12:11:37 25-Aug-2000 12:11:37 26-Aug-2000 12:11:37 if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/) { my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4); $expired = '' if !defined $expired; # Make time-difference minimum 2, and rounded up to even value my($increment) = date_seconds($date3) - date_seconds($date2) + 1; $increment = 2 if ($increment == 0); $increment = ($increment >> 1) << 1; # We used to use globally unique replacement values, but timing # differences make this impossible. Just show the increment on the # last one. printf MUNGED ("first failed = time last try = time2 next try = time2 + %s%s\n", $increment, $expired); next; } # more_errno values in exim_dumpdb output which are times s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /; # port numbers in dumpdb output s/T:([a-z0-9.]+(:[0-9.]+|:\[[^]]+])?):$parm_port_n /T:$1:PORT_N /; s/T:([a-z0-9.[\]]+(:[0-9.]+|:\[[^]]+])?):$parm_port_s /T:$1:PORT_S /; # and exinext s/Transport: (?:[a-z0-9.]+|\[[^\]]+]) (?:[0-9.]+|\[[^\]]+]):\K$parm_port_s /PORT_S /; # port numbers in stderr s/^set_process_info: .*\]:\K$parm_port_d /PORT_D /; s/^set_process_info: .*\]:\K$parm_port_s /PORT_S /; # ======== Dates and times ======== # Dates and times are all turned into the same value - trying to turn # them into different ones cannot be done repeatedly because they are # real time stamps generated while running the test. The actual date and # time used was fixed when I first started running automatic Exim tests. # Date/time in header lines and SMTP responses s/[A-Z][a-z]{2}, (\s|\xE2\x96\x91) \d\d? (\s|\xE2\x96\x91) [A-Z][a-z]{2} (\s|\xE2\x96\x91) \d{4} (\s|\xE2\x96\x91) \d\d\:\d\d:\d\d (\s|\xE2\x96\x91) [-+]\d{4} /Tue,${1}2${2}Mar${3}1999${4}09:44:33${5}+0000/gx; # and in a French locale s/\S{4},\s\d\d?\s[^,]+\s\d{4}\s\d\d\:\d\d:\d\d\s[-+]\d{4} /dim., 10 f\xE9vr 2019 20:05:49 +0000/gx; # Date/time in logs and in one instance of a filter test s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d(\s[+-]\d\d\d\d)?\s/1999-03-02 09:44:33 /gx; s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\.\d{3}(?:\s(?:[+-]\d\d\d\d|[A-Z]{2}T))?\s/2017-07-30 18:51:05.712 /gx; s/^Logwrite\s"\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Logwrite "1999-03-02 09:44:33/gx; # Date/time in syslog test s/^SYSLOG:\s\'\K\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\s/2017-07-30 18:51:05 /gx; s/^SYSLOG:\s\'\K\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\.\d{3}\s/2017-07-30 18:51:05.712 /gx; s/^SYSLOG:\s\'\K\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\s[+-]\d\d\d\d\s/2017-07-30 18:51:05 +9999 /gx; s/^SYSLOG:\s\'\K\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\.\d{3}\s[+-]\d\d\d\d\s/2017-07-30 18:51:05.712 +9999 /gx; s/((D|[RQD]T)=)\d+s/$1qqs/g; s/((D|[RQD]T)=)\d\.\d{3}s/$1q.qqqs/g; # Date/time in message separators s/(?:[A-Z][a-z]{2} (\s|\xE2\x96\x91) ){2}\d\d (\s|\xE2\x96\x91) \d\d:\d\d:\d\d (\s|\xE2\x96\x91) \d\d\d\d /Tue${1}Mar${1}02${2}09:44:33${3}1999/gx; # Date of message arrival in spool file as shown by -Mvh s/^\d{9,10}\s0$/ddddddddd 0/; # Date/time in mbx mailbox files 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; # Dates/times in debugging output for writing retry records if (/^ first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/) { my($next) = $3 - $2; $_ = " first failed=dddd last try=dddd next try=+$next $4\n"; } s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\w)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/; s/^(\s*)received_time=\d+ diff=\d+ timeout=(\d+)/$1received_time=tttt diff=tttt timeout=$2/; # Time to retry may vary s/time to retry = \S+/time to retry = tttt/; s/retry record exists: age=\S+/retry record exists: age=ttt/; s/failing_interval=\S+ message_age=\S+/failing_interval=ttt message_age=ttt/; # Date/time in exim -bV output s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g; # Eximstats heading s/Exim\sstatistics\sfrom\s\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\sto\s \d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Exim statistics from