X-Git-Url: https://git.exim.org/users/heiko/exim.git/blobdiff_plain/ea49d0e16fbc6f56fc5b8519d266f88d09139187..65347ce3341c8386c3e2e1e9599c5c56e79838ec:/test/runtest?ds=sidebyside diff --git a/test/runtest b/test/runtest index acff149af..ab9b2bb95 100755 --- a/test/runtest +++ b/test/runtest @@ -1,6 +1,6 @@ -#! /usr/bin/perl -w - -# $Cambridge: exim/test/runtest,v 1.2 2006/02/08 14:28:51 ph10 Exp $ +#! /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 ############################################################################### # This is the controlling script for the "new" test suite for Exim. It should # @@ -15,33 +15,68 @@ # Placed in the Exim CVS: 06 February 2006 # ############################################################################### -require Cwd; +#use strict; +use v5.10.1; +use warnings; +use if $^V >= v5.19.11, experimental => 'smartmatch'; + 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); -# Start by initializing some global variables +use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Smart::Comments' => '####'; +use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Data::Dumper'; -$testversion = "4.61 (06-Feb-06)"; +use constant TEST_TOP => 8999; +use constant TEST_SPECIAL_TOP => 9999; -$cf = "bin/cf"; -$cr = "\r"; -$debug = 0; -$force_update = 0; -$more = "less -XF"; -$optargs = ""; -$save_output = 0; -$server_opts = ""; -$have_ipv4 = 1; -$have_ipv6 = 1; +# Start by initializing some global variables -$test_start = 1; -$test_end = $test_top = 8999; -$test_special_top = 9999; -@test_list = (); -@test_dirs = (); +chomp(my $testversion = `git describe --always --dirty 2>&1` || '<unknown>'); + +# 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 @@ -54,19 +89,32 @@ $test_special_top = 9999; # are defined, so it is trivially possible to change them should that ever # become necessary. -$parm_ipv4_test_net = "224"; -$parm_ipv6_test_net = "ff00"; +my $parm_ipv4_test_net = 224; +my $parm_ipv6_test_net = 'ff00'; # Port numbers are currently hard-wired -$parm_port_n = 1223; # Nothing listening on this port -$parm_port_s = 1224; # Used for the "server" command -$parm_port_d = 1225; # Used for the Exim daemon -$parm_port_d2 = 1226; # Additional for daemon -$parm_port_d3 = 1227; # Additional for daemon -$parm_port_d4 = 1228; # Additional for daemon +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; ############################################################################### ############################################################################### @@ -97,6 +145,7 @@ sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); } 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; @@ -115,9 +164,17 @@ 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 # @@ -140,6 +197,13 @@ my($spool); # 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); @@ -151,7 +215,7 @@ if (opendir(DIR, "spool")) chomp($pid = <PID>); close(PID); print "Tidyup: killing daemon pid=$pid\n"; - system("sudo rm -f spool/$spool; sudo kill -SIGINT $pid"); + system("sudo rm -f spool/$spool; sudo kill -INT $pid"); } } else @@ -165,7 +229,10 @@ close(T); system("sudo /bin/rm -rf ./spool test-* ./dnszones/*") if ($rc == 0 && !$save_output); -system("sudo /bin/rm -rf ./eximdir/*"); +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"; } @@ -196,14 +263,26 @@ return $newid; } -# This is used while munging the output from exim_dumpdb. We cheat by assuming -# that the date always the same, and just return the number of seconds since -# midnight. +# 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)/; -return $hour * 60 * 60 + $min * 60 + $sec; +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); } @@ -273,14 +352,18 @@ return @yield; 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 @@ -295,8 +378,16 @@ $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # that are specific to certain file types, though there are also some of those # inline too. -while(<IN>) +LINE: while(<IN>) { +RESET_AFTER_EXTRA_LINE_READ: + # Custom munges + if ($extra) + { + next if $extra =~ m%^/% && eval $extra; + eval $extra if $extra =~ m/^s/; + } + # Check for "*** truncated ***" $yield = 1 if /\*\*\* truncated \*\*\*/; @@ -306,11 +397,15 @@ while(<IN>) # 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) - s/Exim \d+\.\d+[\w-]*/Exim x.yz/i; + # patchexim should have fixed this for us + #s/Exim \K\d+[._]\d+[\w_-]*/x.yz/i; # Replace Exim message ids by a unique series s/((?:[^\W_]{6}-){2}[^\W_]{2}) @@ -328,13 +423,11 @@ while(<IN>) s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/; # PRVS values - s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; + s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; # Old form + s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g; # New form - # Error lines on stdout from SSL contain process id values and file names. - # They also contain a source file name and line number, which may vary from - # release to release. - s/^\d+:error:/pppp:error:/; - s/:(?:\/[^\s:]+\/)?([^\/\s]+\.c):\d+:/:$1:dddd:/; + # There are differences in error messages between OpenSSL versions + s/SSL_CTX_set_cipher_list/SSL_connect/; # 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/; @@ -348,14 +441,16 @@ while(<IN>) # The message for a non-listening FIFO varies s/:[^:]+: while opening named pipe/: Error: while opening named pipe/; - # The name of the shell may vary - s/\s\Q$parm_shell\E\b/ SHELL/; - # Debugging output of lists of hosts may have different sort keys s/sort=\S+/sort=xx/ if /^\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\S+/; # 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 ======== @@ -365,8 +460,10 @@ while(<IN>) if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/) { my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4); - $expired = "" if !defined $expired; - my($increment) = date_seconds($date3) - date_seconds($date2); + $expired = '' if !defined $expired; + + # Round the time-difference up to nearest even value + my($increment) = ((date_seconds($date3) - date_seconds($date2) + 1) >> 1) << 1; # We used to use globally unique replacement values, but timing # differences make this impossible. Just show the increment on the @@ -380,6 +477,13 @@ while(<IN>) # 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-z.]+(:[0-9.]+)?):$parm_port_n /T:$1:PORT_N /; + + # 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 ======== @@ -389,12 +493,24 @@ while(<IN>) # 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\d\d?\s[A-Z][a-z]{2}\s\d\d\d\d\s\d\d\:\d\d:\d\d\s[-+]\d{4} + s/[A-Z][a-z]{2},\s\d\d?\s[A-Z][a-z]{2}\s\d{4}\s\d\d\:\d\d:\d\d\s[-+]\d{4} /Tue, 2 Mar 1999 09:44:33 +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)?/1999-03-02 09:44:33/gx; + 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)?\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){2}\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d @@ -412,17 +528,156 @@ while(<IN>) my($next) = $3 - $2; $_ = " first failed=dddd last try=dddd next try=+$next $4\n"; } - s/^now=\d+ received_time=\d+ diff=\d+ timeout=(\d+)/now=tttt received_time=tttt diff=tttt timeout=$1/; + 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 <time> to <time>/x; + + # Treat ECONNRESET the same as ECONNREFUSED. At least some systems give + # us the former on a new connection. + s/(could not connect to .*: Connection) reset by peer$/$1 refused/; + + # ======== TLS certificate algorithms ======== + # + # In Received: headers, convert RFC 8314 style ciphersuite to + # the older (comment) style, keeping only the Auth element + # (discarding kex, cipher, mac). For TLS 1.3 there is no kex + # element (and no _WITH); insert a spurious "RSA". + # Also in $tls_X_cipher_std reporting. + + s/^\s+by \S+ with .+ \K \(TLS1(?:\.[0-3])?\) tls TLS_.*?([^_]+)_WITH.+$/(TLS1.x:ke-$1-AES256-SHAnnn:xxx)/; + s/^\s+by \S+ with .+ \K \(TLS1(?:\.[0-3])?\) tls TLS_.+$/(TLS1.x:ke-RSA-AES256-SHAnnn:xxx)/; + + s/ cipher_ TLS_.*?([^_]+)_WITH.+$/ cipher_ TLS1.x:ke_$1_WITH_ci_mac/; + s/ cipher_ TLS_.*$/ cipher_ TLS1.x:ke_RSA_WITH_ci_mac/; + + # Test machines might have various different TLS library versions supporting + # different protocols; can't rely upon TLS 1.2's AES256-GCM-SHA384, so we + # treat the standard algorithms the same. + # + # TLSversion : KeyExchange? - Authentication/Signature - C_iph_er - MAC : bits + # + # So far, have seen: + # TLSv1:AES128-GCM-SHA256:128 + # TLSv1:AES256-SHA:256 + # TLSv1.1:AES256-SHA:256 + # TLSv1.2:AES256-GCM-SHA384:256 + # TLSv1.2:DHE-RSA-AES256-SHA:256 + # TLSv1.3:TLS_AES_256_GCM_SHA384:256 + # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128 + # We also need to handle the ciphersuite without the TLS part present, for + # client-ssl's output. We also see some older forced ciphersuites, but + # negotiating TLS 1.2 instead of 1.0. + # Mail headers (...), log-lines X=..., client-ssl output ... + # (and \b doesn't match between ' ' and '(' ) + # + # Retain the authentication algorith field as we want to test that. + + s/( (?: (?:\b|\s) [\(=] ) | \s )TLS1(\.[123])?:/$1TLS1.x:/xg; + s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-AES(128|256)-(GCM-SHA(256|384)|SHA)(?!:)/ke-$3-AES256-SHAnnn/g; + s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-AES(128|256)-(GCM-SHA(256|384)|SHA):(128|256)/ke-$3-AES256-SHAnnn:xxx/g; - # ======== Caller's login, uid, gid, home ======== + # OpenSSL TLSv1.3 - unsure what to do about the authentication-variant testcases now, + # as it seems the protocol no longer supports a user choice. Replace the "TLS" field with "RSA". + # Also insert a key-exchange field for back-compat, even though 1.3 doesn't do that. + # + # TLSversion : "TLS" - C_iph_er - MAC : ??? + # + s/TLS_AES(_256)?_GCM_SHA384(?!:)/ke-RSA-AES256-SHAnnn/g; + s/:TLS_AES(_256)?_GCM_SHA384:256/:ke-RSA-AES256-SHAnnn:xxx/g; + + # LibreSSL + # TLSv1:AES256-GCM-SHA384:256 + # TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256 + # + # ECDHE-RSA-CHACHA20-POLY1305 + # AES256-GCM-SHA384 + + s/(?<!-)(AES256-GCM-SHA384)/RSA-$1/; + s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-(AES256|CHACHA20)-(GCM-SHA384|POLY1305)(?!:)/ke-$3-AES256-SHAnnn/g; + s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-(AES256|CHACHA20)-(GCM-SHA384|POLY1305):256/ke-$3-AES256-SHAnnn:xxx/g; + + # GnuTLS have seen: + # TLS1.3:ECDHE_RSA_AES_256_GCM_SHA384:256 + # TLS1.3:ECDHE_SECP256R1__RSA_PSS_RSAE_SHA256__AES_256_GCM__AEAD:256 + # TLS1.3:ECDHE_X25519__RSA_PSS_RSAE_SHA256__AES_256_GCM:256 + # TLS1.3:ECDHE_PSK_SECP256R1__AES_256_GCM__AEAD:256 + # + # TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256 + # TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128 + # TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical) + # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128 + # TLS1.2:ECDHE_SECP256R1__RSA_SHA256__AES_256_GCM:256 + # TLS1.2:ECDHE_SECP256R1__RSA_SHA256__AES_128_CBC__SHA256:128 + # TLS1.2:ECDHE_SECP256R1__ECDSA_SHA512__AES_256_GCM:256 + # TLS1.2:ECDHE_SECP256R1__AES_256_GCM:256 (3.6.7 resumption) + # TLS1.2:ECDHE_RSA_SECP256R1__AES_256_GCM:256 (! 3.5.18 !) + # TLS1.2:RSA__CAMELLIA_256_GCM:256 (leave the cipher name) + # TLS1.2-PKIX:RSA__AES_128_GCM__AEAD:128 (the -PKIX seems to be a 3.1.20 thing) + # TLS1.2-PKIX:ECDHE_RSA_SECP521R1__AES_256_GCM__AEAD:256 + # + # X=TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256 + # X=TLS1.2:RSA_AES_256_CBC_SHA1:256 + # X=TLS1.1:RSA_AES_256_CBC_SHA1:256 + # X=TLS1.0:RSA_AES_256_CBC_SHA1:256 + # X=TLS1.0:DHE_RSA_AES_256_CBC_SHA1:256 + # X=TLS1.0-PKIX:RSA__AES_256_CBC__SHA1:256 + # and as stand-alone cipher: + # ECDHE-RSA-AES256-SHA + # DHE-RSA-AES256-SHA256 + # DHE-RSA-AES256-SHA + # picking latter as canonical simply because regex easier that way. + s/\bDHE_RSA_AES_128_CBC_SHA1:128/RSA-AES256-SHA1:256/g; + s/TLS1.[x0123](-PKIX)?: # TLS version + ((EC)?DHE(_((?<psk>PSK)_)?((?<auth>RSA|ECDSA)_)? + (SECP(256|521)R1|X25519))?__?)? # key-exchange + ((?<auth>RSA|ECDSA)((_PSS_RSAE)?_SHA(512|256))?__?)? # authentication + (?<with>WITH_)? # stdname-with + AES_(256|128)_(CBC|GCM) # cipher + (__?AEAD)? # pseudo-MAC + (__?SHA(1|256|384))? # PRF + :(256|128) # cipher strength + /"TLS1.x:ke-" + . (defined($+{psk}) ? $+{psk} : "") + . (defined($+{auth}) ? $+{auth} : "") + . (defined($+{with}) ? $+{with} : "") + . "-AES256-SHAnnn:xxx"/gex; + s/TLS1.2:RSA__CAMELLIA_256_GCM(_SHA384)?:256/TLS1.2:RSA_CAMELLIA_256_GCM-SHAnnn:256/g; + s/\b(ECDHE-(RSA|ECDSA)-AES256-SHA|DHE-RSA-AES256-SHA256)\b/ke-$2-AES256-SHAnnn/g; + + # Separate reporting of TLS version + s/ver: TLS1(\.[0-3])?$/ver: TLS1.x/; + s/ \(TLS1(\.[0-3])?\) / (TLS1.x) /; + + # GnuTLS library error message changes + s/(No certificate was found|Certificate is required)/The peer did not send any certificate/g; +#(dodgy test?) s/\(certificate verification failed\): invalid/\(gnutls_handshake\): The peer did not send any certificate./g; + s/\(gnutls_priority_set\): No or insufficient priorities were set/\(gnutls_handshake\): Could not negotiate a supported cipher suite/g; + s/\(gnutls_handshake\): \KNo supported cipher suites have been found.$/Could not negotiate a supported cipher suite./; + + # (this new one is a generic channel-read error, but the testsuite + # only hits it in one place) + 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; + + # (replace old with new, hoping that old only happens in one situation) + 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; + 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; + + # signature algorithm names + s/RSA-SHA1/RSA-SHA/; + + + # ======== Caller's login, uid, gid, home, gecos ======== s/\Q$parm_caller_home\E/CALLER_HOME/g; # NOTE: these must be done s/\b\Q$parm_caller\E\b/CALLER/g; # in this order! @@ -434,6 +689,8 @@ while(<IN>) s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g; s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g; + s/\bname="?$parm_caller_gecos"?/name=CALLER_GECOS/g; + # When looking at spool files with -Mvh, we will find not only the caller # login, but also the uid and gid. It seems that $) in some Perls gives all # the auxiliary gids as well, so don't bother checking for that. @@ -448,9 +705,10 @@ while(<IN>) # ======== Exim's login ======== - # For bounce messages, this will appear on the U= lines in logs and also - # after Received: and in addresses. In one pipe test it appears after - # "Running as:". It also appears in addresses, and in the names of lock + # For messages received by the daemon, this is in the -H file, which some + # tests inspect. For bounce messages, this will appear on the U= lines in + # logs and also after Received: and in addresses. In one pipe test it appears + # after "Running as:". It also appears in addresses, and in the names of lock # files. s/U=$parm_eximuser/U=EXIMUSER/; @@ -467,17 +725,24 @@ while(<IN>) s/\buid=$parm_exim_uid\b/uid=EXIM_UID/g; s/\bgid=$parm_exim_gid\b/gid=EXIM_GID/g; + s/^$parm_eximuser $parm_exim_uid $parm_exim_gid/EXIMUSER EXIM_UID EXIM_GID/; + # ======== General uids, gids, and pids ======== # Note: this must come after munges for caller's and exim's uid/gid + # These are for systems where long int is 64 + s/\buid=4294967295/uid=-1/; + s/\beuid=4294967295/euid=-1/; + s/\bgid=4294967295/gid=-1/; + s/\begid=4294967295/egid=-1/; + s/\bgid=\d+/gid=gggg/; s/\begid=\d+/egid=gggg/; - s/\bpid=\d+/pid=pppp/; + s/\b(pid=|pid |PID: )\d+/$1pppp/; s/\buid=\d+/uid=uuuu/; s/\beuid=\d+/euid=uuuu/; s/set_process_info:\s+\d+/set_process_info: pppp/; - s/queue run pid \d+/queue run pid ppppp/; s/process \d+ running as transport filter/process pppp running as transport filter/; s/process \d+ writing to transport filter/process pppp writing to transport filter/; s/reading pipe for subprocess \d+/reading pipe for subprocess pppp/; @@ -486,6 +751,14 @@ while(<IN>) # Pid in temp file in appendfile transport s"test-mail/temp\.\d+\."test-mail/temp.pppp."; + # Optional pid in log lines + s/^(\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d)(\.\d{3}|)(\s[+-]\d{4}|)(\s\[\d+\])/ + "$1$2$3 [" . new_value($4, "%s", \$next_pid) . "]"/gxe; + + # Optional pid in syslog test lines + s/^(SYSLOG:\s\'([-0-9]{10}\s[:.0-9]{8,12}\s([-+]\d{4}\s)?|))(\[\d+\] )/ + "$1\[" . new_value($4, "%s", \$next_pid) . "]"/gxe; + # Detect a daemon stderr line with a pid and save the pid for subsequent # removal from following lines. $spid = $1 if /^(\s*\d+) (?:listening|LOG: MAIN|(?:daemon_smtp_port|local_interfaces) overridden by)/; @@ -495,6 +768,10 @@ while(<IN>) s/waiting for children of \d+/waiting for children of pppp/; s/waiting for (\S+) \(\d+\)/waiting for $1 (pppp)/; + # Most builds are without HAVE_LOCAL_SCAN + next if /^calling local_scan\(\); timeout=300$/; + next if /^local_scan\(\) returned 0 NULL$/; + # ======== Port numbers ======== # Incoming port numbers may vary, but not in daemon startup line. @@ -502,20 +779,33 @@ while(<IN>) s/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e; # This handles "connection from" and the like, when the port is given - if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/\*>/ && - !/Connection refused/) + if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/ + && !/\*>/&& !/==/ && !/\*\*/ && !/Connection refused/ && !/in response to/) { s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie; } # Port in host address in spool file output from -Mvh - s/^-host_address (.*)\.\d+/-host_address $1.9999/; + s/^(--?host_address) (.*)\.\d+/$1 $2.9999/; + + if ($dynamic_socket and $dynamic_socket->opened and my $port = $dynamic_socket->sockport) { + s/^Connecting to 127\.0\.0\.1 port \K$port/<dynamic port>/; + } # ======== Local IP addresses ======== # The amount of space between "host" and the address in verification output # depends on the length of the host name. We therefore reduce it to one space # for all of them. + # Also, the length of space at the end of the host line is dependent + # on the length of the longest line, so strip it also on otherwise + # un-rewritten lines like localhost + # + # host 127.0.0.1 [127.0.0.1] + # host 10.0.0.1 [10.0.0.1]- + # + # host 127.0.0.1 [127.0.0.1]-- + # host 169.16.16.16 [169.16.16.10] s/^\s+host\s(\S+)\s+(\S+)/ host $1 $2/; s/^\s+(host\s\S+\s\S+)\s+(port=.*)/ host $1 $2/; @@ -523,7 +813,11 @@ while(<IN>) s/host\s\Q$parm_ipv4\E\s\[\Q$parm_ipv4\E\]/host ipv4.ipv4.ipv4.ipv4 [ipv4.ipv4.ipv4.ipv4]/; 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]/; s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g; - s/\b\Q$parm_ipv6\E\b/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g; + s/(^|\W)\K\Q$parm_ipv6\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g; + s/(^|\W)\K\Q$parm_ipv6_stripped\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g; + s/\b\Q$parm_ipv4r\E\b/ip4-reverse/g; + s/(^|\W)\K\Q$parm_ipv6r\E/ip6-reverse/g; + s/^\s+host\s\S+\s+\[\S+\]\K +$//; # strip, not collapse the trailing whitespace # ======== Test network IP addresses ======== @@ -533,11 +827,10 @@ while(<IN>) # ======== IP error numbers and messages ======== # These vary between operating systems - s/Can't assign requested address/Network Error/; - s/Cannot assign requested address/Network Error/; + s/Can(no|')t assign requested address/Network Error/; s/Operation timed out/Connection timed out/; s/Address family not supported by protocol family/Network Error/; - s/Network is unreachable/Network Error/; + s/Network( is)? unreachable/Network Error/; s/Invalid argument/Network Error/; s/\(\d+\): Network/(dd): Network/; @@ -550,10 +843,20 @@ while(<IN>) # ======== Other error numbers ======== s/errno=\d+/errno=dd/g; + # ======== System Error Messages ====== + # depending on the underlaying file system the error message seems to differ + s/(?: is not a regular file)|(?: has too many links \(\d+\))/ not a regular file or too many links/; # ======== Output from ls ======== # Different operating systems use different spacing on long output - s/ +/ /g if /^[-rwd]{10} /; + #s/ +/ /g if /^[-rwd]{10} /; + # (Bug 1226) SUSv3 allows a trailing printable char for modified access method control. + # Handle only the Gnu and MacOS space, dot, plus and at-sign. A full [[:graph:]] + # unfortunately matches a non-ls linefull of dashes. + # Allow the case where we've already picked out the file protection bits. + if (s/^([-d](?:[-r][-w][-SsTtx]){3})[.+@]?( +|$)/$1$2/) { + s/ +/ /g; + } # ======== Message sizes ========= @@ -564,30 +867,32 @@ while(<IN>) s/([\s,])S=\d+\b/$1S=sss/; s/:S\d+\b/:Ssss/; s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout; - s/\sSIZE=\d+\b/ SIZE=ssss/ if $is_stderr || $is_stdout; + s/\sSIZE=\d+\b/ SIZE=ssss/; s/\ssize=\d+\b/ size=sss/ if $is_stderr; s/old size = \d+\b/old size = sssss/; s/message size = \d+\b/message size = sss/; s/this message = \d+\b/this message = sss/; s/Size of headers = \d+/Size of headers = sss/; s/sum=(?!0)\d+/sum=dddd/; - s/(?<=sum=dddd )count=(?!0)\d+\b/count=dd/; - s/(?<=sum=0 )count=(?!0)\d+\b/count=dd/; + s/(?<=sum=dddd )count=\d+\b/count=dd/; + s/(?<=sum=0 )count=\d+\b/count=dd/; s/,S is \d+\b/,S is ddddd/; s/\+0100,\d+;/+0100,ddd;/; s/\(\d+ bytes written\)/(ddd bytes written)/; s/added '\d+ 1'/added 'ddd 1'/; + s/Received\s+\d+/Received nnn/; + s/Delivered\s+\d+/Delivered nnn/; # ======== Values in spool space failure message ======== - s/space=\d+ inodes=\d+/space=xxxxx inodes=xxxxx/; + s/space=\d+ inodes=[+-]?\d+/space=xxxxx inodes=xxxxx/; # ======== Filter sizes ======== # The sizes of filter files may vary because of the substitution of local # filenames, logins, etc. - s/^\d+(?= bytes read from )/ssss/; + s/^\d+(?= (\(tainted\) )?bytes read from )/ssss/; # ======== OpenSSL error messages ======== @@ -595,8 +900,11 @@ while(<IN>) # numbers, or handle specific bad conditions in different ways, leading to # different wording in the error messages, so we cannot compare them. - s/(TLS error on connection (?:from|to) .*? \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/; - +#XXX This loses any trailing "deliving unencypted to" which is unfortunate +# but I can't work out how to deal with that. + s/(TLS session: \(SSL_\w+\): error:)(.*)(?!: delivering)/$1 <<detail omitted>>/; + s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/; + next if /SSL verify error: depth=0 error=certificate not trusted/; # ======== Maildir things ======== # timestamp output in maildir processing @@ -608,12 +916,12 @@ while(<IN>) s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/; # Maildir file names in general - s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/; + s/\b\d+\.M\d+P\d+\b/dddddddddd.HddddddPddddd/; # Maildirsize data - if (/^\d+S,\d+C\s*$/) + while (/^\d+S,\d+C\s*$/) { - print MUNGED "dddS,dC\n"; + print MUNGED; while (<IN>) { last if !/^\d+ \d+\s*$/; @@ -621,6 +929,12 @@ while(<IN>) } last if !defined $_; } + last if !defined $_; + + + # SRS timestamps and signatures vary by hostname and from run to run + + s/(?i)SRS0=....=.[^=]?=([^=]+)=([^@]+)\@([^ ]+)/SRS0=ZZZZ=YY=$1=$2\@$3/g; # ======== Output from the "fd" program about open descriptors ======== @@ -628,9 +942,7 @@ while(<IN>) # at least we'll still be checking the number of open fd's. s/max fd = \d+/max fd = dddd/; - s/status=0 RDONLY/STATUS/g; - s/status=1 WRONLY/STATUS/g; - s/status=2 RDWR/STATUS/g; + s/status=[0-9a-f]+ (?:RDONLY|WRONLY|RDWR)/STATUS/g; # ======== Contents of spool files ======== @@ -639,6 +951,10 @@ while(<IN>) s/^\d\d\d(?=[PFS*])/ddd/; + # ========================================================== + # MIME boundaries in RFC3461 DSN messages + s/\d{8,10}-eximdsn-\d+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/; + # ========================================================== # Some munging is specific to the specific file types @@ -646,9 +962,11 @@ while(<IN>) if ($is_stdout) { - # Skip translate_ip_address in -bP output because it ain't always there + # Skip translate_ip_address and use_classresources in -bP output because + # they aren't always there. next if /translate_ip_address =/; + next if /use_classresources/; # In certain filter tests, remove initial filter lines because they just # clog up by repetition. @@ -665,6 +983,48 @@ while(<IN>) next; } } + + # remote IPv6 addrs vary + s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/; + + # openssl version variances + # Error lines on stdout from SSL contain process id values and file names. + # They also contain a source file name and line number, which may vary from + # release to release. + + next if /^SSL info:/; + next if /SSL verify error: depth=0 error=certificate not trusted/; + s/SSL3_READ_BYTES/ssl3_read_bytes/i; + s/CONNECT_CR_FINISHED/ssl3_read_bytes/i; + s/^\d+:error:\d+(?:E\d+)?(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/; + s/^error:[^:]*:(SSL routines:ssl3_read_bytes:(tls|ssl)v\d+ alert)/error:dddddddd:$1/; + + # gnutls version variances + next if /^Error in the pull function./; + + # optional IDN2 variant conversions. Accept either IDN1 or IDN2 + s/conversion strasse.de/conversion xn--strae-oqa.de/; + s/conversion: german.xn--strae-oqa.de/conversion: german.straÃe.de/; + + # subsecond timstamp info in reported header-files + s/^(-received_time_usec \.)\d{6}$/$1uuuuuu/; + + # Postgres server takes varible time to shut down; lives in various places + s/^waiting for server to shut down\.+ done$/waiting for server to shut down.... done/; + s/^\/.*postgres /POSTGRES /; + + # DMARC is not always supported by the build + next if /^dmarc_tld_file =/; + + # ARC is not always supported by the build + next if /^arc_sign =/; + + # TLS resumption is not always supported by the build + next if /^tls_resumption_hosts =/; + next if /^-tls_resumption/; + + # gsasl library version may not support some methods + s/250-AUTH ANONYMOUS PLAIN SCRAM-SHA-1\K SCRAM-SHA-256//; } # ======== stderr ======== @@ -675,14 +1035,113 @@ while(<IN>) s/^Exim version .*/Exim version x.yz ..../; - # Debugging lines for Exim terminations + # Debugging lines for Exim terminations and process-generation s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/; + s/^(proxy-proc \w{5}-pid) \d+$/$1 pppp/; + s/^(?:\s*\d+ )(exec .* -oPX)$/pppp $1/; + next if /(?:postfork: | fork(?:ing|ed) for )/; # IP address lookups use gethostbyname() when IPv6 is not supported, # and gethostbyname2() or getipnodebyname() when it is. - s/\bgethostbyname2?|\bgetipnodebyname/get[host|ipnode]byname[2]/; + s/\b(gethostbyname2?|\bgetipnodebyname)(\(af=inet\))?/get[host|ipnode]byname[2]/; + + # Extra lookups done when ipv6 is supported + next if /^host_fake_gethostbyname\(af=inet6\) returned 1 \(HOST_NOT_FOUND\)$/; + + # we don't care what TZ enviroment the testhost was running + next if /^Reset TZ to/; + + # ========= Exim lookups ================== + # Lookups have a char which depends on the number of lookup types compiled in, + # in stderr output. Replace with a "0". Recognising this while avoiding + # other output is fragile; perhaps the debug output should be revised instead. + s%^\s+(:?closing )?\K[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g; + + # drop gnutls version strings + next if /GnuTLS compile-time version: \d+[\.\d]+$/; + next if /GnuTLS runtime version: \d+[\.\d]+$/; + + # drop openssl version strings + next if /OpenSSL compile-time version: OpenSSL \d+[\.\da-z]+/; + next if /OpenSSL runtime version: OpenSSL \d+[\.\da-z]+/; + + # this is timing-dependent + next if /^OpenSSL: creating STEK$/; + next if /^selfsign cert rotate$/; + + # TLS preload + # only OpenSSL speaks of these + next if /^TLS: (preloading (DH params|ECDH curve|CA bundle) for server|generating selfsigned server cert)/; + next if /^Diffie-Hellman initialized from default/; + next if /^ECDH OpenSSL (< )?[\d.+]+: temp key parameter settings:/; + next if /^ECDH: .*'prime256v1'/; + next if /^tls_verify_certificates: system$/; + next if /^tls_set_watch: .*\/cert.pem/; + next if /^Generating 2048 bit RSA key/; + + # TLS preload + # only GnuTLS speaks of these + next if /^GnuTLS global init required$/; + next if /^TLS: basic cred init, server/; + next if /^TLS: preloading cipher list for server: NULL$/; + s/^GnuTLS using default session cipher\/priority "NORMAL"$/TLS: not preloading cipher list for server/; + next if /^GnuTLS<2>: added \d+ protocols, \d+ ciphersuites, \d+ sig algos and \d+ groups into priority list$/; + next if /^GnuTLS<2>: (Disabling X.509 extensions|signing structure using RSA-SHA256)/; + next if /^GnuTLS.*(wrap_nettle_mpi_print|gnutls_subject_alt_names_get|get_alt_name)/; + + # only kevent platforms (FreeBSD, OpenBSD) say this + next if /^watch dir/; + next if /^watch file .*\/usr\/local/; + next if /^watch file .*\/etc\/ssl/; + + # TLS preload + # there happen in different orders for OpenSSL/GnuTLS/noTLS + next if /^TLS: generating selfsigned server cert/; + next if /^TLS: not preloading (CA bundle|cipher list) for server$/; + next if /^TLS: not preloading server certs$/; + + # drop lookups + next if /^Lookups \(built-in\):/; + next if /^Loading lookup modules from/; + next if /^Loaded \d+ lookup modules/; + next if /^Total \d+ lookups/; + + # drop compiler information + next if /^Compiler:/; + + # and the ugly bit + # different libraries will have different numbers (possibly 0) of follow-up + # lines, indenting with more data + if (/^Library version:/) { + while (1) { + $_ = <IN>; + next if /^\s/; + goto RESET_AFTER_EXTRA_LINE_READ; + } + } + + # drop other build-time controls emitted for debugging + next if /^WHITELIST_D_MACROS:/; + next if /^TRUSTED_CONFIG_LIST:/; + + # As of Exim 4.74, we log when a setgid fails; because we invoke Exim + # with -be, privileges will have been dropped, so this will always + # be the case + next if /^changing group to \d+ failed: (Operation not permitted|Not owner)/; + + # We might not keep this check; rather than change all the tests, just + # ignore it as long as it succeeds; then we only need to change the + # TLS tests where tls_require_ciphers has been set. + if (m{^changed uid/gid: calling tls_validate_require_cipher}) { + my $discard = <IN>; + next; + } + next if /^tls_validate_require_cipher child \d+ ended: status=0x0/; + + # We invoke Exim with -D, so we hit this new message as of Exim 4.73: + next if /^macros_trusted overridden to true by whitelisting/; # We have to omit the localhost ::1 address so that all is well in # the IPv4-only case. @@ -691,12 +1150,19 @@ while(<IN>) if (/looked up these IP addresses/); next if /name=localhost address=::1/; + # drop pdkim debugging header + next if /^DKIM( <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+|: no signatures)$/; + + # Some platforms have TIOCOUTome do not + next if /\d+ bytes remain in socket output buffer$/; # Various other IPv6 lines must be omitted too next if /using host_fake_gethostbyname for \S+ \(IPv6\)/; next if /get\[host\|ipnode\]byname\[2\]\(af=inet6\)/; next if /DNS lookup of \S+ \(AAAA\) using fakens/; next if / in dns_ipv4_lookup?/; + next if / writing neg-cache entry for .*AAAA/; + next if /^faking res_search\(AAAA\) response length as 65535/; if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/) { @@ -704,11 +1170,22 @@ while(<IN>) next; } + # Non-TLS bulds have a different Recieved: header expansion + s/^((.*)\t}}}}by \$primary_hostname \$\{if def:received_protocol \{with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/; + s/^((\s*).*considering: with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/; + if (/condition: def:tls_in_cipher_std$/) + { + $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; + $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; + $_= <IN>; $_= <IN>; $_= <IN>; next; + } + + # Skip tls_advertise_hosts and hosts_require_tls checks when the options # are unset, because tls ain't always there. next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?) - \sno\s\(option\sunset\)/x; + \sno\s\((option\sunset|end\sof\slist)\)/x; # Skip auxiliary group lists because they will vary. @@ -732,12 +1209,14 @@ while(<IN>) # Some DBM libraries seem to make DBM files on opening with O_RDWR without # O_CREAT; other's don't. In the latter case there is some debugging output # which is not present in the former. Skip the relevant lines (there are - # two of them). + # three of them). - if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/) + if (/returned from EXIM_DBOPEN: \(nil\)/) { - $_ = <IN>; - next; + $_ .= <IN>; + s?\Q$parm_cwd\E?TESTSUITE?g; + if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/) + { $_ = <IN>; next; } } # Some tests turn on +expand debugging to check on expansions. @@ -753,6 +1232,163 @@ while(<IN>) while (<IN>) { last if !/^\s/; } } + # remote port numbers vary + s/(Connection request from 127.0.0.1 port) \d{1,5}/$1 sssss/; + + # Platform-dependent error strings + s/Operation timed out/Connection timed out/; + + # Platform differences on disconnect + s/unexpected disconnection while reading SMTP command from \[127.0.0.1\] \K\(error: Connection reset by peer\) //; + + # Platform-dependent resolver option bits + s/^ (?:writing|update) neg-cache entry for [^,]+-\K[0-9a-f]+, ttl/xxxx, ttl/; + + # timing variance, run-to-run + s/^time on queue = \K1s/0s/; + + # content-scan: file order can vary in directory + s%unspool_mbox\(\): unlinking 'TESTSUITE/spool/scan/[^/]*/\K[^\']*%FFFFFFFFF%; + + # Skip hosts_require_dane checks when the options + # are unset, because dane ain't always there. + next if /in\shosts_require_dane\?\sno\s\(option\sunset\)/x; + + # daemon notifier socket + s/^(\s*\d+|ppppp) (creating notifier socket)$/ppppp $2/; + s/^ \@(.*exim_daemon_notify)$/ $1/; + s/^(\s*\d+|ppppp) \@?(.*exim_daemon_notify)$/ppppp $2/; + next if /unlinking notifier socket/; + + # daemon notifier socket + # Timing variance over runs. Collapse repeated memssages. + if (/notify triggered queue run/) + { + my $line = $_; + while (/notify triggered queue run/) { $_ = <IN>; } + $_ = $line . $_; + } + + # DISABLE_OCSP + next if /in hosts_requ(est|ire)_ocsp\? (no|yes)/; + + # SUPPORT_PROXY + next if /host in hosts_proxy\?/; + + # PIPE_CONNECT + next if / in (pipelining_connect_advertise_hosts|hosts_pipe_connect)?\? no /; + + # Experimental_International + next if / in smtputf8_advertise_hosts\? no \(option unset\)/; + + # Experimental_REQUIRETLS + next if / in tls_advertise_requiretls?\? no \(end of list\)/; + + # TCP Fast Open + next if /^(ppppp )?setsockopt FASTOPEN: Network Error/; + + # Environment cleaning + next if /\w+ in keep_environment\? (yes|no)/; + + # Sizes vary with test hostname + s/^cmd buf flush \d+ bytes/cmd buf flush ddd bytes/; + + # Spool filesystem free space changes on different systems. + s/^((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/; + + # Non-TLS builds have different expansions for received_header_text + if (s/(with \$received_protocol)\}\} \$\{if def:tls_cipher \{\(\$tls_cipher\)\n$/$1/) + { + $_ .= <IN>; + s/[\sâ]+\}\}(?=\(Exim )/\}\} /; + } + if (/^ âââcondition: def:tls_cipher$/) + { + <IN>; <IN>; <IN>; <IN>; <IN>; <IN>; + <IN>; <IN>; <IN>; <IN>; <IN>; next; + } + + # Not all platforms build with DKIM enabled + next if /^DKIM >> Body data for hash, canonicalized/; + + # Not all platforms build with SPF enabled + next if /^(spf_conn_init|SPF_dns_exim_new|spf_compile\.c)/; + + # Not all platforms have sendfile support + next if /^cannot use sendfile for body: no support$/; + + # Parts of DKIM-specific debug output depend on the time/date + next if /^date:\w+,\{SP\}/; + next if /^DKIM \[[^[]+\] (Header hash|b) computed:/; + + # Not all platforms support TCP Fast Open, and the compile omits the check + if (s/\S+ in hosts_try_fastopen\? (no \(option unset\)|no \(end of list\)|yes \(matched "\*"\))\n$//) + { + chomp; + $_ .= <IN>; + s/ \.\.\. >>> / ... /; + if (s/ non-TFO mode connection attempt to 224.0.0.0, 0 data\b$//) { chomp; $_ .= <IN>; } + s/Address family not supported by protocol family/Network Error/; + s/Network is unreachable/Network Error/; + } + next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/; + s/^(Connecting to .* \.\.\. sending) \d+ (nonTFO early-data)$/$1 dd $2/; + + if (/^([0-9: ]* # possible timestamp + Connecting\ to\ [^ ]+\ [^ ]+(\ from\ [^ ]+)?)\ \.\.\. + \ .*TFO\ mode\x20 + (sendto,\ no\ data:\ EINPROGRESS # Linux + |connection\ attempt\ to\ [^,]+,\ 0\ data) # MacOS & no-support + $/x) + { + $_ = $1 . " ... " . <IN>; + s/^(.* \.\.\.) [0-9: ]*connected$/$1 connected/; + + if (/^Connecting to .* \.\.\. connected$/) + { + $_ .= <IN>; + if (/^(Connecting to .* \.\.\. )connected\n\s+SMTP(\(close\)>>|\(Connection refused\)<<)$/) + { + $_ = $1 . "failed: Connection refused\n" . <IN>; + s/^(Connecting .*)\n\s+SMTP\(close\)>>$/$1/; + } + elsif (/^(Connecting to .* \.\.\. connected\n)read response data: size=/) + { $_ = $1; } + + # Date/time in SMTP banner + s/[A-Z][a-z]{2},\s\d\d?\s[A-Z][a-z]{2}\s\d{4}\s\d\d\:\d\d:\d\d\s[-+]\d{4} + /Tue, 2 Mar 1999 09:44:33 +0000/gx; + } + } + + # Specific pointer values reported for DB operations change from run to run + s/^(\s*returned from EXIM_DBOPEN: )(0x)?[0-9a-f]+/${1}0xAAAAAAAA/; + s/^(\s*EXIM_DBCLOSE.)(0x)?[0-9a-f]+/${1}0xAAAAAAAA/; + + # Platform-dependent output during MySQL startup + next if /PerconaFT file system space/; + next if /^Waiting for MySQL server to answer/; + next if /mysqladmin: CREATE DATABASE failed; .* database exists/; + + # Postgres version-dependent differences + s/^initdb: warning: (enabling "trust" authentication for local connections)$/\nWARNING: $1/; + + # Not all builds include DMARC + next if /^DMARC: no (dmarc_tld_file|sender_host_address)$/ ; + + # TLS resumption is not always supported by the build + next if /in tls_resumption_hosts\?/; + + # Platform differences in errno strings + s/ SMTP\(Operation timed out\)<</ SMTP(Connection timed out)<</; + + # Platform differences for errno values (eg. Hurd) + s/^errno = \d+$/errno = EEE/; + s/^writing error \d+: /writing error EEE: /; + + # Some platforms have to flip to slow-mode taint-checking + next if /switching to slow-mode taint checking/; + # When Exim is checking the size of directories for maildir, it uses # the check_dir_size() function to scan directories. Of course, the order # of the files that are obtained using readdir() varies from system to @@ -785,15 +1421,97 @@ while(<IN>) /^Support for:/ || /^Routers:/ || /^Transports:/ || + /^Malware:/ || /^log selectors =/ || /^cwd=/ || - /^Fixed never_users:/ + /^Fixed never_users:/ || + /^Configure owner:/ || + /^Size of off_t:/ ); + + } next; } + # ======== log ======== + + elsif ($is_log) + { + # Berkeley DB version differences + next if / Berkeley DB error: /; + + # CHUNKING: exact sizes depend on hostnames in headers + s/(=>.* K C="250- \d)\d+ (byte chunk, total \d)\d+/$1nn $2nn/; + + # openssl version variances + s/(TLS error on connection [^:]*: error:)[0-9A-F]{8}(:system library):(?:fopen|func\(4095\)):(No such file or directory)$/$1xxxxxxxx$2:fopen:$3/; + s/(DANE attempt failed.*error:)[0-9A-F]{8}(:SSL routines:)(?:(?i)ssl3_get_server_certificate|tls_process_server_certificate|CONNECT_CR_CERT)(?=:certificate verify failed$)/$1xxxxxxxx$2ssl3_get_server_certificate/; + s/(DKIM: validation error: )error:[0-9A-F]{8}:rsa routines:(?:(?i)int_rsa_verify|CRYPTO_internal):(?:bad signature|algorithm mismatch)$/$1Public key signature verification has failed./; + s/ARC: AMS signing: privkey PEM-block import: error:\K[0-9A-F]{8}:(PEM routines):get_name:(no start line)/0906D06C:$1:PEM_read_bio:$2/; + + # gnutls version variances + if (/TLS error on connection \(recv\): .* (Decode error|peer did not send any certificate)/) + { + my $prev = $_; + $_ = <IN>; + if (/error on first read/) + { + s/TLS session: \Kerror on first read:/(gnutls_handshake): A TLS fatal alert has been received.:/; + goto RESET_AFTER_EXTRA_LINE_READ; + } + else + { $_ = $prev; } + } + # translate gnutls error into the openssl one + s/ARC: AMS signing: privkey PEM-block import: \KThe requested data were not available.$/error:0906D06C:PEM routines:PEM_read_bio:no start line/; + + # DKIM timestamps + if ( /(DKIM: d=.*) t=([0-9]*) x=([0-9]*) / ) + { + my ($prefix, $t_diff) = ($1, $3 - $2); + s/DKIM: d=.* t=[0-9]* x=[0-9]* /${prefix} t=T x=T+${t_diff} /; + } + # GnuTLS reports a different keysize vs. OpenSSL, for ed25519 keys + s/signer: [^ ]* bits:\K 256/ 253/; + s/public key too short:\K 256 bits/ 253 bits/; + + # port numbers + s/(?:\[[^\]]*\]:|port )\K$parm_port_d/PORT_D/; + s/(?:\[[^\]]*\]:|port )\K$parm_port_d2/PORT_D2/; + s/(?:\[[^\]]*\]:|port )\K$parm_port_d3/PORT_D3/; + s/(?:\[[^\]]*\]:|port )\K$parm_port_d4/PORT_D4/; + s/(?:\[[^\]]*\]:|port )\K$parm_port_s/PORT_S/; + s/(?:\[[^\]]*\]:|port )\K$parm_port_n/PORT_N/; + s/I=\[[^\]]*\]:\K\d+/ppppp/; + + # Platform differences for errno values (eg. Hurd). Leave 0 and negative numbers alone. + s/R=\w+ T=\w+ defer\K \([1-9]\d*\): / (EEE): /; + + # Platform differences in errno strings + s/Arg list too long/Argument list too long/; + + # OpenSSL vs. GnuTLS + s/session: \K\((SSL_connect|gnutls_handshake)\): timed out/(tls lib connect fn): timed out/; + s/TLS error on connection from .*\K\((SSL_accept|gnutls_handshake)\): timed out/(tls lib accept fn): timed out/; + s/TLS error on connection from .*\K(SSL_accept: TCP connection closed by peer|\(gnutls_handshake\): The TLS connection was non-properly terminated.)/(tls lib accept fn): TCP connection closed by peer/; + } + + # ======== mail ======== + + elsif ($is_mail) + { + # DKIM timestamps, and signatures depending thereon + if ( /^(\s+)t=([0-9]*); x=([0-9]*); b=[A-Za-z0-9+\/]+$/ ) + { + my ($indent, $t_diff) = ($1, $3 - $2); + s/.*/${indent}t=T; x=T+${t_diff}; b=bbbb;/; + <IN>; + <IN>; + } + } + # ======== All files other than stderr ======== print MUNGED; @@ -812,14 +1530,61 @@ return $yield; # Arguments: [0] the prompt string # [1] if there is a U in the prompt and $force_update is true -# Returns: nothing (it sets $_) +# [2] if there is a C in the prompt and $force_continue is true +# Returns: returns the answer + +sub interact { + my ($prompt, $have_u, $have_c) = @_; + + print $prompt; + + if ($have_u) { + print "... update forced\n"; + return 'u'; + } -sub interact{ -print $_[0]; -if ($_[1]) { $_ = "u"; print "... update forced\n"; } - else { $_ = <T>; } + if ($have_c) { + print "... continue forced\n"; + return 'c'; + } + + return lc <T>; +} + + + +################################################## +# Subroutine to log in force_continue mode # +################################################## + +# In force_continue mode, we just want a terse output to a statically +# named logfile. If multiple files in same batch (stdout, stderr, etc) +# all have mismatches, it will log multiple times. +# +# Arguments: [0] the logfile to append to +# [1] the testno that failed +# Returns: nothing + + + +sub log_failure { + my ($logfile, $testno, $detail) = @_; + + open(my $fh, '>>', $logfile) or return; + + print $fh "Test $testno " + . (defined $detail ? "$detail " : '') + . "failed\n"; } +# Computer-readable summary results logfile + +sub log_test { + my ($logfile, $testno, $resultchar) = @_; + + open(my $fh, '>>', $logfile) or return; + print $fh "$testno $resultchar\n"; +} @@ -836,21 +1601,29 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted +# [5] optionally, a custom munge command # -# Returns: 0 comparison succeeded or differences to be ignored -# 1 comparison failed; files were updated (=> re-compare) +# Returns: 0 comparison succeeded +# 1 comparison failed; differences to be ignored +# 2 comparison failed; files may have been updated (=> re-compare) # # Does not return if the user replies "Q" to a prompt. sub check_file{ -my($rf,$rsf,$mf,$sf,$sortfile) = @_; +my($rf,$rsf,$mf,$sf,$sortfile,$extra) = @_; # If there is no saved file, the raw files must either not exist, or be # empty. The test ! -s is TRUE if the file does not exist or is empty. -if (! -e $sf) +# we check if there is a flavour specific file, but we remember +# the original file name as "generic" +$sf_generic = $sf; +$sf_flavour = "$sf_generic.$flavour"; +$sf_current = -e $sf_flavour ? $sf_flavour : $sf_generic; + +if (! -e $sf_current) { - return 0 if (! -s $rf && ! -s $rsf); + return 0 if (! -s $rf && (! defined $rsf || ! -s $rsf)); print "\n"; print "** $rf is not empty\n" if (-s $rf); @@ -858,11 +1631,14 @@ if (! -e $sf) for (;;) { - print "Continue, Show, or Quit? [Q] "; - $_ = <T>; - tests_exit(1) if /^q?$/i; - return 0 if /^c$/i; - last if (/^s$/); + $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue); + tests_exit(1) if /^q?$/; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, $rf); + log_test($log_summary_filename, $testno, 'F') if ($force_continue); + } + return 1 if /^c$/i && $rf !~ /paniclog/ && (!defined $rsf || $rsf !~ /paniclog/); + last if (/^[sc]$/); } foreach $f ($rf, $rsf) @@ -872,30 +1648,38 @@ if (! -e $sf) print "\n"; print "------------ $f -----------\n" if (defined $rf && -s $rf && defined $rsf && -s $rsf); - system("$more $f"); + system @more => $f; } } print "\n"; for (;;) { - interact("Continue, Update & retry, Quit? [Q] ", $force_update); - tests_exit(1) if /^q?$/i; - return 0 if /^c$/i; + $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, $rf); + log_test($log_summary_filename, $testno, 'F') + } + return 1 if /^c$/i; last if (/^u$/i); } } +#### $_ + # Control reaches here if either (a) there is a saved file ($sf), or (b) there # was a request to create a saved file. First, create the munged file from any # data that does exist. -open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); -my($truncated) = munge($rf) if -e $rf; +open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!"); +my($truncated) = munge($rf, $extra) if -e $rf; + +# Append the raw server log, if it is non-empty if (defined $rsf && -e $rsf) { print MUNGED "\n******** SERVER ********\n"; - $truncated |= munge($rsf); + $truncated |= munge($rsf, $extra); } close(MUNGED); @@ -913,7 +1697,7 @@ close(MUNGED); # a result of parallel deliveries. We load the munged file and sort sequences # of delivery lines. -if (-e $sf) +if (-e $sf_current) { # Deal with truncated text items @@ -921,10 +1705,10 @@ if (-e $sf) { my(@munged, @saved, $i, $j, $k); - open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!"); + open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!"); @munged = <MUNGED>; close(MUNGED); - open(SAVED, "$sf") || tests_exit(-1, "Failed to open $sf: $!"); + open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $sf_current: $!"); @saved = <SAVED>; close(SAVED); @@ -946,26 +1730,25 @@ if (-e $sf) } } - open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); - for ($i = 0; $i < @munged; $i++) - { print MUNGED $munged[$i]; } - close(MUNGED); + open(my $fh, '>', $mf) or tests_exit(-1, "Failed to open $mf: $!"); + print $fh @munged; } # Deal with log sorting if ($sortfile) { - my(@munged, $i, $j); - open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!"); - @munged = <MUNGED>; - close(MUNGED); + my @munged = do { + open(my $fh, '<', $mf) or tests_exit(-1, "Failed to open $mf: $!"); + <$fh>; + }; - for ($i = 0; $i < @munged; $i++) + for (my $i = 0; $i < @munged; $i++) { if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/) { + my $j; for ($j = $i + 1; $j < @munged; $j++) { last if $munged[$j] !~ @@ -977,93 +1760,223 @@ if (-e $sf) } } - open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); - print MUNGED "**NOTE: The delivery lines in this file have been sorted.\n"; - for ($i = 0; $i < @munged; $i++) - { print MUNGED $munged[$i]; } - close(MUNGED); + open(my $fh, '>', $mf) or tests_exit(-1, "Failed to open $mf: $!"); + print $fh "**NOTE: The delivery lines in this file have been sorted.\n"; + print $fh @munged; } # Do the comparison - return 0 if (system("$cf $mf $sf >test-cf") == 0); + return 0 if (system("$cf '$mf' '$sf_current' >test-cf") == 0); # Handle comparison failure - print "** Comparison of $mf with $sf failed"; - system("$more test-cf"); + print "** Comparison of $mf with $sf_current failed"; + system @more => 'test-cf'; print "\n"; for (;;) { - interact("Continue, Update & retry, Quit? [Q] ", $force_update); - tests_exit(1) if /^q?$/i; - return 0 if /^c$/i; - last if (/^u$/i); + $_ = interact('Continue, Retry, Update current' + . ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : '') + . ' & retry, Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, $sf_current); + log_test($log_summary_filename, $testno, 'F') + } + return 1 if /^c$/i; + return 2 if /^r$/i; + last if (/^[us]$/i); } } # Update or delete the saved file, and give the appropriate return code. if (-s $mf) - { tests_exit(-1, "Failed to cp $mf $sf") if system("cp $mf $sf") != 0; } + { + my $sf = /^u/i ? $sf_current : $sf_flavour; + copy($mf, $sf) or tests_exit(-1, "Failed to copy $mf $sf"); + } else - { tests_exit(-1, "Failed to unlink $sf") if !unlink($sf); } + { + # if we deal with a flavour file, we can't delete it, because next time the generic + # file would be used again + if ($sf_current eq $sf_flavour) { + open(my $fh, '>', $sf_current); + } + else { + tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current); + } + } -return 1; +return 2; } +################################################## +# Custom munges +# keyed by name of munge; value is a ref to a hash +# which is keyed by file, value a string to look for. +# Usable files are: +# paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail +# Search strings starting with 's' do substitutions; +# with '/' do line-skips. +# Triggered by a scriptfile line "munge <name>" +################################################## +$munges = + { 'dnssec' => + { 'stderr' => '/^Reverse DNS security status: unverified\n/' }, + + 'gnutls_unexpected' => + { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./' }, + + 'gnutls_handshake' => + { 'mainlog' => 's/\(gnutls_handshake\): Error in the push function/\(gnutls_handshake\): A TLS packet with unexpected length was received/' }, + + 'gnutls_bad_clientcert' => + { 'mainlog' => 's/\(certificate verification failed\): certificate invalid/\(gnutls_handshake\): The peer did not send any certificate./', + 'stdout' => 's/Succeeded in starting TLS/A TLS fatal alert has been received.\nFailed to start TLS' + }, + + 'optional_events' => + { 'stdout' => '/event_action =/' }, + + 'optional_ocsp' => + { 'stderr' => '/127.0.0.1 in hosts_requ(ire|est)_ocsp/' }, + + 'optional_cert_hostnames' => + { 'stderr' => '/in tls_verify_cert_hostnames\? no/' }, + + 'loopback' => + { 'stdout' => 's/[[](127\.0\.0\.1|::1)]/[IP_LOOPBACK_ADDR]/' }, + + 'scanfile_size' => + { 'stdout' => 's/(Content-length:) \d\d\d/$1 ddd/' }, + + 'delay_1500' => + { 'stderr' => 's/(1[5-9]|23\d)\d\d msec/ssss msec/' }, + + 'tls_anycipher' => + { 'mainlog' => 's! X=TLS\S+ ! X=TLS_proto_and_cipher !; + s! DN="C=! DN="/C=!; + s! DN="[^,"]*\K,!/!; + s! DN="[^,"]*\K,!/!; + s! DN="[^,"]*\K,!/!; + ', + 'rejectlog' => 's/ X=TLS\S+ / X=TLS_proto_and_cipher /', + }, + + 'debug_pid' => + { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d+/ppppp/g' }, + + 'optional_dsn_info' => + { 'mail' => '/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/' + }, + + 'optional_config' => + { 'stdout' => '/^( + dkim_(canon|domain|private_key|selector|sign_headers|strict|hash|identity|timestamps) + |gnutls_require_(kx|mac|protocols) + |hosts_pipe_connect + |hosts_(requ(est|ire)|try)_(dane|ocsp) + |dane_require_tls_ciphers + |hosts_(avoid|nopass|noproxy|require|verify_avoid)_tls + |pipelining_connect_advertise_hosts + |socks_proxy + |tls_[^ ]* + |utf8_downconvert + )($|[ ]=)/x' + }, + + 'sys_bindir' => + { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' }, + + 'sync_check_data' => + { 'mainlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/', + 'rejectlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/'}, + + 'debuglog_stdout' => + { 'stdout' => 's/^\d\d:\d\d:\d\d\s+\d+ //; + s/Process \d+ is ready for new message/Process pppp is ready for new message/' + }, + + 'timeout_errno' => # actual errno differs Solaris vs. Linux + { 'mainlog' => 's/((?:host|message) deferral .* errno) <\d+> /$1 <EEE> /' }, + + 'peer_terminated_conn' => # actual error differs FreedBSD vs. Linux + { 'stderr' => 's/^( SMTP\()Connection reset by peer(\)<<)$/$1closed$2/' }, + + 'perl_variants' => # result of hash-in-scalar-context changed from bucket-fill to keycount + { 'stdout' => 's%^> X/X$%> X%' }, + }; + + +sub max { + my ($a, $b) = @_; + return $a if ($a > $b); + return $b; +} + ################################################## # Subroutine to check the output of a test # ################################################## # This function is called when the series of subtests is complete. It makes -# use of check() file, whose arguments are: +# use of check_file(), whose arguments are: # # [0] the name of the main raw output file # [1] the name of the server raw output file or undef # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted +# [5] an optional custom munge command # -# Arguments: none +# Arguments: Optionally, name of a single custom munge to run. # Returns: 0 if the output compared equal -# 1 if files were updated and the test must be re-run +# 1 if comparison failed; differences to be ignored +# 2 if re-run needed (files may have been updated) sub check_output{ +my($mungename) = $_[0]; my($yield) = 0; +my($munge) = $munges->{$mungename} if defined $mungename; -$yield = 1 if check_file("spool/log/paniclog", +$yield = max($yield, check_file("spool/log/paniclog", "spool/log/serverpaniclog", "test-paniclog-munged", - "paniclog/$testno", 0); + "paniclog/$testno", 0, + $munge->{paniclog})); -$yield = 1 if check_file("spool/log/rejectlog", +$yield = max($yield, check_file("spool/log/rejectlog", "spool/log/serverrejectlog", "test-rejectlog-munged", - "rejectlog/$testno", 0); + "rejectlog/$testno", 0, + $munge->{rejectlog})); -$yield = 1 if check_file("spool/log/mainlog", +$yield = max($yield, check_file("spool/log/mainlog", "spool/log/servermainlog", "test-mainlog-munged", - "log/$testno", $sortlog); + "log/$testno", $sortlog, + $munge->{mainlog})); if (!$stdout_skip) { - $yield = 1 if check_file("test-stdout", + $yield = max($yield, check_file("test-stdout", "test-stdout-server", "test-stdout-munged", - "stdout/$testno", 0); + "stdout/$testno", 0, + $munge->{stdout})); } if (!$stderr_skip) { - $yield = 1 if check_file("test-stderr", + $yield = max($yield, check_file("test-stderr", "test-stderr-server", "test-stderr-munged", - "stderr/$testno", 0); + "stderr/$testno", 0, + $munge->{stderr})); } # Compare any delivered messages, unless this test is skipped. @@ -1101,8 +2014,9 @@ if (! $message_skip) } print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug; - $yield = 1 if check_file($mail, undef, "test-mail-munged", - "mail/$testno.$saved_mail", 0); + $yield = max($yield, check_file($mail, undef, "test-mail-munged", + "mail/$testno.$saved_mail", 0, + $munge->{mail})); delete $expected_mails{"mail/$testno.$saved_mail"}; } @@ -1115,15 +2029,19 @@ if (! $message_skip) for (;;) { - interact("Continue, Update & retry, or Quit? [Q] ", $force_update); - tests_exit(1) if /^q?$/i; - last if /^c$/i; + $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, "missing email"); + log_test($log_summary_filename, $testno, 'F') + } + last if /^c$/; # For update, we not only have to unlink the file, but we must also # remove it from the @oldmails vector, as otherwise it will still be # checked for when we re-run the test. - if (/^u$/i) + if (/^u$/) { foreach $key (keys %expected_mails) { @@ -1171,8 +2089,9 @@ if (! $msglog_skip) ($munged_msglog = $msglog) =~ s/((?:[^\W_]{6}-){2}[^\W_]{2}) /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx; - $yield = 1 if check_file("spool/msglog/$msglog", undef, - "test-msglog-munged", "msglog/$testno.$munged_msglog", 0); + $yield = max($yield, check_file("spool/msglog/$msglog", undef, + "test-msglog-munged", "msglog/$testno.$munged_msglog", 0, + $munge->{msglog})); delete $expected_msglogs{"$testno.$munged_msglog"}; } } @@ -1197,10 +2116,14 @@ if (! $msglog_skip) for (;;) { - interact("Continue, Update, or Quit? [Q] ", $force_update); - tests_exit(1) if /^q?$/i; - last if /^c$/i; - if (/^u$/i) + $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, "missing msglog"); + log_test($log_summary_filename, $testno, 'F') + } + last if /^c$/; + if (/^u$/) { foreach $key (keys %expected_msglogs) { @@ -1236,7 +2159,7 @@ if ($debug) $prcmd =~ s/; /;\n>> /; print ">> $prcmd\n"; } -system("$cmd"); +system($cmd); } @@ -1248,7 +2171,7 @@ system("$cmd"); # The <SCRIPT> file is open for us to read an optional return code line, # followed by the command line and any following data lines for stdin. The # command line can be continued by the use of \. Data lines are not continued -# in this way. In all lines, the following substutions are made: +# in this way. In all lines, the following substitutions are made: # # DIR => the current directory # CALLER => the caller of this script @@ -1257,19 +2180,26 @@ system("$cmd"); # reference to the subtest number, holding previous value # reference to the expected return code value # reference to where to put the command name (for messages) +# auxiliary information returned from a previous run # -# Returns: 0 the commmand was executed inline, no subprocess was run +# Returns: 0 the command was executed inline, no subprocess was run # 1 a non-exim command was run and waited for # 2 an exim command was run and waited for # 3 a command was run and not waited for (daemon, server, exim_lock) # 4 EOF was encountered after an initial return code line +# Optionally also a second parameter, a hash-ref, with auxiliary information: +# exim_pid: pid of a run process +# munge: name of a post-script results munger sub run_command{ my($testno) = $_[0]; my($subtestref) = $_[1]; my($commandnameref) = $_[3]; +my($aux_info) = $_[4]; my($yield) = 1; +our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV; + if (/^(\d+)\s*$/) # Handle unusual return code { my($r) = $_[2]; @@ -1335,30 +2265,62 @@ if (/^dbmbuild\s+(\S+)\s+(\S+)/) if (/^dump\s+(\S+)/) { - my($which) = $1; - my(@temp); + my $which = $1; print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug; - open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |"); - @temp = <IN>; - close(IN); - if ($which eq "callout") + open(my $in, "-|", './eximdir/exim_dumpdb', "$parm_cwd/spool", $which) or die "Can't run exim_dumpdb: $!"; + open(my $out, ">>test-stdout"); + print $out "+++++++++++++++++++++++++++\n"; + + if ($which eq "retry") { - @temp = sort { - my($aa) = substr $a, 21; - my($bb) = substr $b, 21; - return $aa cmp $bb; - } @temp; + # the sort key is the first part of the retry db dump line, but for + # sorting we (temporarly) replace the own hosts ipv4 with a munged + # version, which matches the munging that is done later + # Why? We must ensure sure, that 127.0.0.1 always sorts first + # map-sort-map: Schwartz's transformation + # test 0099 + my @temp = map { $_->[1] } + sort { $a->[0] cmp $b->[0] } + #map { [ (split)[0] =~ s/\Q$parm_ipv4/ip4.ip4.ip4.ip4/gr, $_ ] } # this is too modern for 5.10.1 + map { + (my $k = (split)[0]) =~ s/\Q$parm_ipv4/ip4.ip4.ip4.ip4/g; + [ $k, $_ ] + } + do { local $/ = "\n "; <$in> }; + foreach $item (@temp) + { + $item =~ s/^\s*(.*)\n(.*)\n?\s*$/$1\n$2/m; + print $out " $item\n"; + } } - open(OUT, ">>test-stdout"); - print OUT "+++++++++++++++++++++++++++\n"; - print OUT @temp; - close(OUT); + else + { + my @temp = <$in>; + if ($which eq "callout") + { + @temp = sort { + my($aa) = substr $a, 21; + my($bb) = substr $b, 21; + return $aa cmp $bb; + } @temp; + } + print $out @temp; + } + close($in); # close it explicitly, otherwise $? does not get set return 1; } -# The "echo" command is a way of writing comments to the screen. +# verbose comments start with ### +if (/^###\s/) { + for my $file (qw(test-stdout test-stderr test-stderr-server test-stdout-server)) { + open my $fh, '>>', $file or die "Can't open >>$file: $!\n"; + say {$fh} $_; + } + return 0; +} +# The "echo" command is a way of writing comments to the screen. if (/^echo\s+(.*)$/) { print "$1\n"; @@ -1378,7 +2340,7 @@ if (/^exim_lock\s+(.*)$/) # This gives the process time to get started; otherwise the next # process may not find it there when it expects it. - select(undef, undef, undef, 0.01); + select(undef, undef, undef, 0.1); return 3; } @@ -1396,29 +2358,69 @@ if (/^exinext\s+(.*)/) } +# The "exigrep" command runs exigrep on the current mainlog + +if (/^exigrep\s+(.*)/) + { + run_system("(./eximdir/exigrep " . + "$1 $parm_cwd/spool/log/mainlog;" . + "echo exigrep exit code = \$?)" . + ">>test-stdout"); + return 1; + } + + +# The "eximstats" command runs eximstats on the current mainlog + +if (/^eximstats\s+(.*)/) + { + run_system("(./eximdir/eximstats " . + "$1 $parm_cwd/spool/log/mainlog;" . + "echo eximstats exit code = \$?)" . + ">>test-stdout"); + return 1; + } + + # The "gnutls" command makes a copy of saved GnuTLS parameter data in the # spool directory, to save Exim from re-creating it each time. if (/^gnutls/) { - run_system "sudo cp -p aux-fixed/gnutls-params spool/gnutls-params;" . - "sudo chown $parm_eximuser:$parm_eximgroup spool/gnutls-params;" . - "sudo chmod 0400 spool/gnutls-params"; + my $gen_fn = "spool/gnutls-params-$gnutls_dh_bits_normal"; + run_system "sudo cp -p aux-fixed/gnutls-params $gen_fn;" . + "sudo chown $parm_eximuser:$parm_eximgroup $gen_fn;" . + "sudo chmod 0400 $gen_fn"; return 1; } # The "killdaemon" command should ultimately follow the starting of any Exim -# daemon with the -bd option. We kill with SIGINT rather than SIGTERM to stop -# it outputting "Terminated" to the terminal when not in the background. +# daemon with the -bd option. if (/^killdaemon/) { - $pid = `cat $parm_cwd/spool/exim-daemon.*`; - run_system("sudo /bin/kill -SIGINT $pid"); - close DAEMONCMD; # Waits for process - run_system("sudo /bin/rm -f spool/exim-daemon.*"); - return 1; + my $return_extra = {}; + if (exists $aux_info->{exim_pid}) + { + $pid = $aux_info->{exim_pid}; + $return_extra->{exim_pid} = undef; + print ">> killdaemon: recovered pid $pid\n" if $debug; + if ($pid) + { + run_system("sudo /bin/kill -TERM $pid"); + wait; + } + } else { + $pid = `cat $parm_cwd/spool/exim-daemon.*`; + if ($pid) + { + run_system("sudo /bin/kill -TERM $pid"); + close DAEMONCMD; # Waits for process + } + } + run_system("sudo /bin/rm -f spool/exim-daemon.*"); + return (1, $return_extra); } @@ -1433,6 +2435,18 @@ elsif (/^millisleep\s+(.*)$/) } +# The "munge" command selects one of a hardwired set of test-result modifications +# to be made before result compares are run against the golden set. This lets +# us account for test-system dependent things which only affect a few, but known, +# test-cases. +# Currently only the last munge takes effect. + +if (/^munge\s+(.*)$/) + { + return (0, { munge => $1 }); + } + + # The "sleep" command does just that. For sleeps longer than 1 second we # tell the user what's going on. @@ -1458,8 +2472,8 @@ if (/^sleep\s+(.*)$/) # Various Unix management commands are recognized -if (/^(ln|ls|du|mkdir|mkfifo|touch|cp)\s/ || - /^sudo (rmdir|rm|chown|chmod)\s/) +if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ || + /^sudo\s(rmdir|rm|mv|chown|chmod)\s/) { run_system("$_ >>test-stdout 2>>test-stderr"); return 1; @@ -1480,10 +2494,12 @@ if (/^(ln|ls|du|mkdir|mkfifo|touch|cp)\s/ || # command, triggered by $server_pid being non-zero. The server sends its output # to a different file. The variable $server_opts, if not empty, contains # options to disable IPv4 or IPv6 if necessary. +# This works because "server" swallows its stdin before waiting for a connection. if (/^server\s+(.*)$/) { - $cmd = "./bin/server $server_opts $1 >>test-stdout-server"; + $pidfile = "$parm_cwd/aux-var/server-daemon.pid"; + $cmd = "./bin/server $server_opts -oP $pidfile $1 >>test-stdout-server"; print ">> $cmd\n" if ($debug); $server_pid = open SERVERCMD, "|$cmd" || tests_exit(-1, "Failed to run $cmd"); SERVERCMD->autoflush(1); @@ -1497,10 +2513,9 @@ if (/^server\s+(.*)$/) print SERVERCMD "++++\n"; # Send end to server; can't send EOF yet # because close() waits for the process. - # This gives the server time to get started; otherwise the next + # Interlock the server startup; otherwise the next # process may not find it there when it expects it. - - select(undef, undef, undef, 0.01); + while (! stat("$pidfile") ) { select(undef, undef, undef, 0.3); } return 3; } @@ -1541,7 +2556,7 @@ if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/) while (scalar @sizes > 0) { ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/; - $leadin = "" if !defined $leadin; + $leadin = '' if !defined $leadin; $leadin =~ s/_/ /g; $len -= length($leadin) + 1; while ($count-- > 0) @@ -1580,12 +2595,12 @@ if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/) # command in the variable $cmd. Shared code to run this command and handle its # input and output follows. -# The "client" and "client-ssl" commands run a script-driven program that plays -# the part of an email client. We also have the availability of running Perl -# for doing one-off special things. Note that all these commands expect stdin -# data to be supplied. +# The "client", "client-gnutls", and "client-ssl" commands run a script-driven +# program that plays the part of an email client. We also have the availability +# of running Perl for doing one-off special things. Note that all these +# commands expect stdin data to be supplied. -if (/^client/ || /^client-ssl/ || /^(sudo\s+)?perl\b/) +if (/^client/ || /^(sudo\s+)?perl\b/) { s"client"./bin/client"; $cmd = "$_ >>test-stdout 2>>test-stderr"; @@ -1597,12 +2612,12 @@ if (/^client/ || /^client-ssl/ || /^(sudo\s+)?perl\b/) # not drop privilege when -C and -D options are present. To run the exim # command as root, we use sudo. -elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) +elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/) { - $args = $5; - my($envset) = (defined $1)? $1 : ""; - my($sudo) = (defined $3)? "sudo " : ""; - my($special)= (defined $4)? $4 : ""; + $args = $6; + my($envset) = (defined $1)? $1 : ''; + my($sudo) = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":'') : ''; + my($special)= (defined $5)? $5 : ''; $wait_time = (defined $2)? $2 : 0; # Return 2 rather than 1 afterwards @@ -1633,31 +2648,58 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) if ($args =~ /\$msg/) { - my($listcmd) = "$parm_cwd/eximdir/exim -bp " . - "-DEXIM_PATH=$parm_cwd/eximdir/exim " . - "-C $parm_cwd/test-config |"; - print ">> Getting queue list from:\n>> $listcmd\n" if ($debug); - open (QLIST, $listcmd) || tests_exit(-1, "Couldn't run \"exim -bp\": $!\n"); - my(@msglist) = (); - while (<QLIST>) { push (@msglist, $1) if /^\s*\d+[smhdw]\s+\S+\s+(\S+)/; } - close(QLIST); + my($queuespec); + if ($args =~ /-qG\w+/) { $queuespec = $&; } - # Done backwards just in case there are more than 9 + my @listcmd; - my($i); - for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; } - } + if (defined $queuespec) + { + @listcmd = ("$parm_cwd/eximdir/exim", '-bp', + $queuespec, + "-DEXIM_PATH=$parm_cwd/eximdir/exim", + -C => "$parm_cwd/test-config"); + } + else + { + @listcmd = ("$parm_cwd/eximdir/exim", '-bp', + "-DEXIM_PATH=$parm_cwd/eximdir/exim", + -C => "$parm_cwd/test-config"); + } + print ">> Getting queue list from:\n>> @listcmd\n" if $debug; + # We need the message ids sorted in ascending order. + # Message id is: <timestamp>-<pid>-<fractional-time>. On some systems (*BSD) the + # PIDs are randomized, so sorting just the whole PID doesn't work. + # We do the Schartz' transformation here (sort on + # <timestamp><fractional-time>). Thanks to Kirill Miazine + my @msglist = + map { $_->[1] } # extract the values + sort { $a->[0] cmp $b->[0] } # sort by key + map { [join('.' => (split /-/, $_)[0,2]) => $_] } # key (timestamp.fractional-time) => value(message_id) + map { /^\s*\d+[smhdw]\s+\S+\s+(\S+)/ } `@listcmd` or tests_exit(-1, "No output from `exim -bp` (@listcmd)\n"); - # If -d is specified in $optargs, remove it from $args; i.e. let + # Done backwards just in case there are more than 9 + + for (my $i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; } + if ( $args =~ /\$msg\d/ ) + { + tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n") + unless $force_continue; + } + } + + # If -d is specified in $optargs, remove it from $args; i.e. let # the command line for runtest override. Then run Exim. $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/; - $cmd = "$envset$sudo$parm_cwd/eximdir/exim$special$optargs " . + my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : ''; + + $cmd = "$envset$sudo$opt_valgrind" . + "$parm_cwd/eximdir/exim$special$optargs " . "-DEXIM_PATH=$parm_cwd/eximdir/exim$special " . "-C $parm_cwd/test-config $args " . ">>test-stdout 2>>test-stderr"; - # If the command is starting an Exim daemon, we run it in the same # way as the "server" command above, that is, we don't want to wait # for the process to finish. That happens when "killdaemon" is obeyed later @@ -1677,18 +2719,97 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) # Before running the command, convert the -bd option into -bdf so that an # Exim daemon doesn't double fork. This means that when we wait close - # DAEMONCMD, it waits for the correct process. + # DAEMONCMD, it waits for the correct process. Also, ensure that the pid + # file is written to the spool directory, in case the Exim binary was + # built with PID_FILE_PATH pointing somewhere else. - $cmd =~ s/\s-bd\s/ -bdf /; + if ($cmd =~ /\s-oP\s/) + { + ($pidfile = $cmd) =~ s/^.*-oP ([^ ]+).*$/$1/; + $cmd =~ s!\s-bd\s! -bdf !; + } + else + { + $pidfile = "$parm_cwd/spool/exim-daemon.pid"; + $cmd =~ s!\s-bd\s! -bdf -oP $pidfile !; + } print ">> |${cmd}-server\n" if ($debug); open DAEMONCMD, "|${cmd}-server" || tests_exit(-1, "Failed to run $cmd"); DAEMONCMD->autoflush(1); while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input - select(undef, undef, undef, 0.3); # Let the daemon get going + + # Interlock with daemon startup + for (my $count = 0; ! stat("$pidfile") && $count < 30; $count++ ) + { select(undef, undef, undef, 0.3); } return 3; # Don't wait } + elsif ($cmd =~ /\s-DSERVER=wait:(\d+)\s/) + { + + # The port and the $dynamic_socket was already allocated while parsing the + # script file, where -DSERVER=wait:PORT_DYNAMIC was encountered. + + my $listen_port = $1; + if ($debug) { printf ">> wait-mode daemon: $cmd\n"; } + run_system("sudo mkdir spool/log 2>/dev/null"); + run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); + + my $pid = fork(); + if (not defined $pid) { die "** fork failed: $!\n" } + if (not $pid) { + close(STDIN); + open(STDIN, '<&', $dynamic_socket) or die "** dup sock to stdin failed: $!\n"; + close($dynamic_socket); + print "[$$]>> ${cmd}-server\n" if ($debug); + exec "exec ${cmd}-server"; + die "Can't exec ${cmd}-server: $!\n"; + } + while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input + select(undef, undef, undef, 0.3); # Let the daemon get going + return (3, { exim_pid => $pid }); # Don't wait + } } +# The "background" command is run but not waited-for, like exim -DSERVER=server. +# One script line is read and fork-exec'd. The PID is stored for a later +# killdaemon. + +elsif (/^background$/) + { + my $line; +# $pidfile = "$parm_cwd/aux-var/server-daemon.pid"; + + $_ = <SCRIPT>; $lineno++; + chomp; + do_substitute($testno); + $line = $_; + if ($debug) { printf ">> daemon: $line >>test-stdout 2>>test-stderr\n"; } + + my $pid = fork(); + if (not defined $pid) { die "** fork failed: $!\n" } + if (not $pid) { + print "[$$]>> ${line}\n" if ($debug); + close(STDIN); + open(STDIN, "<", "test-stdout"); + close(STDOUT); + open(STDOUT, ">>", "test-stdout"); + close(STDERR); + open(STDERR, ">>", "test-stderr-server"); + exec "exec ${line}"; + exit(1); + } + +# open(my $fh, ">", $pidfile) || +# tests_exit(-1, "Failed to open $pidfile: $!"); +# printf($fh, "%d\n", $pid); +# close($fh); + + while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; } # Ignore any input + select(undef, undef, undef, 0.3); # Let the daemon get going + return (3, { exim_pid => $pid }); # Don't wait + } + + # Unknown command @@ -1696,22 +2817,40 @@ else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); } # Run the command, with stdin connected to a pipe, and write the stdin data -# to it, with appropriate substitutions. If a line ends with \NONL\, chop off -# the terminating newline (and the \NONL\). If the command contains +# to it, with appropriate substitutions. If a starts with '>>> ', process it +# via Perl's string eval(). +# If the command contains # -DSERVER=server add "-server" to the command, where it will adjoin the name # for the stderr file. See comment above about the use of -DSERVER. -$stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : ""; +$stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : ''; print ">> |${cmd}${stderrsuffix}\n" if ($debug); open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd"); CMD->autoflush(1); -while (<SCRIPT>) +LINE: while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; do_substitute($testno); - if (/^(.*)\\NONL\\\s*$/) { print CMD $1; } else { print CMD; } + if (my ($cmd, $line) = /^(:\S+?:)(.*)/) { + $_ = $line; + { + $cmd eq ':eval:' and do { + $_ = eval "\"$_\""; + last; + }; + $cmd eq ':noeol:' and do { + s/[\r\n]*$//; + last; + }; + $cmd eq ':sleep:' and do { + sleep $_; + next LINE; + }; + } + } + print CMD; } # For timeout tests, wait before closing the pipe; we expect a @@ -1739,7 +2878,7 @@ return $yield; # Ran command and waited ############################################################################### ############################################################################### -# Here beginneth the Main Program ... +# Here begins the Main Program ... ############################################################################### ############################################################################### @@ -1748,28 +2887,28 @@ return $yield; # Ran command and waited autoflush STDOUT 1; print "Exim tester $testversion\n"; +# extend the PATH with .../sbin +# we map all (.../bin) to (.../sbin:.../bin) +$ENV{PATH} = do { + my %seen = map { $_, 1 } split /:/, $ENV{PATH}; + join ':' => map { m{(.*)/bin$} + ? ( $seen{"$1/sbin"} ? () : ("$1/sbin"), $_) + : ($_) } + split /:/, $ENV{PATH}; +}; ################################################## -# Check for the "less" command # +# Some tests check created file modes # ################################################## -$more = "more" if system("which less >/dev/null 2>&1") != 0; - +umask 022; ################################################## -# Check for sudo access to root # +# Check for the "less" command # ################################################## -print "You need to have sudo access to root to run these tests. Checking ...\n"; -if (system("sudo date >/dev/null") != 0) - { - die "** Test for sudo failed: testing abandoned.\n"; - } -else - { - print "Test for sudo OK\n"; - } +@more = 'more' if system('which less >/dev/null 2>&1') != 0; @@ -1778,11 +2917,8 @@ else ################################################## # If the first character of the first argument is '/', the argument is taken -# as the path to the binary. - -$parm_exim = (@ARGV > 0 && $ARGV[0] =~ ?^/?)? shift @ARGV : ""; -print "Exim binary is $parm_exim\n" if $parm_exim ne ""; - +# as the path to the binary. If the first argument does not start with a +# '/' but exists in the file system, it's assumed to be the Exim binary. ################################################## @@ -1793,31 +2929,59 @@ print "Exim binary is $parm_exim\n" if $parm_exim ne ""; # options are passed on to Exim calls within the tests. Typically, this is used # to turn on Exim debugging while setting up a test. -while (@ARGV > 0 && $ARGV[0] =~ /^-/) - { - my($arg) = shift @ARGV; - if ($optargs eq "") - { - if ($arg eq "-DEBUG") { $debug = 1; $cr = "\n"; next; } - if ($arg eq "-DIFF") { $cf = "diff -u"; next; } - if ($arg eq "-UPDATE") { $force_update = 1; next; } - if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; } - if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; } - if ($arg eq "-KEEP") { $save_output = 1; next; } - } - $optargs .= " $arg"; - } +Getopt::Long::Configure qw(no_getopt_compat); +GetOptions( + 'debug' => sub { $debug = 1; $cr = "\n" }, + 'diff' => sub { $cf = 'diff -u' }, + 'continue' => sub { $force_continue = 1; @more = 'cat' }, + 'update' => \$force_update, + 'ipv4!' => \$have_ipv4, + 'ipv6!' => \$have_ipv6, + 'keep' => \$save_output, + 'slow' => \$slow, + 'valgrind' => \$valgrind, + 'range=s{2}' => \my @range_wanted, + 'test=i@' => \my @tests_wanted, + 'fail-any!' => \my $fail_any, + 'flavor|flavour=s' => \$flavour, + 'help' => sub { pod2usage(-exit => 0) }, + 'man' => sub { + pod2usage( + -exit => 0, + -verbose => 2, + -noperldoc => system('perldoc -V 2>/dev/null 1>&2') + ); + }, +) or pod2usage; + +($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV); +print "Exim binary is `$parm_exim'\n" if defined $parm_exim; + + +my @wanted = sort numerically uniq + @tests_wanted ? @tests_wanted : (), + @range_wanted ? $range_wanted[0] .. $range_wanted[1] : (), + @ARGV ? @ARGV == 1 ? $ARGV[0] : + $ARGV[1] eq '+' ? $ARGV[0]..($ARGV[0] >= 9000 ? TEST_SPECIAL_TOP : TEST_TOP) : + 0+$ARGV[0]..0+$ARGV[1] # add 0 to cope with test numbers starting with zero + : (); +@wanted = 1..TEST_TOP if not @wanted; -# Any subsequent arguments are a range of test numbers. +################################################## +# Check for sudo access to root # +################################################## -if (@ARGV > 0) +print "You need to have sudo access to root to run these tests. Checking ...\n"; +if (system('sudo true >/dev/null') != 0) { - $test_end = $test_start = $ARGV[0]; - $test_end = $ARGV[1] if (@ARGV > 1); - $test_end = ($test_start >= 9000)? $test_special_top : $test_top - if $test_end eq "+"; - die "** Test numbers out of order\n" if ($test_end < $test_start); + die "** Test for sudo failed: testing abandoned.\n"; } +else + { + print "Test for sudo OK\n"; + } + + ################################################## @@ -1842,58 +3006,9 @@ $parm_cwd = Cwd::getcwd(); # takes precedence; otherwise exim-snapshot takes precedence over any numbered # releases. -if ($parm_exim eq "") - { - my($use_srcdir) = ""; - - opendir DIR, ".." || die "** Failed to opendir \"..\": $!\n"; - while ($f = readdir(DIR)) - { - my($srcdir); - - # Try this directory if it is "exim4" or if it is exim-snapshot or exim-n.m - # possibly followed by -RCx where n.m is greater than any previously tried - # directory. Thus, we should choose the highest version of Exim that has - # been compiled. - - if ($f eq "exim4" || $f eq "exim-snapshot") - { $srcdir = $f; } - else - { $srcdir = $f - if ($f =~ /^exim-\d+\.\d+(-RC\d+)?$/ && $f gt $use_srcdir); } - - # Look for a build directory with a binary in it. If we find a binary, - # accept this source directory. - - if ($srcdir) - { - opendir SRCDIR, "../$srcdir" || - die "** Failed to opendir \"$cwd/../$srcdir\": $!\n"; - while ($f = readdir(SRCDIR)) - { - if ($f =~ /^build-/ && -e "../$srcdir/$f/exim") - { - $use_srcdir = $srcdir; - $parm_exim = "$cwd/../$srcdir/$f/exim"; - $parm_exim =~ s'/[^/]+/\.\./'/'; - last; - } - } - closedir(SRCDIR); - } - - # If we have found "exim4" or "exim-snapshot", that takes precedence. - # Otherwise, continue to see if there's a later version. - - last if $use_srcdir eq "exim4" || $use_srcdir eq "exim-snapshot"; - } - closedir(DIR); - print "Exim binary found in $parm_exim\n" if $parm_exim ne ""; - } - # If $parm_exim is still empty, ask the caller -if ($parm_exim eq "") +if (not $parm_exim) { print "** Did not find an Exim binary to test\n"; for ($i = 0; $i < 5; $i++) @@ -1911,7 +3026,7 @@ if ($parm_exim eq "") print "** $trybin does not exist\n"; } } - die "** Too many tries\n" if $parm_exim eq ""; + die "** Too many tries\n" if $parm_exim eq ''; } @@ -1920,21 +3035,63 @@ if ($parm_exim eq "") # Find what is in the binary # ################################################## -open(EXIMINFO, "$parm_exim -C confs/0000 -DDIR=$parm_cwd " . - "-bP exim_user exim_group|") || - die "** Cannot run $parm_exim: $!\n"; -while(<EXIMINFO>) +# deal with TRUSTED_CONFIG_LIST restrictions +unlink("$parm_cwd/test-config") if -e "$parm_cwd/test-config"; +open (IN, "$parm_cwd/confs/0000") || + tests_exit(-1, "Couldn't open $parm_cwd/confs/0000: $!\n"); +open (OUT, ">test-config") || + tests_exit(-1, "Couldn't open test-config: $!\n"); +while (<IN>) { print OUT; } +close(IN); +close(OUT); + +print("Probing with config file: $parm_cwd/test-config\n"); + +my $eximinfo = "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd -bP exim_user exim_group"; +chomp(my @eximinfo = `$eximinfo 2>&1`); +die "$0: Can't run $eximinfo\n" if $? == -1; + +warn 'Got ' . ($?>>8) . " from $eximinfo\n" if $?; +foreach (@eximinfo) { + if (my ($version) = /^Exim version (\S+)/) { + my $git = `git describe --dirty=-XX --match 'exim-4*'`; + if (defined $git and $? == 0) { + chomp $git; + $git =~ s/^exim-//i; + $git =~ s/.*-\Kg([[:xdigit:]]+(?:-XX)?)/$1/; + print <<___ + +*** Version mismatch +*** Exim binary: $version +*** Git : $git + +___ + if not $version eq $git; + } + } $parm_eximuser = $1 if /^exim_user = (.*)$/; $parm_eximgroup = $1 if /^exim_group = (.*)$/; + $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/; + ($parm_configure_owner, $parm_configure_group) = ($1, $2) + if /^Configure owner:\s*(\d+):(\d+)/; + print if /wrong owner/; } -close(EXIMINFO); -if (defined $parm_eximuser) - { - if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; } - else { $parm_exim_uid = getpwnam($parm_eximuser); } - } +if (not defined $parm_eximuser) { + die <<XXX, map { "|$_\n" } @eximinfo; +Unable to extract exim_user from binary. +Check if Exim refused to run; if so, consider: + TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS +If debug permission denied, are you in the exim group? +Failing to get information from binary. +Output from $eximinfo: +XXX + +} + +if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; } +else { $parm_exim_uid = getpwnam($parm_eximuser); } if (defined $parm_eximgroup) { @@ -1942,7 +3099,46 @@ if (defined $parm_eximgroup) else { $parm_exim_gid = getgrnam($parm_eximgroup); } } -open(EXIMINFO, "$parm_exim -bV -C confs/0000 -DDIR=$parm_cwd |") || +# check the permissions on the TRUSTED_CONFIG_LIST +if (defined $parm_trusted_config_list) + { + die "TRUSTED_CONFIG_LIST: $parm_trusted_config_list: $!\n" + if not -f $parm_trusted_config_list; + + die "TRUSTED_CONFIG_LIST $parm_trusted_config_list must not be world writable!\n" + if 02 & (stat _)[2]; + + die sprintf "TRUSTED_CONFIG_LIST: $parm_trusted_config_list %d is group writable, but not owned by group '%s' or '%s'.\n", + (stat _)[1], + scalar(getgrgid 0), scalar(getgrgid $>) + if (020 & (stat _)[2]) and not ((stat _)[5] == $> or (stat _)[5] == 0); + + die sprintf "TRUSTED_CONFIG_LIST: $parm_trusted_config_list is not owned by user '%s' or '%s'.\n", + scalar(getpwuid 0), scalar(getpwuid $>) + if (not (-o _ or (stat _)[4] == 0)); + + open(TCL, $parm_trusted_config_list) or die "Can't open $parm_trusted_config_list: $!\n"; + my $test_config = getcwd() . '/test-config'; + die "Can't find '$test_config' in TRUSTED_CONFIG_LIST $parm_trusted_config_list." + if not grep { /^\Q$test_config\E$/ } <TCL>; + } +else + { + die "Unable to check the TRUSTED_CONFIG_LIST, seems to be empty?\n"; + } + +die "CONFIGURE_OWNER ($parm_configure_owner) does not match the user invoking $0 ($>)\n" + if $parm_configure_owner != $>; + +die "CONFIGURE_GROUP ($parm_configure_group) does not match the group invoking $0 ($))\n" + if 0020 & (stat "$parm_cwd/test-config")[2] + and $parm_configure_group != $); + +die "aux-fixed file is group-writeable; best to strip them all, recursively\n" + if 0020 & (stat "aux-fixed/0037.f-1")[2]; + + +open(EXIMINFO, "$parm_exim -d-all+transport -bV -C $parm_cwd/test-config -DDIR=$parm_cwd |") || die "** Cannot run $parm_exim: $!\n"; print "-" x 78, "\n"; @@ -1951,9 +3147,18 @@ while (<EXIMINFO>) { my(@temp); - if (/^Exim version/) { print; next; } + if (/^(Exim|Library) version/) { print; } + if (/Runtime: /) {print; } + + elsif (/^Size of off_t: (\d+)/) + { + print; + $have_largefiles = 1 if $1 > 4; + die "** Size of off_t > 32 which seems improbable, not running tests\n" + if ($1 > 32); + } - if (/^Support for: (.*)/) + elsif (/^Support for: (.*)/) { print; @temp = split /(\s+)/, $1; @@ -1961,7 +3166,7 @@ while (<EXIMINFO>) %parm_support = @temp; } - if (/^Lookups: (.*)/) + elsif (/^Lookups \(built-in\): (.*)/) { print; @temp = split /(\s+)/, $1; @@ -1969,7 +3174,7 @@ while (<EXIMINFO>) %parm_lookups = @temp; } - if (/^Authenticators: (.*)/) + elsif (/^Authenticators: (.*)/) { print; @temp = split /(\s+)/, $1; @@ -1977,7 +3182,7 @@ while (<EXIMINFO>) %parm_authenticators = @temp; } - if (/^Routers: (.*)/) + elsif (/^Routers: (.*)/) { print; @temp = split /(\s+)/, $1; @@ -1989,7 +3194,7 @@ while (<EXIMINFO>) # that the basic transport name is set, and then the name with each of the # options. - if (/^Transports: (.*)/) + elsif (/^Transports: (.*)/) { print; @temp = split /(\s+)/, $1; @@ -2001,16 +3206,26 @@ while (<EXIMINFO>) if ($k =~ "/") { @temp = split /\//, $k; - $parm_transports{"$temp[0]"} = " "; + $parm_transports{$temp[0]} = " "; for ($i = 1; $i < @temp; $i++) { $parm_transports{"$temp[0]/$temp[$i]"} = " "; } } } } + + elsif (/^Malware: (.*)/) + { + print; + @temp = split /(\s+)/, $1; + push(@temp, ' '); + %parm_malware = @temp; + } + } close(EXIMINFO); print "-" x 78, "\n"; +unlink("$parm_cwd/test-config"); ################################################## # Check for SpamAssassin and ClamAV # @@ -2019,17 +3234,18 @@ print "-" x 78, "\n"; # These are crude tests. If they aren't good enough, we'll have to improve # them, for example by actually passing a message through spamc or clamscan. -if (defined $parm_support{'Content_Scanning'}) +if (defined $parm_support{Content_Scanning}) { + my $sock = new FileHandle; + if (system("spamc -h 2>/dev/null >/dev/null") == 0) { - $parm_running{'SpamAssassin'} = ' '; print "The spamc command works:\n"; # This test for an active SpamAssassin is courtesy of John Jetmore. # The tests are hard coded to localhost:783, so no point in making # this test flexible like the clamav test until the test scripts are - # changed. spamd doesn't have the nice PING/PONG protoccol that + # changed. spamd doesn't have the nice PING/PONG protocol that # clamd does, but it does respond to errors in an informative manner, # so use that. @@ -2038,23 +3254,23 @@ if (defined $parm_support{'Content_Scanning'}) { my $sin = sockaddr_in($sport, inet_aton($sint)) or die "** Failed packing $sint:$sport\n"; - socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) + socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) or die "** Unable to open socket $sint:$sport\n"; local $SIG{ALRM} = sub { die "** Timeout while connecting to socket $sint:$sport\n"; }; alarm(5); - connect(SOCK, $sin) + connect($sock, $sin) or die "** Unable to connect to socket $sint:$sport\n"; alarm(0); - select((select(SOCK), $| = 1)[0]); - print SOCK "bad command\r\n"; + select((select($sock), $| = 1)[0]); + print $sock "bad command\r\n"; $SIG{ALRM} = sub { die "** Timeout while reading from socket $sint:$sport\n"; }; alarm(10); - my $res = <SOCK>; + my $res = <$sock>; alarm(0); $res =~ m|^SPAMD/| @@ -2069,7 +3285,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'SpamAssassin'} = ' '; + $parm_running{SpamAssassin} = ' '; print " SpamAssassin (spamd) seems to be running\n"; } } @@ -2088,11 +3304,11 @@ if (defined $parm_support{'Content_Scanning'}) print "The clamscan command works"; $test_prefix = $ENV{EXIM_TEST_PREFIX}; - $test_prefix = "" if !defined $test_prefix; + $test_prefix = '' if !defined $test_prefix; foreach $f ("$test_prefix/etc/clamd.conf", "$test_prefix/usr/local/etc/clamd.conf", - "$test_prefix/etc/clamav/clamd.conf", "") + "$test_prefix/etc/clamav/clamd.conf", '') { if (-e $f) { @@ -2101,38 +3317,82 @@ if (defined $parm_support{'Content_Scanning'}) } } - if ($clamconf ne "") + # Read the ClamAV configuration file and find the socket interface. + + if ($clamconf ne '') { + my $socket_domain; open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n"; while (<IN>) { if (/^LocalSocket\s+(.*)/) { $parm_clamsocket = $1; + $socket_domain = AF_UNIX; last; } + if (/^TCPSocket\s+(\d+)/) + { + if (defined $parm_clamsocket) + { + $parm_clamsocket .= " $1"; + $socket_domain = AF_INET; + last; + } + else + { + $parm_clamsocket = " $1"; + } + } + elsif (/^TCPAddr\s+(\S+)/) + { + if (defined $parm_clamsocket) + { + $parm_clamsocket = $1 . $parm_clamsocket; + $socket_domain = AF_INET; + last; + } + else + { + $parm_clamsocket = $1; + } + } } close(IN); - if (-e $parm_clamsocket) + + if (defined $socket_domain) { print ":\n The clamd socket is $parm_clamsocket\n"; # This test for an active ClamAV is courtesy of Daniel Tiefnig. eval { - my $sun = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n"; - socket(SOCK, AF_UNIX, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n"; - + my $socket; + if ($socket_domain == AF_UNIX) + { + $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n"; + } + elsif ($socket_domain == AF_INET) + { + my ($ca_host, $ca_port) = split(/\s+/,$parm_clamsocket); + my $ca_hostent = gethostbyname($ca_host) or die "** Failed to get raw address for host '$ca_host'\n"; + $socket = sockaddr_in($ca_port, $ca_hostent) or die "** Failed packing '$parm_clamsocket'\n"; + } + else + { + die "** Unknown socket domain '$socket_domain' (should not happen)\n"; + } + socket($sock, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n"; local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; }; alarm(5); - connect(SOCK, $sun) or die "** Unable to connect to socket '$parm_clamsocket'\n"; + connect($sock, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n"; alarm(0); - my $ofh = select SOCK; $| = 1; select $ofh; - print SOCK "PING\n"; + my $ofh = select $sock; $| = 1; select $ofh; + print $sock "PING\n"; $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; }; alarm(10); - my $res = <SOCK>; + my $res = <$sock>; alarm(0); $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n"; @@ -2141,18 +3401,18 @@ if (defined $parm_support{'Content_Scanning'}) if($@) { - warn $@; + print " $@"; print " Assume ClamAV is not running\n"; } else { - $parm_running{'ClamAV'} = ' '; + $parm_running{ClamAV} = ' '; print " ClamAV seems to be running\n"; } } else { - print ", but the socket for clamd does not exist\n"; + print ", but the socket for clamd could not be determined\n"; print "Assume ClamAV is not running\n"; } } @@ -2166,6 +3426,22 @@ if (defined $parm_support{'Content_Scanning'}) } +################################################## +# Check for redis # +################################################## +if (defined $parm_lookups{redis}) + { + if (system("redis-server -v 2>/dev/null >/dev/null") == 0) + { + print "The redis-server command works\n"; + $parm_running{redis} = ' '; + } + else + { + print "The redis-server command failed: assume Redis not installed\n"; + } + } + ################################################## # Test for the basic requirements # ################################################## @@ -2173,21 +3449,21 @@ if (defined $parm_support{'Content_Scanning'}) # This test suite assumes that Exim has been built with at least the "usual" # set of routers, transports, and lookups. Ensure that this is so. -$missing = ""; +$missing = ''; -$missing .= " Lookup: lsearch\n" if (!defined $parm_lookups{'lsearch'}); +$missing .= " Lookup: lsearch\n" if (!defined $parm_lookups{lsearch}); -$missing .= " Router: accept\n" if (!defined $parm_routers{'accept'}); -$missing .= " Router: dnslookup\n" if (!defined $parm_routers{'dnslookup'}); -$missing .= " Router: manualroute\n" if (!defined $parm_routers{'manualroute'}); -$missing .= " Router: redirect\n" if (!defined $parm_routers{'redirect'}); +$missing .= " Router: accept\n" if (!defined $parm_routers{accept}); +$missing .= " Router: dnslookup\n" if (!defined $parm_routers{dnslookup}); +$missing .= " Router: manualroute\n" if (!defined $parm_routers{manualroute}); +$missing .= " Router: redirect\n" if (!defined $parm_routers{redirect}); -$missing .= " Transport: appendfile\n" if (!defined $parm_transports{'appendfile'}); -$missing .= " Transport: autoreply\n" if (!defined $parm_transports{'autoreply'}); -$missing .= " Transport: pipe\n" if (!defined $parm_transports{'pipe'}); -$missing .= " Transport: smtp\n" if (!defined $parm_transports{'smtp'}); +$missing .= " Transport: appendfile\n" if (!defined $parm_transports{appendfile}); +$missing .= " Transport: autoreply\n" if (!defined $parm_transports{autoreply}); +$missing .= " Transport: pipe\n" if (!defined $parm_transports{pipe}); +$missing .= " Transport: smtp\n" if (!defined $parm_transports{smtp}); -if ($missing ne "") +if ($missing ne '') { print "\n"; print "** Many features can be included or excluded from Exim binaries.\n"; @@ -2209,8 +3485,8 @@ if ($missing ne "") for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls", "fakens", "iefbr14", "server") { - next if ($prog eq "client-ssl" && !defined $parm_support{'OpenSSL'}); - next if ($prog eq "client-gnutls" && !defined $parm_support{'GnuTLS'}); + next if ($prog eq "client-ssl" && !defined $parm_support{OpenSSL}); + next if ($prog eq "client-gnutls" && !defined $parm_support{GnuTLS}); if (!-e "bin/$prog") { print "\n"; @@ -2224,9 +3500,9 @@ for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls", # have that functionality compiled, we needn't bother. $dlfunc_deleted = 0; -if (defined $parm_support{'Expand_dlfunc'} && !-e "bin/loaded") +if (defined $parm_support{Expand_dlfunc} && !-e 'bin/loaded') { - delete $parm_support{'Expand_dlfunc'}; + delete $parm_support{Expand_dlfunc}; $dlfunc_deleted = 1; } @@ -2238,18 +3514,29 @@ if (defined $parm_support{'Expand_dlfunc'} && !-e "bin/loaded") # Find the caller of this program. ($parm_caller,$pwpw,$parm_caller_uid,$parm_caller_gid,$pwquota,$pwcomm, - $pwgecos, $parm_caller_home) = getpwuid($>); + $parm_caller_gecos, $parm_caller_home) = getpwuid($>); $pwpw = $pwpw; # Kill Perl warnings $pwquota = $pwquota; $pwcomm = $pwcomm; -$pwgecos = $pwgecos; $parm_caller_group = getgrgid($parm_caller_gid); -print "Program caller is $parm_caller, whose group is $parm_caller_group\n"; +print "Program caller is $parm_caller ($parm_caller_uid), whose group is $parm_caller_group ($parm_caller_gid)\n"; print "Home directory is $parm_caller_home\n"; +unless (defined $parm_eximgroup) + { + print "Unable to derive \$parm_eximgroup.\n"; + die "** ABANDONING.\n"; + } + +if ($parm_caller_home eq $parm_cwd) + { + print "will confuse working dir with homedir; change homedir\n"; + die "** ABANDONING.\n"; + } + print "You need to be in the Exim group to run these tests. Checking ..."; if (`groups` =~ /\b\Q$parm_eximgroup\E\b/) @@ -2264,40 +3551,35 @@ else # Find this host's IP addresses - there may be many, of course, but we keep # one of each type (IPv4 and IPv6). +#XXX it would be good to avoid non-UP interfaces -$parm_ipv4 = ""; -$parm_ipv6 = ""; - -$local_ipv4 = ""; -$local_ipv6 = ""; - -open(IFCONFIG, "ifconfig -a|") || die "** Cannot run \"ifconfig\": $!\n"; -while (($parm_ipv4 eq "" || $parm_ipv6 eq "") && ($_ = <IFCONFIG>)) +open(IFCONFIG, '-|', (grep { -x "$_/ip" } split /:/, $ENV{PATH}) ? 'ip address' : 'ifconfig -a') + or die "** Cannot run 'ip address' or 'ifconfig -a'\n"; +while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>)) { - my($ip); - if ($parm_ipv4 eq "" && - $_ =~ /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)\s/i) + if (/^(?:[0-9]+: )?([a-z0-9]+): /) { $ifname = $1; } + + if (not $parm_ipv4 and /^\s*inet(?:\saddr(?:ess))?:?\s*(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i) { - $ip = $1; - next if ($ip eq "127.0.0.1"); - $parm_ipv4 = $ip; + # It would be nice to be able to vary the /16 used for manyhome; we could take + # an option to runtest used here - but we'd also have to pass it on to fakens. + # Possibly an environment variable? + next if $1 eq '0.0.0.0' or $1 =~ /^(?:127|10\.250)\./; + $parm_ipv4 = $1; } - if ($parm_ipv6 eq "" && - $_ =~ /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)/i) + if ( (not $parm_ipv6 or $parm_ipv6 =~ /%/) + and /^\s*inet6(?:\saddr(?:ess))?:?\s*([abcdef\d:]+)(?:%[^ \/]+)?(?:\/\d+)?/i) { - $ip = $1; - next if ($ip eq "::1" || $ip =~ /^fe80/i); - $parm_ipv6 = $ip; + next if $1 eq '::' or $1 eq '::1' or $1 =~ /^ff00/i or $1 =~ /^fe80::1/i; + $parm_ipv6 = $1; + if ($1 =~ /^fe80/i) { $parm_ipv6 .= '%' . $ifname; } } } close(IFCONFIG); # Use private IP addresses if there are no public ones. -$parm_ipv4 = $local_ipv4 if ($parm_ipv4 eq ""); -$parm_ipv6 = $local_ipv6 if ($parm_ipv6 eq ""); - # If either type of IP address is missing, we need to set the value to # something other than empty, because that wrecks the substitutions. The value # is reflected, so use a meaningful string. Set appropriate options for the @@ -2306,7 +3588,7 @@ $parm_ipv6 = $local_ipv6 if ($parm_ipv6 eq ""); # of IPV4 or IPv6 can be simulated by command options, which force $have_ipv4 # and $have_ipv6 false. -if ($parm_ipv4 eq "") +if (not $parm_ipv4) { $have_ipv4 = 0; $parm_ipv4 = "<no IPv4 address found>"; @@ -2319,23 +3601,23 @@ elsif ($have_ipv4 == 0) } else { - $parm_running{"IPv4"} = " "; + $parm_running{IPv4} = " "; } -if ($parm_ipv6 eq "") +if (not $parm_ipv6) { $have_ipv6 = 0; $parm_ipv6 = "<no IPv6 address found>"; $server_opts .= " -noipv6"; - delete($parm_support{"IPv6"}); + delete($parm_support{IPv6}); } elsif ($have_ipv6 == 0) { $parm_ipv6 = "<IPv6 testing disabled>"; $server_opts .= " -noipv6"; - delete($parm_support{"IPv6"}); + delete($parm_support{IPv6}); } -elsif (!defined $parm_support{'IPv6'}) +elsif (!defined $parm_support{IPv6}) { $have_ipv6 = 0; $parm_ipv6 = "<no IPv6 support in Exim binary>"; @@ -2343,17 +3625,46 @@ elsif (!defined $parm_support{'IPv6'}) } else { - $parm_running{"IPv6"} = " "; + $parm_running{IPv6} = " "; } print "IPv4 address is $parm_ipv4\n"; print "IPv6 address is $parm_ipv6\n"; +$parm_ipv6 =~ /^[^%\/]*/; +# drop any %scope from the ipv6, for some uses +($parm_ipv6_stripped = $parm_ipv6) =~ s/%.*//g; + +# For munging test output, we need the reversed IP addresses. + +$parm_ipv4r = ($parm_ipv4 !~ /^\d/)? '' : + join(".", reverse(split /\./, $parm_ipv4)); + +$parm_ipv6r = $parm_ipv6; # Appropriate if not in use +if ($parm_ipv6 =~ /^[\da-f]/) + { + my(@comps) = split /:/, $parm_ipv6_stripped; + my(@nibbles); + foreach $comp (@comps) + { + push @nibbles, sprintf("%lx", hex($comp) >> 8); + push @nibbles, sprintf("%lx", hex($comp) & 0xff); + } + $parm_ipv6r = join(".", reverse(@nibbles)); + } # Find the host name, fully qualified. chomp($temp = `hostname`); -$parm_hostname = (gethostbyname($temp))[0]; -$parm_hostname = "no.host.name.found" if $parm_hostname eq ""; +die "'hostname' didn't return anything\n" unless defined $temp and length $temp; +if ($temp =~ /\./) + { + $parm_hostname = $temp; + } +else + { + $parm_hostname = (gethostbyname($temp))[0]; + $parm_hostname = "no.host.name.found" unless defined $parm_hostname and length $parm_hostname; + } print "Hostname is $parm_hostname\n"; if ($parm_hostname !~ /\./) @@ -2361,9 +3672,17 @@ if ($parm_hostname !~ /\./) print "\n*** Host name is not fully qualified: this may cause problems ***\n\n"; } -# Find the user's shell +if ($parm_hostname =~ /[[:upper:]]/) + { + print "\n*** Host name has upper case characters: this may cause problems ***\n\n"; + } + +if ($parm_hostname =~ /\.example\.com$/) + { + die "\n*** Host name ends in .example.com; this conflicts with the testsuite use of that domain.\n" + . " Please change the host's name (or comment out this check, and fail several testcases)\n"; + } -$parm_shell = $ENV{'SHELL'}; ################################################## @@ -2406,8 +3725,8 @@ die "** Unable to make patched exim: $!\n" # tests_exit(), so that suitable cleaning up can be done when required. # Arrange to catch interrupting signals, to assist with this. -$SIG{'INT'} = \&inthandler; -$SIG{'PIPE'} = \&pipehandler; +$SIG{INT} = \&inthandler; +$SIG{PIPE} = \&pipehandler; # For some tests, we need another copy of the binary that is setuid exim rather # than root. @@ -2417,7 +3736,6 @@ system("sudo cp eximdir/exim eximdir/exim_exim;" . "sudo chgrp $parm_eximgroup eximdir/exim_exim;" . "sudo chmod 06755 eximdir/exim_exim"); - ################################################## # Make copies of utilities we might need # ################################################## @@ -2425,30 +3743,30 @@ system("sudo cp eximdir/exim eximdir/exim_exim;" . # Certain of the tests make use of some of Exim's utilities. We do not need # to be root to copy these. -($parm_exim_dir) = $parm_exim =~ ?^(.*)/exim?; +($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?; $dbm_build_deleted = 0; -if (defined $parm_lookups{'dbm'} && - system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0) +if (defined $parm_lookups{dbm} && not copy("$parm_exim_dir/exim_dbmbuild", "eximdir")) { - delete $parm_lookups{'dbm'}; + delete $parm_lookups{dbm}; $dbm_build_deleted = 1; } -if (system("cp $parm_exim_dir/exim_dumpdb eximdir") != 0) - { - tests_exit(-1, "Failed to make a copy of exim_dumpdb: $!"); - } - -if (system("cp $parm_exim_dir/exim_lock eximdir") != 0) - { - tests_exit(-1, "Failed to make a copy of exim_lock: $!"); - } +foreach my $tool (qw(exim_dumpdb exim_lock exinext exigrep eximstats)) { + copy("$parm_exim_dir/$tool" => "eximdir/") + or tests_exit(-1, "Failed to make a copy of $tool: $!"); + chmod((stat "$parm_exim_dir/$tool")[2]&07777, "eximdir/$tool") + or tests_exit(-1, "Failed to chmod $tool: $!\n"); +} -if (system("cp $parm_exim_dir/exinext eximdir") != 0) - { - tests_exit(-1, "Failed to make a copy of exinext: $!"); - } +# Collect some version information +print '-' x 78, "\n"; +print "Perl version for runtest: $]\n"; +foreach (map { "./eximdir/$_" } qw(exigrep exinext eximstats)) { + # fold (or unfold?) multiline output into a one-liner + print join(', ', map { chomp; $_ } `$_ --version`), "\n"; +} +print '-' x 78, "\n"; ################################################## @@ -2460,6 +3778,17 @@ if (system("cp $parm_exim_dir/exinext eximdir") != 0) print "Exim user is $parm_eximuser ($parm_exim_uid)\n"; print "Exim group is $parm_eximgroup ($parm_exim_gid)\n"; + +if ($parm_caller_uid eq $parm_exim_uid) { + tests_exit(-1, "Exim user ($parm_eximuser,$parm_exim_uid) cannot be " + ."the same as caller ($parm_caller,$parm_caller_uid)"); +} +if ($parm_caller_gid eq $parm_exim_gid) { + tests_exit(-1, "Exim group ($parm_eximgroup,$parm_exim_gid) cannot be " + ."the same as caller's ($parm_caller) group as it confuses " + ."results analysis"); +} + print "The Exim user needs access to the test suite directory. Checking ..."; if (($rc = system("sudo bin/checkaccess $parm_cwd/eximdir/exim $parm_eximuser $parm_eximgroup")) != 0) @@ -2481,6 +3810,8 @@ else print " OK\n"; } +tests_exit(-1, "Failed to unlink $log_summary_filename: $!") + if not unlink($log_summary_filename) and -e $log_summary_filename; ################################################## # Create a list of available tests # @@ -2494,40 +3825,43 @@ else # because the current binary does not support the right facilities, and also # those that are outside the numerical range selected. -print "\nTest range is $test_start to $test_end\n"; +printf "\nWill run %d tests between %d and %d for flavour %s\n", + scalar(@wanted), $wanted[0], $wanted[-1], $flavour; + print "Omitting \${dlfunc expansion tests (loadable module not present)\n" if $dlfunc_deleted; print "Omitting dbm tests (unable to copy exim_dbmbuild)\n" if $dbm_build_deleted; -opendir(DIR, "scripts") || tests_exit(-1, "Failed to opendir(\"scripts\"): $!"); -@test_dirs = sort readdir(DIR); -closedir(DIR); -for ($i = 0; $i < @test_dirs; $i++) +my @test_dirs = grep { not /^CVS$/ } map { basename $_ } glob 'scripts/*' + or die tests_exit(-1, "Failed to find test scripts in 'scripts/*`: $!"); + +# Scan for relevant tests +# HS12: Needs to be reworked. +DIR: for (my $i = 0; $i < @test_dirs; $i++) { my($testdir) = $test_dirs[$i]; my($wantthis) = 1; - next if $testdir eq "." || $testdir eq ".."; print ">>Checking $testdir\n" if $debug; # Skip this directory if the first test is equal or greater than the first # test in the next directory. - next if ($i < @test_dirs - 1) && - ($test_start >= substr($test_dirs[$i+1], 0, 4)); + next DIR if ($i < @test_dirs - 1) && + ($wanted[0] >= substr($test_dirs[$i+1], 0, 4)); # No need to carry on if the end test is less than the first test in this # subdirectory. - last if $test_end < substr($testdir, 0, 4); + last DIR if $wanted[-1] < substr($testdir, 0, 4); # Check requirements, if any. - if (open(REQUIRES, "scripts/$testdir/REQUIRES")) + if (open(my $requires, "scripts/$testdir/REQUIRES")) { - while (<REQUIRES>) + while (<$requires>) { next if /^\s*$/; s/\s+$//; @@ -2555,12 +3889,45 @@ for ($i = 0; $i < @test_dirs; $i++) { if (!defined $parm_transports{$1}) { $wantthis = 0; last; } } + elsif (/^malware (.*)$/) + { + if (!defined $parm_malware{$1}) { $wantthis = 0; last; } + } + elsif (/^feature (.*)$/) + { + # move to a subroutine? + my $eximinfo = "$parm_exim -C $parm_cwd/test-config -DDIR=$parm_cwd -bP macro $1"; + + open (IN, "$parm_cwd/confs/0000") || + tests_exit(-1, "Couldn't open $parm_cwd/confs/0000: $!\n"); + open (OUT, ">test-config") || + tests_exit(-1, "Couldn't open test-config: $!\n"); + while (<IN>) + { + do_substitute($testno); + print OUT; + } + close(IN); + close(OUT); + + system($eximinfo . " >/dev/null 2>&1"); + if ($? != 0) { + unlink("$parm_cwd/test-config"); + $wantthis = 0; + $_ = "feature $1"; + last; + } + unlink("$parm_cwd/test-config"); + } + elsif (/^ipv6-non-linklocal/) + { + if ($parm_ipv6 =~ /%/) { $wantthis = 0; last; } + } else { tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\""); } } - close(REQUIRES); } else { @@ -2574,26 +3941,29 @@ for ($i = 0; $i < @test_dirs; $i++) { chomp; print "Omitting tests in $testdir (missing $_)\n"; - next; } # We want the tests from this subdirectory, provided they are in the # range that was selected. - opendir(SUBDIR, "scripts/$testdir") || - tests_exit(-1, "Failed to opendir(\"scripts/$testdir\"): $!"); - @testlist = sort readdir(SUBDIR); - close(SUBDIR); + @testlist = grep { $_ ~~ @wanted } grep { /^\d+(?:\.\d+)?$/ } map { basename $_ } glob "scripts/$testdir/*"; + tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!") + if not @testlist; foreach $test (@testlist) { - next if $test !~ /^\d{4}$/; - next if $test < $test_start || $test > $test_end; - push @test_list, "$testdir/$test"; + if (!$wantthis) + { + log_test($log_summary_filename, $test, '.'); + } + else + { + push @test_list, "$testdir/$test"; + } } } -print ">>Test List: @test_list\n", if $debug; +print ">>Test List:\n", join "\n", @test_list, '' if $debug; ################################################## @@ -2655,6 +4025,10 @@ foreach $basedir ("aux-var", "dnszones") } } +# Set a user's shell, distinguishable from /bin/sh + +symlink('/bin/sh' => 'aux-var/sh'); +$ENV{SHELL} = $parm_shell = "$parm_cwd/aux-var/sh"; ################################################## # Create fake DNS zones for this host # @@ -2674,7 +4048,7 @@ if ($have_ipv4 || $have_ipv6) "; for queries that it cannot answer\n\n" . "PASS ON NOT FOUND\n\n"; print OUT "$shortname A $parm_ipv4\n" if $have_ipv4; - print OUT "$shortname AAAA $parm_ipv6\n" if $have_ipv6; + print OUT "$shortname AAAA $parm_ipv6_stripped\n" if $have_ipv6; print OUT "\n; End\n"; close(OUT); } @@ -2682,21 +4056,43 @@ if ($have_ipv4 || $have_ipv6) if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1") { my(@components) = $parm_ipv4 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/; - open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") || - tests_exit(-1, - "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!"); - print OUT "; This is a dynamically constructed fake zone file.\n" . - "; The zone is $components[0].in-addr.arpa.\n\n" . - "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n" . - "; End\n"; - close(OUT); + + if ($components[0]=='10') + { + open(OUT, ">>$parm_cwd/dnszones/db.ip4.$components[0]") || + tests_exit(-1, "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!"); + print OUT "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n"; + close(OUT); + } + else + { + open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") || + tests_exit(-1, + "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!"); + print OUT "; This is a dynamically constructed fake zone file.\n" . + "; The zone is $components[0].in-addr.arpa.\n\n" . + "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n" . + "; End\n"; + close(OUT); + } } -if ($have_ipv6 && $parm_ipv6 ne "::1") +if ($have_ipv6 && $parm_ipv6_stripped ne "::1") { - my(@components) = split /:/, $parm_ipv6; + my($exp_v6) = $parm_ipv6_stripped; + $exp_v6 =~ s/[^:]//g; + if ( $parm_ipv6_stripped =~ /^([^:].+)::$/ ) { + $exp_v6 = $1 . ':0' x (9-length($exp_v6)); + } elsif ( $parm_ipv6_stripped =~ /^(.+)::(.+)$/ ) { + $exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2; + } elsif ( $parm_ipv6_stripped =~ /^::(.+[^:])$/ ) { + $exp_v6 = '0:' x (9-length($exp_v6)) . $1; + } else { + $exp_v6 = $parm_ipv6_stripped; + } + my(@components) = split /:/, $exp_v6; my(@nibbles) = reverse (split /\s*/, shift @components); - my($sep) = ""; + my($sep) = ''; $" = "."; open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") || @@ -2745,60 +4141,71 @@ closedir(DIR); # contains ****. We open input from the terminal so that we can read responses # to prompts. -open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!"); - -print "\nPress RETURN to run the tests: "; -$_ = <T>; -print "\n"; +if (not $force_continue) { + # runtest needs to interact if we're not in continue + # mode. It does so by communicate to /dev/tty + open(T, '<', '/dev/tty') or tests_exit(-1, "Failed to open /dev/tty: $!"); + print "\nPress RETURN to run the tests: "; + <T>; +} -$lasttestdir = ""; +my $failures = 0; foreach $test (@test_list) { - local($lineno) = 0; - local($commandno) = 0; - local($subtestno) = 0; - local($testno) = substr($test, -4); - local($sortlog) = 0; + state $lasttestdir = ''; + + local $lineno = 0; + local $commandno = 0; + local $subtestno = 0; + local $sortlog = 0; - my($gnutls) = 0; - my($docheck) = 1; - my($thistestdir) = substr($test, 0, -5); + (local $testno = $test) =~ s|.*/||; + + # Leaving traces in the process table and in the environment + # gives us a chance to identify hanging processes (exim daemons) + local $0 = "[runtest $testno]"; + local $ENV{EXIM_TEST_NUMBER} = $testno; + + my $gnutls = 0; + my $docheck = 1; + my $thistestdir = substr($test, 0, -5); + + $dynamic_socket->close() if $dynamic_socket; if ($lasttestdir ne $thistestdir) { $gnutls = 0; if (-s "scripts/$thistestdir/REQUIRES") { - my($indent) = ""; + my $indent = ''; print "\n>>> The following tests require: "; - open(IN, "scripts/$thistestdir/REQUIRES") || - tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1"); - while (<IN>) + open(my $requires, '<', "scripts/$thistestdir/REQUIRES") || + tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $!"); + while (<$requires>) { $gnutls = 1 if /^support GnuTLS/; print $indent, $_; $indent = ">>> "; } - close(IN); } + $lasttestdir = $thistestdir; } - $lasttestdir = $thistestdir; # Remove any debris in the spool directory and the test-mail directory # and also the files for collecting stdout and stderr. Then put back # the test-mail directory for appendfile deliveries. system "sudo /bin/rm -rf spool test-*"; - system "mkdir test-mail 2>/dev/null"; + mkdir "test-mail"; # A privileged Exim will normally make its own spool directory, but some of # the tests run in unprivileged modes that don't always work if the spool # directory isn't already there. What is more, we want anybody to be able # to read it in order to find the daemon's pid. - system "mkdir spool; " . - "sudo chown $parm_eximuser:$parm_eximgroup spool; " . + mkdir "spool"; + system "sudo chown $parm_eximuser:$parm_eximgroup spool; " . "sudo chmod 0755 spool"; # Empty the cache that keeps track of things like message id mappings, and @@ -2806,6 +4213,7 @@ foreach $test (@test_list) undef %cache; $next_msgid = "aX"; + $next_pid = 1234; $next_port = 1111; $message_skip = 0; $msglog_skip = 0; @@ -2813,6 +4221,7 @@ foreach $test (@test_list) $stdout_skip = 0; $rmfiltertest = 0; $is_ipv6test = 0; + $TEST_STATE->{munge} = ''; # Remove the associative arrays used to hold checked mail files and msglogs @@ -2820,9 +4229,21 @@ foreach $test (@test_list) undef %expected_msglogs; # Open the test's script - open(SCRIPT, "scripts/$test") || tests_exit(-1, "Failed to open \"scripts/$test\": $!"); + # Run through the script once to set variables which should be global + while (<SCRIPT>) + { + if (/^no_message_check/) { $message_skip = 1; next; } + if (/^no_msglog_check/) { $msglog_skip = 1; next; } + if (/^no_stderr_check/) { $stderr_skip = 1; next; } + if (/^no_stdout_check/) { $stdout_skip = 1; next; } + if (/^rmfiltertest/) { $rmfiltertest = 1; next; } + if (/^sortlog/) { $sortlog = 1; next; } + if (/\bPORT_DYNAMIC\b/) { $dynamic_socket = Exim::Runtest::dynamic_socket(); next; } + } + # Reset to beginning of file for per test interpreting/processing + seek(SCRIPT, 0, 0); # The first line in the script must be a comment that is used to identify # the set of tests as a whole. @@ -2845,6 +4266,8 @@ foreach $test (@test_list) while (<SCRIPT>) { $lineno++; + # Could remove these variable settings because they are already + # set above, but doesn't hurt to leave them here. if (/^no_message_check/) { $message_skip = 1; next; } if (/^no_msglog_check/) { $msglog_skip = 1; next; } if (/^no_stderr_check/) { $stderr_skip = 1; next; } @@ -2852,6 +4275,15 @@ foreach $test (@test_list) if (/^rmfiltertest/) { $rmfiltertest = 1; next; } if (/^sortlog/) { $sortlog = 1; next; } + if (/^need_largefiles/) + { + next if $have_largefiles; + print ">>> Large file support is needed for test $testno, but is not available: skipping\n"; + $docheck = 0; # don't check output + undef $_; # pretend EOF + last; + } + if (/^need_ipv4/) { next if $have_ipv4; @@ -2876,7 +4308,7 @@ foreach $test (@test_list) if (/^need_move_frozen_messages/) { - next if defined $parm_support{"move_frozen_messages"}; + next if defined $parm_support{move_frozen_messages}; print ">>> move frozen message support is needed for test $testno, " . "but is not\n>>> available: skipping\n"; $docheck = 0; # don't check output @@ -2884,22 +4316,43 @@ foreach $test (@test_list) last; } - last unless /^(#|\s*$)/; + last unless /^(?:#(?!##\s)|\s*$)/; } last if !defined $_; # Hit EOF my($subtest_startline) = $lineno; - # Now run the command. The function returns 0 if exim was run and waited - # for, 1 if any other command was run and waited for, and 2 if a command + # Now run the command. The function returns 0 for an inline command, + # 1 if a non-exim command was run and waited for, 2 if an exim + # command was run and waited for, and 3 if a command # was run and not waited for (usually a daemon or server startup). - my($commandname) = ""; + my($commandname) = ''; my($expectrc) = 0; - my($rc) = run_command($testno, \$subtestno, \$expectrc, \$commandname); + my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE); my($cmdrc) = $?; - print ">> rc=$rc cmdrc=$cmdrc\n" if $debug; + if ($debug) { + print ">> rc=$rc cmdrc=$cmdrc\n"; + if (defined $run_extra) { + foreach my $k (keys %$run_extra) { + my $v = defined $run_extra->{$k} ? qq!"$run_extra->{$k}"! : '<undef>'; + print ">> $k -> $v\n"; + } + } + } + $run_extra = {} unless defined $run_extra; + foreach my $k (keys %$run_extra) { + if (exists $TEST_STATE->{$k}) { + my $nv = defined $run_extra->{$k} ? qq!"$run_extra->{$k}"! : 'removed'; + print ">> override of $k; was $TEST_STATE->{$k}, now $nv\n" if $debug; + } + if (defined $run_extra->{$k}) { + $TEST_STATE->{$k} = $run_extra->{$k}; + } elsif (exists $TEST_STATE->{$k}) { + delete $TEST_STATE->{$k}; + } + } # Hit EOF after an initial return code number @@ -2928,20 +4381,52 @@ foreach $test (@test_list) for (;;) { - print "\nshow stdErr, show stdOut, Continue (without file comparison), or Quit? [Q] "; - $_ = <T>; + print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] "; + $_ = $force_continue ? "c" : <T>; tests_exit(1) if /^q?$/i; - last if /^c$/i; + if (/^c$/ && $force_continue) + { + log_failure($log_failed_filename, $testno, "exit code unexpected"); + log_test($log_summary_filename, $testno, 'F'); + $failures++; + } + if ($force_continue) + { + print "\nstdout tail:\n"; + print "==================>\n"; + system("tail -20 test-stdout"); + print "===================\n"; + + print "stderr tail:\n"; + print "==================>\n"; + system("tail -30 test-stderr"); + print "===================\n"; + + print "stdout-server tail:\n"; + print "==================>\n"; + system("tail -20 test-stdout-server"); + print "===================\n"; + + print "stderr-server tail:\n"; + print "==================>\n"; + system("tail -30 test-stderr-server"); + print "===================\n"; + + print "... continue forced\n"; + } + + last if /^[rc]$/i; if (/^e$/i) { - system("$more test-stderr"); + system @more => 'test-stderr'; } elsif (/^o$/i) { - system("$more test-stdout"); + system @more => 'test-stdout'; } } + $retry = 1 if /^r$/i; $docheck = 0; } @@ -2956,7 +4441,8 @@ foreach $test (@test_list) if ($? != 0) { if (($? & 0xff) == 0) - { printf("Server return code %d", $?/256); } + { printf("Server return code %d for test %d starting line %d", $?/256, + $testno, $subtest_startline); } elsif (($? & 0xff00) == 0) { printf("Server killed by signal %d", $? & 255); } else @@ -2964,10 +4450,17 @@ foreach $test (@test_list) for (;;) { - print "\nShow server stdout, Continue, or Quit? [Q] "; - $_ = <T>; + print "\nShow server stdout, Retry, Continue, or Quit? [Q] "; + $_ = $force_continue ? "c" : <T>; tests_exit(1) if /^q?$/i; - last if /^c$/i; + if (/^c$/ && $force_continue) + { + log_failure($log_failed_filename, $testno, "exit code unexpected"); + log_test($log_summary_filename, $testno, 'F'); + $failures++; + } + print "... continue forced\n" if $force_continue; + last if /^[rc]$/i; if (/^s$/i) { @@ -2977,6 +4470,7 @@ foreach $test (@test_list) close(S); } } + $retry = 1 if /^r$/i; } } } @@ -2984,20 +4478,38 @@ foreach $test (@test_list) close SCRIPT; # The script has finished. Check the all the output that was generated. The - # function returns 0 if all is well, 1 if we should rerun the test (the files - # have been updated). It does not return if the user responds Q to a prompt. + # function returns 0 for a perfect pass, 1 if imperfect but ok, 2 if we should + # rerun the test (the files # have been updated). + # It does not return if the user responds Q to a prompt. + + if ($retry) + { + $retry = '0'; + print (("#" x 79) . "\n"); + redo; + } if ($docheck) { - if (check_output() != 0) + sleep 1 if $slow; + my $rc = check_output($TEST_STATE->{munge}); + if ($rc == 0) { - print (("#" x 79) . "\n"); - redo; + log_test($log_summary_filename, $testno, 'P'); } else + { + $failures++; + } + if ($rc < 2) { print (" Script completed\n"); } + else + { + print (("#" x 79) . "\n"); + redo; + } } } @@ -3006,8 +4518,84 @@ foreach $test (@test_list) # Exit from the test script # ################################################## -tests_exit(-1, "No runnable tests selected") if @test_list == 0; -tests_exit(0); +tests_exit(-1, "No runnable tests selected") if not @test_list; +tests_exit($fail_any ? $failures : 0); -# End of runtest script +__END__ + +=head1 NAME + + runtest - run the exim testsuite + +=head1 SYNOPSIS + + runtest [exim-path] [options] [test0 [test1]] + +=head1 DESCRIPTION + +B<runtest> runs the Exim testsuite. + +=head1 OPTIONS + +For legacy reasons the options are not case sensitive. + +=over + +=item B<--continue> + +Do not stop for user interaction or on errors. (default: off) + +=item B<--debug> + +This option enables the output of debug information when running the +various test commands. (default: off) + +=item B<--diff> + +Use C<diff -u> for comparing the expected output with the produced +output. (default: use a built-in routine) + +=item B<--flavor>|B<--flavour> I<flavour> + +Override the expected results for results for a specific (OS) flavour. +(default: unused) + +=item B<--[no]ipv4> +Skip IPv4 related setup and tests (default: use ipv4) + +=item B<--[no]ipv6> + +Skip IPv6 related setup and tests (default: use ipv6) + +=item B<--keep> + +Keep the various output files produced during a test run. (default: don't keep) + +=item B<--range> I<n0> I<n1> + +Run tests between (including) I<n0> and I<n1>. A "+" may be used to specify the "last +test available". + +=item B<--slow> + +Insert some delays to compensate for a slow host system. (default: off) + +=item B<--test> I<n> + +Run the specified test. This option may used multiple times. + +=item B<--update> + +Automatically update the recorded (expected) data on mismatch. (default: off) + +=item B<--valgrind> + +Start Exim wrapped by I<valgrind>. (default: don't use valgrind) + +=back + +=cut + + +# End of runtest script