X-Git-Url: https://git.exim.org/users/heiko/exim.git/blobdiff_plain/2eb77f91023a3279166810a7ce9f15508d244e65..f3f9fe5c6f21a00accc994e0b79480d247f9d6db:/test/runtest diff --git a/test/runtest b/test/runtest index aeca824e1..229581005 100755 --- a/test/runtest +++ b/test/runtest @@ -1,4 +1,6 @@ -#! /usr/bin/perl -w +#! /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 # @@ -14,16 +16,34 @@ ############################################################################### #use strict; -require Cwd; +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 lib "$RealBin/lib"; +use Exim::Runtest; +use Exim::Utils qw(uniq numerically); + +use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Smart::Comments' => '####'; +use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Data::Dumper'; + +use constant TEST_TOP => 8999; +use constant TEST_SPECIAL_TOP => 9999; # Start by initializing some global variables -$testversion = "4.80 (08-May-12)"; +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 @@ -31,28 +51,31 @@ $testversion = "4.80 (08-May-12)"; # 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 -$gnutls_dh_bits_normal = 2236; - -$cf = "bin/cf -exact"; -$cr = "\r"; -$debug = 0; -$force_continue = 0; -$force_update = 0; -$log_failed_filename = "failed-summary.log"; -$more = "less -XF"; -$optargs = ""; -$save_output = 0; -$server_opts = ""; - -$have_ipv4 = 1; -$have_ipv6 = 1; -$have_largefiles = 0; - -$test_start = 1; -$test_end = $test_top = 8999; -$test_special_top = 9999; -@test_list = (); -@test_dirs = (); +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 @@ -65,22 +88,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'; +$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; ############################################################################### ############################################################################### @@ -130,6 +163,8 @@ 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; } @@ -165,7 +200,7 @@ if (exists $TEST_STATE->{exim_pid}) { $pid = $TEST_STATE->{exim_pid}; print "Tidyup: killing wait-mode daemon pid=$pid\n"; - system("sudo kill -SIGINT $pid"); + system("sudo kill -INT $pid"); } if (opendir(DIR, "spool")) @@ -179,7 +214,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 @@ -320,11 +355,14 @@ 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 @@ -339,7 +377,7 @@ $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 @@ -366,7 +404,7 @@ RESET_AFTER_EXTRA_LINE_READ: # Replace the Exim version number (may appear in various places) # patchexim should have fixed this for us - #s/(Exim) \d+\.\d+[\w_-]*/$1 x.yz/i; + #s/Exim \K\d+[._]\d+[\w_-]*/x.yz/i; # Replace Exim message ids by a unique series s/((?:[^\W_]{6}-){2}[^\W_]{2}) @@ -387,12 +425,6 @@ RESET_AFTER_EXTRA_LINE_READ: 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/; @@ -413,10 +445,11 @@ RESET_AFTER_EXTRA_LINE_READ: # 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: write=\d+ read=\d+/running as transport filter: write=dddd read=dddd/; + s/(running as transport filter:) fd_write=\d+ fd_read=\d+/$1 fd_write=dddd fd_read=dddd/; # ======== Dumpdb output ======== @@ -426,8 +459,10 @@ RESET_AFTER_EXTRA_LINE_READ: 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 @@ -441,6 +476,13 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 ======== @@ -450,12 +492,24 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 @@ -473,7 +527,7 @@ RESET_AFTER_EXTRA_LINE_READ: my($next) = $3 - $2; $_ = " first failed=dddd last try=dddd next try=+$next $4\n"; } - s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\d)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/; + 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 @@ -484,61 +538,135 @@ RESET_AFTER_EXTRA_LINE_READ: # 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; - # Time on queue tolerance - s/QT=1s/QT=0s/; - # 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; + + # 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/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.[12]:/$1TLSv1:/xg; - s/\bAES256-GCM-SHA384\b/AES256-SHA/g; - s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g; + 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_AES_256_CBC_SHA1:256/g; - s/TLS1.[012]:((EC)?DHE_)?RSA_AES_(256|128)_(CBC|GCM)_SHA(1|256|384):(256|128)/TLS1.x:xxxxRSA_AES_256_CBC_SHAnnn:256/g; - s/\b(ECDHE-RSA-AES256-SHA|DHE-RSA-AES256-SHA256)\b/AES256-SHA/g; + 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/The peer did not send any certificate/g; + 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 to \d{1,3}(.\d{1,3}){3} \[\d{1,3}(.\d{1,3}){3}\] \(gnutls_handshake\): Error in the pull function\./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 \(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; @@ -560,7 +688,7 @@ RESET_AFTER_EXTRA_LINE_READ: 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\b/name=CALLER_GECOS/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 @@ -610,11 +738,10 @@ RESET_AFTER_EXTRA_LINE_READ: 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/; @@ -624,8 +751,12 @@ RESET_AFTER_EXTRA_LINE_READ: 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)(\s[+-]\d\d\d\d|)(\s\[\d+\])/ - "$1$2 [" . new_value($3, "%s", \$next_pid) . "]"/gxe; + 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. @@ -636,6 +767,10 @@ RESET_AFTER_EXTRA_LINE_READ: 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. @@ -644,13 +779,17 @@ RESET_AFTER_EXTRA_LINE_READ: # This handles "connection from" and the like, when the port is given if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/ - && !/\*>/ && !/Connection refused/) + && !/\*>/&& !/==/ && !/\*\*/ && !/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 ======== @@ -660,6 +799,12 @@ RESET_AFTER_EXTRA_LINE_READ: # 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/; @@ -668,9 +813,10 @@ RESET_AFTER_EXTRA_LINE_READ: 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/(^|\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+\]) +$/$1 /; + s/^\s+host\s\S+\s+\[\S+\]\K +$//; # strip, not collapse the trailing whitespace # ======== Test network IP addresses ======== @@ -680,11 +826,10 @@ RESET_AFTER_EXTRA_LINE_READ: # ======== 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/; @@ -697,6 +842,9 @@ RESET_AFTER_EXTRA_LINE_READ: # ======== 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 @@ -725,8 +873,8 @@ RESET_AFTER_EXTRA_LINE_READ: 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)/; @@ -743,7 +891,7 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 ======== @@ -751,7 +899,11 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 @@ -763,7 +915,7 @@ RESET_AFTER_EXTRA_LINE_READ: 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 while (/^\d+S,\d+C\s*$/) @@ -779,14 +931,17 @@ RESET_AFTER_EXTRA_LINE_READ: 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 ======== # The statuses seem to be different on different operating systems, but # 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 ======== @@ -795,15 +950,9 @@ RESET_AFTER_EXTRA_LINE_READ: s/^\d\d\d(?=[PFS*])/ddd/; - # ========= 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%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g; - # ========================================================== # MIME boundaries in RFC3461 DSN messages - s/\d{8,10}-eximdsn-\d{8,10}/NNNNNNNNNN-eximdsn-MMMMMMMMMM/; + s/\d{8,10}-eximdsn-\d+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/; # ========================================================== # Some munging is specific to the specific file types @@ -833,6 +982,48 @@ RESET_AFTER_EXTRA_LINE_READ: 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 ======== @@ -843,14 +1034,29 @@ RESET_AFTER_EXTRA_LINE_READ: 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]+$/; @@ -860,6 +1066,41 @@ RESET_AFTER_EXTRA_LINE_READ: 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/; @@ -887,7 +1128,7 @@ RESET_AFTER_EXTRA_LINE_READ: # 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/; + 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 @@ -898,7 +1139,7 @@ RESET_AFTER_EXTRA_LINE_READ: } next if /^tls_validate_require_cipher child \d+ ended: status=0x0/; - # We invoke Exim with -D, so we hit this new messag as of Exim 4.73: + # 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 @@ -909,14 +1150,18 @@ RESET_AFTER_EXTRA_LINE_READ: next if /name=localhost address=::1/; # drop pdkim debugging header - next if /^PDKIM <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+$/; + 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/) { @@ -924,11 +1169,22 @@ RESET_AFTER_EXTRA_LINE_READ: 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. @@ -952,12 +1208,14 @@ RESET_AFTER_EXTRA_LINE_READ: # 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. @@ -973,6 +1231,163 @@ RESET_AFTER_EXTRA_LINE_READ: 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 @@ -994,11 +1409,6 @@ RESET_AFTER_EXTRA_LINE_READ: @saved = (); } - # 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; - # Skip some lines that Exim puts out at the start of debugging output # because they will be different in different binaries. @@ -1010,16 +1420,97 @@ RESET_AFTER_EXTRA_LINE_READ: /^Support for:/ || /^Routers:/ || /^Transports:/ || + /^Malware:/ || /^log selectors =/ || /^cwd=/ || /^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; @@ -1039,13 +1530,24 @@ return $yield; # Arguments: [0] the prompt string # [1] if there is a U in the prompt and $force_update is true # [2] if there is a C in the prompt and $force_continue is true -# Returns: nothing (it sets $_) +# Returns: returns the answer + +sub interact { + my ($prompt, $have_u, $have_c) = @_; -sub interact{ -print $_[0]; -if ($_[1]) { $_ = "u"; print "... update forced\n"; } - elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; } - else { $_ = <T>; } + print $prompt; + + if ($have_u) { + print "... update forced\n"; + return 'u'; + } + + if ($have_c) { + print "... continue forced\n"; + return 'c'; + } + + return lc <T>; } @@ -1065,13 +1567,22 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } sub log_failure { - my $logfile = shift(); - my $testno = shift(); - my $detail = shift() || ''; - if ( open(my $fh, ">>", $logfile) ) { - print $fh "Test $testno $detail failed\n"; - close $fh; - } + 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"; } @@ -1091,8 +1602,9 @@ sub log_failure { # [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 may have been 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. @@ -1102,7 +1614,13 @@ 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 && (! defined $rsf || ! -s $rsf)); @@ -1112,12 +1630,14 @@ if (! -e $sf) for (;;) { - print "Continue, Show, or Quit? [Q] "; - $_ = $force_continue ? "c" : <T>; - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, $rf) if (/^c$/i && $force_continue); - 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) @@ -1127,27 +1647,34 @@ 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, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, $rsf) if (/^c$/i && $force_continue); - 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: $!"); +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"; @@ -1169,7 +1696,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 @@ -1177,10 +1704,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); @@ -1202,26 +1729,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] !~ @@ -1233,42 +1759,57 @@ 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, Retry, Update & retry, Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, $sf) if (/^c$/i && $force_continue); - return 0 if /^c$/i; - return 1 if /^r$/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; + tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0; + } 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; } @@ -1281,23 +1822,102 @@ return 1; # 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/', }, + { 'stderr' => '/^Reverse DNS security status: unverified\n/' }, 'gnutls_unexpected' => - { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./', }, + { '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/', }, - - 'tpda' => - { 'stdout' => '/tpda_delivery_action =/', }, - + { '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 # ################################################## @@ -1312,49 +1932,50 @@ $munges = # [4] TRUE if this is a log file whose deliveries must be sorted # [5] an optional custom munge command # -# Arguments: Optionally, name of a custom munge to run. +# Arguments: Optionally, name of a single custom munge to run. # Returns: 0 if the output compared equal -# 1 if re-run needed (files may have been updated) +# 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, - $munge->{'paniclog'}); + $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, - $munge->{'rejectlog'}); + $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, - $munge->{'mainlog'}); + $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, - $munge->{'stdout'}); + $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, - $munge->{'stderr'}); + $munge->{stderr})); } # Compare any delivered messages, unless this test is skipped. @@ -1392,9 +2013,9 @@ if (! $message_skip) } print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug; - $yield = 1 if check_file($mail, undef, "test-mail-munged", + $yield = max($yield, check_file($mail, undef, "test-mail-munged", "mail/$testno.$saved_mail", 0, - $munge->{'mail'}); + $munge->{mail})); delete $expected_mails{"mail/$testno.$saved_mail"}; } @@ -1407,16 +2028,19 @@ if (! $message_skip) for (;;) { - interact("Continue, Update & retry, or Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "missing email") if (/^c$/i && $force_continue); - 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) { @@ -1464,9 +2088,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, + $yield = max($yield, check_file("spool/msglog/$msglog", undef, "test-msglog-munged", "msglog/$testno.$munged_msglog", 0, - $munge->{'msglog'}); + $munge->{msglog})); delete $expected_msglogs{"$testno.$munged_msglog"}; } } @@ -1491,11 +2115,14 @@ if (! $msglog_skip) for (;;) { - interact("Continue, Update, or Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/i && $force_continue); - 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) { @@ -1543,7 +2170,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 @@ -1552,14 +2179,14 @@ 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) -# auxilliary information returned from a previous run +# 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 alse a second parameter, a hash-ref, with auxilliary information: +# 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 @@ -1570,6 +2197,8 @@ 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]; @@ -1635,30 +2264,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"; @@ -1734,8 +2395,7 @@ if (/^gnutls/) # 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/) { @@ -1747,14 +2407,14 @@ if (/^killdaemon/) print ">> killdaemon: recovered pid $pid\n" if $debug; if ($pid) { - run_system("sudo /bin/kill -SIGINT $pid"); + run_system("sudo /bin/kill -TERM $pid"); wait; } } else { $pid = `cat $parm_cwd/spool/exim-daemon.*`; if ($pid) { - run_system("sudo /bin/kill -SIGINT $pid"); + run_system("sudo /bin/kill -TERM $pid"); close DAEMONCMD; # Waits for process } } @@ -1775,7 +2435,7 @@ elsif (/^millisleep\s+(.*)$/) # The "munge" command selects one of a hardwired set of test-result modifications -# to be made before result compares are run agains the golden set. This lets +# 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. @@ -1812,7 +2472,7 @@ if (/^sleep\s+(.*)$/) # Various Unix management commands are recognized if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ || - /^sudo (rmdir|rm|chown|chmod)\s/) + /^sudo\s(rmdir|rm|mv|chown|chmod)\s/) { run_system("$_ >>test-stdout 2>>test-stderr"); return 1; @@ -1833,10 +2493,12 @@ if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\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); @@ -1850,10 +2512,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.5); + while (! stat("$pidfile") ) { select(undef, undef, undef, 0.3); } return 3; } @@ -1894,7 +2555,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) @@ -1950,12 +2611,12 @@ if (/^client/ || /^(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 @@ -1986,22 +2647,43 @@ 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 = $&; } + + my @listcmd; + + 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"); # Done backwards just in case there are more than 9 - my($i); - for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; } + 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"); + tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n") + unless $force_continue; } } @@ -2010,11 +2692,13 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) $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 @@ -2038,41 +2722,46 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) # 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 -oP $parm_cwd/spool/exim-daemon.pid !; + 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; - my $waitmode_sock = new FileHandle; 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 ($s_ip,$s_port) = ('127.0.0.1', $listen_port); - my $sin = sockaddr_in($s_port, inet_aton($s_ip)) - or die "** Failed packing $s_ip:$s_port\n"; - socket($waitmode_sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) - or die "** Unable to open socket $s_ip:$s_port: $!\n"; - setsockopt($waitmode_sock, SOL_SOCKET, SO_REUSEADDR, 1) - or die "** Unable to setsockopt(SO_REUSEADDR): $!\n"; - bind($waitmode_sock, $sin) - or die "** Unable to bind socket ($s_port): $!\n"; - listen($waitmode_sock, 5); my $pid = fork(); if (not defined $pid) { die "** fork failed: $!\n" } if (not $pid) { close(STDIN); - open(STDIN, "<&", $waitmode_sock) or die "** dup sock to stdin failed: $!\n"; - close($waitmode_sock); + 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"; - exit(1); + 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 @@ -2080,6 +2769,46 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) } } +# 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 @@ -2087,22 +2816,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 @@ -2130,7 +2877,7 @@ return $yield; # Ran command and waited ############################################################################### ############################################################################### -# Here beginneth the Main Program ... +# Here begins the Main Program ... ############################################################################### ############################################################################### @@ -2139,6 +2886,15 @@ 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}; +}; ################################################## # Some tests check created file modes # @@ -2151,23 +2907,7 @@ umask 022; # Check for the "less" command # ################################################## -$more = "more" if system("which less >/dev/null 2>&1") != 0; - - - -################################################## -# Check for sudo access to root # -################################################## - -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; @@ -2176,11 +2916,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] =~ m?^/?)? 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. ################################################## @@ -2191,34 +2928,58 @@ 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 "-CONTINUE"){$force_continue = 1; - $more = "cat"; - 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, + '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"; + } + + ################################################## @@ -2243,58 +3004,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++) @@ -2312,7 +3024,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 ''; } @@ -2323,32 +3035,61 @@ if ($parm_exim eq "") # deal with TRUSTED_CONFIG_LIST restrictions unlink("$parm_cwd/test-config") if -e "$parm_cwd/test-config"; -symlink("$parm_cwd/confs/0000", "$parm_cwd/test-config") - or die "Unable to link initial config into place: $!\n"; +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"); -open(EXIMINFO, "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd " . - "-bP exim_user exim_group|") || - die "** Cannot run $parm_exim: $!\n"; -while(<EXIMINFO>) + +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); } - } -else - { - print "Unable to extract exim_user from binary.\n"; - print "Check if Exim refused to run; if so, consider:\n"; - print " TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS\n"; - die "Failing to get information from binary.\n"; - } +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) { @@ -2356,7 +3097,46 @@ if (defined $parm_eximgroup) else { $parm_exim_gid = getgrnam($parm_eximgroup); } } -open(EXIMINFO, "$parm_exim -bV -C $parm_cwd/test-config -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"; @@ -2365,7 +3145,8 @@ while (<EXIMINFO>) { my(@temp); - if (/^Exim version/) { print; } + if (/^(Exim|Library) version/) { print; } + if (/Runtime: /) {print; } elsif (/^Size of off_t: (\d+)/) { @@ -2423,12 +3204,21 @@ 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"; @@ -2442,7 +3232,7 @@ unlink("$parm_cwd/test-config"); # 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; @@ -2453,7 +3243,7 @@ if (defined $parm_support{'Content_Scanning'}) # 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. @@ -2493,7 +3283,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'SpamAssassin'} = ' '; + $parm_running{SpamAssassin} = ' '; print " SpamAssassin (spamd) seems to be running\n"; } } @@ -2512,11 +3302,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) { @@ -2527,7 +3317,7 @@ if (defined $parm_support{'Content_Scanning'}) # Read the ClamAV configuration file and find the socket interface. - if ($clamconf ne "") + if ($clamconf ne '') { my $socket_domain; open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n"; @@ -2614,7 +3404,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'ClamAV'} = ' '; + $parm_running{ClamAV} = ' '; print " ClamAV seems to be running\n"; } } @@ -2634,6 +3424,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 # ################################################## @@ -2641,21 +3447,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"; @@ -2677,8 +3483,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"; @@ -2692,9 +3498,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; } @@ -2714,7 +3520,7 @@ $pwcomm = $pwcomm; $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) @@ -2723,6 +3529,12 @@ unless (defined $parm_eximgroup) 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/) @@ -2737,40 +3549,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 @@ -2779,7 +3586,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>"; @@ -2792,23 +3599,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>"; @@ -2816,21 +3623,24 @@ 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/)? "" : +$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; + my(@comps) = split /:/, $parm_ipv6_stripped; my(@nibbles); foreach $comp (@comps) { @@ -2843,8 +3653,16 @@ if ($parm_ipv6 =~ /^[\da-f]/) # 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 !~ /\./) @@ -2857,6 +3675,12 @@ 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"; + } + ################################################## @@ -2899,8 +3723,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. @@ -2910,7 +3734,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 # ################################################## @@ -2921,10 +3744,10 @@ system("sudo cp eximdir/exim eximdir/exim_exim;" . ($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?; $dbm_build_deleted = 0; -if (defined $parm_lookups{'dbm'} && +if (defined $parm_lookups{dbm} && system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0) { - delete $parm_lookups{'dbm'}; + delete $parm_lookups{dbm}; $dbm_build_deleted = 1; } @@ -2953,6 +3776,15 @@ if (system("cp $parm_exim_dir/eximstats eximdir") != 0) tests_exit(-1, "Failed to make a copy of eximstats: $!"); } +# 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"; + ################################################## # Check that the Exim user can access stuff # @@ -2968,6 +3800,11 @@ 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 ..."; @@ -2990,6 +3827,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 # @@ -3003,31 +3842,21 @@ 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); - -# Remove . and .. and CVS from the list. -for ($i = 0; $i < @test_dirs; $i++) - { - my($d) = $test_dirs[$i]; - if ($d eq "." || $d eq ".." || $d eq "CVS") - { - splice @test_dirs, $i, 1; - $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 - -for ($i = 0; $i < @test_dirs; $i++) +# HS12: Needs to be reworked. +DIR: for (my $i = 0; $i < @test_dirs; $i++) { my($testdir) = $test_dirs[$i]; my($wantthis) = 1; @@ -3037,19 +3866,19 @@ for ($i = 0; $i < @test_dirs; $i++) # 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+$//; @@ -3077,12 +3906,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 { @@ -3096,26 +3958,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; ################################################## @@ -3179,8 +4044,8 @@ 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"; +symlink('/bin/sh' => 'aux-var/sh'); +$ENV{SHELL} = $parm_shell = "$parm_cwd/aux-var/sh"; ################################################## # Create fake DNS zones for this host # @@ -3200,7 +4065,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); } @@ -3208,32 +4073,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($exp_v6) = $parm_ipv6; + my($exp_v6) = $parm_ipv6_stripped; $exp_v6 =~ s/[^:]//g; - if ( $parm_ipv6 =~ /^([^:].+)::$/ ) { + if ( $parm_ipv6_stripped =~ /^([^:].+)::$/ ) { $exp_v6 = $1 . ':0' x (9-length($exp_v6)); - } elsif ( $parm_ipv6 =~ /^(.+)::(.+)$/ ) { + } elsif ( $parm_ipv6_stripped =~ /^(.+)::(.+)$/ ) { $exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2; - } elsif ( $parm_ipv6 =~ /^::(.+[^:])$/ ) { + } elsif ( $parm_ipv6_stripped =~ /^::(.+[^:])$/ ) { $exp_v6 = '0:' x (9-length($exp_v6)) . $1; } else { - $exp_v6 = $parm_ipv6; + $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") || @@ -3282,45 +4158,55 @@ 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: "; -$_ = $force_continue ? "c" : <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 = ""; 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; + + (local $testno = $test) =~ s|.*/||; - my($gnutls) = 0; - my($docheck) = 1; - my($thistestdir) = substr($test, 0, -5); + # 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 @@ -3351,6 +4237,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 @@ -3358,9 +4245,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. @@ -3383,6 +4282,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; } @@ -3423,7 +4324,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 @@ -3431,17 +4332,18 @@ 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_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE); my($cmdrc) = $?; @@ -3498,16 +4400,43 @@ foreach $test (@test_list) print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] "; $_ = $force_continue ? "c" : <T>; tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue); - print "... continue forced\n" if $force_continue; + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, "exit code unexpected"); + log_test($log_summary_filename, $testno, 'F') + } + 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'; } } @@ -3526,7 +4455,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 @@ -3537,7 +4467,10 @@ foreach $test (@test_list) print "\nShow server stdout, Retry, Continue, or Quit? [Q] "; $_ = $force_continue ? "c" : <T>; tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue); + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, "exit code unexpected"); + log_test($log_summary_filename, $testno, 'F') + } print "... continue forced\n" if $force_continue; last if /^[rc]$/i; @@ -3557,8 +4490,9 @@ 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) { @@ -3569,14 +4503,17 @@ foreach $test (@test_list) if ($docheck) { - if (check_output($TEST_STATE->{munge}) != 0) + sleep 1 if $slow; + my $rc = check_output($TEST_STATE->{munge}); + log_test($log_summary_filename, $testno, 'P') if ($rc == 0); + if ($rc < 2) { - print (("#" x 79) . "\n"); - redo; + print (" Script completed\n"); } else { - print (" Script completed\n"); + print (("#" x 79) . "\n"); + redo; } } } @@ -3586,8 +4523,84 @@ foreach $test (@test_list) # Exit from the test script # ################################################## -tests_exit(-1, "No runnable tests selected") if @test_list == 0; +tests_exit(-1, "No runnable tests selected") if not @test_list; tests_exit(0); +__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 -# vim: set sw=2 et :