X-Git-Url: https://git.exim.org/exim.git/blobdiff_plain/df88d501afa127937c60832388a75553626c8926..43ba2742c700d625dcdcdaf7bbadc2f72776854a:/test/runtest diff --git a/test/runtest b/test/runtest index 0031cab60..b201d1cfa 100755 --- a/test/runtest +++ b/test/runtest @@ -14,11 +14,13 @@ ############################################################################### #use strict; -require Cwd; use Errno; use FileHandle; use Socket; use Time::Local; +use Cwd; +use File::Basename; +use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); # Start by initializing some global variables @@ -36,11 +38,14 @@ $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 = ""; +$flavour = 'FOO'; $have_ipv4 = 1; $have_ipv6 = 1; @@ -78,6 +83,10 @@ $parm_port_d4 = 1228; # Additional for daemon # Manually set locale $ENV{'LC_ALL'} = 'C'; +# In some environments USER does not exists, but we +# need it for some test(s) +$ENV{USER} = getpwuid($>) + if not exists $ENV{USER}; ############################################################################### @@ -163,7 +172,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")) @@ -177,7 +186,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 @@ -191,7 +200,8 @@ close(T); system("sudo /bin/rm -rf ./spool test-* ./dnszones/*") if ($rc == 0 && !$save_output); -system("sudo /bin/rm -rf ./eximdir/*"); +system("sudo /bin/rm -rf ./eximdir/*") + if (!$save_output); print "\nYou were in test $test at the end there.\n\n" if defined $test; exit $rc if ($rc >= 0); @@ -313,9 +323,12 @@ return @yield; sub munge { my($file) = $_[0]; +my($extra) = $_[1]; my($yield) = 0; my(@saved) = (); +local $_; + open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!"); my($is_log) = $file =~ /log/; @@ -335,9 +348,16 @@ $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # that are specific to certain file types, though there are also some of those # inline too. -while(<IN>) +LINE: while(<IN>) { RESET_AFTER_EXTRA_LINE_READ: + # Custom munges + if ($extra) + { + next if $extra =~ m%^/% && eval $extra; + eval $extra if $extra =~ m/^s/; + } + # Check for "*** truncated ***" $yield = 1 if /\*\*\* truncated \*\*\*/; @@ -402,6 +422,7 @@ 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/; @@ -474,20 +495,26 @@ RESET_AFTER_EXTRA_LINE_READ: 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/; + s/(QT|D)=1s/$1=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 ======== # 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. # 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 # 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 @@ -495,10 +522,15 @@ RESET_AFTER_EXTRA_LINE_READ: # Mail headers (...), log-lines X=..., client-ssl output ... # (and \b doesn't match between ' ' and '(' ) - s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.2:/$1TLSv1:/xg; + s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.[12]:/$1TLSv1:/xg; + s/\bAES128-GCM-SHA256:128\b/AES256-SHA:256/g; + s/\bAES128-GCM-SHA256\b/AES256-SHA/g; s/\bAES256-GCM-SHA384\b/AES256-SHA/g; + s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g; # GnuTLS have seen: + # 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 # @@ -507,12 +539,48 @@ RESET_AFTER_EXTRA_LINE_READ: # X=TLS1.1:RSA_AES_256_CBC_SHA1:256 # X=TLS1.0:DHE_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]:(DHE_)?RSA_AES_256_CBC_SHA(1|256):256/TLS1.x:xxxxRSA_AES_256_CBC_SHAnnn:256/g; - s/\bDHE-RSA-AES256-SHA256\b/DHE-RSA-AES256-SHA/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; + + # GnuTLS library error message changes + s/No certificate was found/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; + + # (this new one is a generic channel-read error, but the testsuite + # only hits it in one place) + s/TLS error on connection \(gnutls_handshake\): Error in the pull function\./a TLS session is required but an attempt to start TLS failed/g; + + # (replace old with new, hoping that old only happens in one situation) + s/TLS error on connection to \d{1,3}(.\d{1,3}){3} \[\d{1,3}(.\d{1,3}){3}\] \(gnutls_handshake\): A TLS packet with unexpected length was received./a TLS session is required for ip4.ip4.ip4.ip4 [ip4.ip4.ip4.ip4], but an attempt to start TLS failed/g; + s/TLS error on connection from \[127.0.0.1\] \(recv\): A TLS packet with unexpected length was received./TLS error on connection from [127.0.0.1] (recv): The TLS connection was non-properly terminated./g; + + # signature algorithm names + s/RSA-SHA1/RSA-SHA/; + + # -d produces a list of environement variables as they are checked if they exist in the + # in the environment. Unfortunately this list isn't always in the same order. For now we + # just remove this list + # + if (/^\w+ in keep_environment/) + { + my @lines = $_; + while (<IN>) + { + if (/^\w+ in keep_environment/) + { + push @lines, $_; + next; + } + print MUNGED sort grep { !/^(SHLVL|_) / } @lines; + redo LINE; + } + } # ======== Caller's login, uid, gid, home, gecos ======== @@ -527,7 +595,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 @@ -631,6 +699,7 @@ RESET_AFTER_EXTRA_LINE_READ: s/^\s+host\s(\S+)\s+(\S+)/ host $1 $2/; s/^\s+(host\s\S+\s\S+)\s+(port=.*)/ host $1 $2/; s/^\s+(host\s\S+\s\S+)\s+(?=MX=)/ $1 /; + s/^\s+host\s.*?\K\s+(ad=\S+)/ $1/; s/host\s\Q$parm_ipv4\E\s\[\Q$parm_ipv4\E\]/host ipv4.ipv4.ipv4.ipv4 [ipv4.ipv4.ipv4.ipv4]/; s/host\s\Q$parm_ipv6\E\s\[\Q$parm_ipv6\E\]/host ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6 [ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6]/; s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g; @@ -664,6 +733,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 @@ -692,8 +764,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)/; @@ -718,7 +790,7 @@ 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>>/; + s/(TLS error on connection (?:from .* )?\(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/; # ======== Maildir things ======== # timestamp output in maildir processing @@ -768,6 +840,10 @@ RESET_AFTER_EXTRA_LINE_READ: # 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+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/; + # ========================================================== # Some munging is specific to the specific file types @@ -796,6 +872,11 @@ RESET_AFTER_EXTRA_LINE_READ: next; } } + + # openssl version variances + next if /^SSL info: unknown state/; + next if /^SSL info: SSLv2\/v3 write client hello A/; + next if /^SSL info: SSLv3 read server key exchange A/; } # ======== stderr ======== @@ -813,7 +894,7 @@ RESET_AFTER_EXTRA_LINE_READ: # 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]/; # drop gnutls version strings next if /GnuTLS compile-time version: \d+[\.\d]+$/; @@ -850,7 +931,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 @@ -957,6 +1038,17 @@ RESET_AFTER_EXTRA_LINE_READ: @saved = (); } + # remote port numbers vary + s/(Connection request from 127.0.0.1 port) \d{1,5}/$1 sssss/; + + # 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; + + # Experimental_International + next if / in smtputf8_advertise_hosts\? no \(option unset\)/; + # Skip some lines that Exim puts out at the start of debugging output # because they will be different in different binaries. @@ -973,11 +1065,21 @@ RESET_AFTER_EXTRA_LINE_READ: /^Fixed never_users:/ || /^Size of off_t:/ ); + + } next; } + # ======== log ======== + + elsif ($is_log) + { + # Berkeley DB version differences + next if / Berkeley DB error: /; + } + # ======== All files other than stderr ======== print MUNGED; @@ -996,16 +1098,43 @@ return $yield; # Arguments: [0] the prompt string # [1] if there is a U in the prompt and $force_update is true -# Returns: nothing (it sets $_) +# [2] if there is a C in the prompt and $force_continue is true +# Returns: returns the answer sub interact{ print $_[0]; if ($_[1]) { $_ = "u"; print "... update forced\n"; } + elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; } else { $_ = <T>; } } +################################################## +# Subroutine to log in force_continue mode # +################################################## + +# In force_continue mode, we just want a terse output to a statically +# named logfile. If multiple files in same batch (stdout, stderr, etc) +# all have mismatches, it will log multiple times. +# +# Arguments: [0] the logfile to append to +# [1] the testno that failed +# Returns: nothing + + + +sub log_failure { + my $logfile = shift(); + my $testno = shift(); + my $detail = shift() || ''; + if ( open(my $fh, ">>", $logfile) ) { + print $fh "Test $testno $detail failed\n"; + close $fh; + } +} + + ################################################## # Subroutine to compare one output file # @@ -1020,6 +1149,7 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted +# [5] optionally, a custom munge command # # Returns: 0 comparison succeeded or differences to be ignored # 1 comparison failed; files may have been updated (=> re-compare) @@ -1027,12 +1157,18 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } # Does not return if the user replies "Q" to a prompt. sub check_file{ -my($rf,$rsf,$mf,$sf,$sortfile) = @_; +my($rf,$rsf,$mf,$sf,$sortfile,$extra) = @_; # If there is no saved file, the raw files must either not exist, or be # empty. The test ! -s is TRUE if the file does not exist or is empty. -if (! -e $sf) +# we check if there is a flavour specific file, but we remember +# the original file name as "generic" +$sf_generic = $sf; +$sf_flavour = "$sf_generic.$flavour"; +$sf_current = -e $sf_flavour ? $sf_flavour : $sf_generic; + +if (! -e $sf_current) { return 0 if (! -s $rf && (! defined $rsf || ! -s $rsf)); @@ -1043,8 +1179,9 @@ if (! -e $sf) for (;;) { print "Continue, Show, or Quit? [Q] "; - $_ = <T>; + $_ = $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$/); } @@ -1063,23 +1200,26 @@ if (! -e $sf) print "\n"; for (;;) { - interact("Continue, Update & retry, Quit? [Q] ", $force_update); + 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; last if (/^u$/i); } } +#### $_ + # Control reaches here if either (a) there is a saved file ($sf), or (b) there # was a request to create a saved file. First, create the munged file from any # data that does exist. open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); -my($truncated) = munge($rf) if -e $rf; +my($truncated) = munge($rf, $extra) if -e $rf; if (defined $rsf && -e $rsf) { print MUNGED "\n******** SERVER ********\n"; - $truncated |= munge($rsf); + $truncated |= munge($rsf, $extra); } close(MUNGED); @@ -1097,7 +1237,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 @@ -1108,7 +1248,7 @@ if (-e $sf) 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); @@ -1170,77 +1310,150 @@ if (-e $sf) # 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"; + print "** Comparison of $mf with $sf_current failed"; system("$more test-cf"); print "\n"; for (;;) { - interact("Continue, Retry, Update & retry, Quit? [Q] ", $force_update); + 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?$/i; + log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue); return 0 if /^c$/i; return 1 if /^r$/i; - last if (/^u$/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(FOO, ">$sf_current"); + close(FOO); + } + else { + tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current); + } + } return 1; } +################################################## +# Custom munges +# keyed by name of munge; value is a ref to a hash +# which is keyed by file, value a string to look for. +# Usable files are: +# paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail +# Search strings starting with 's' do substitutions; +# with '/' do line-skips. +# Triggered by a scriptfile line "munge <name>" +################################################## +$munges = + { 'dnssec' => + { 'stderr' => '/^Reverse DNS security status: unverified\n/' }, + + 'gnutls_unexpected' => + { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./' }, + + 'gnutls_handshake' => + { 'mainlog' => 's/\(gnutls_handshake\): Error in the push function/\(gnutls_handshake\): A TLS packet with unexpected length was received/' }, + + 'optional_events' => + { 'stdout' => '/event_action =/' }, + + 'optional_ocsp' => + { 'stderr' => '/127.0.0.1 in hosts_requ(ire|est)_ocsp/' }, + + 'no_tpt_filter_epipe' => + { 'stderr' => '/^writing error 32: Broken pipe$/' }, + + '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 /' }, + + 'debug_pid' => + { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d{1,5}/ppppp/g' }, + + }; + + ################################################## # Subroutine to check the output of a test # ################################################## # This function is called when the series of subtests is complete. It makes -# use of check() file, whose arguments are: +# use of check_file(), whose arguments are: # # [0] the name of the main raw output file # [1] the name of the server raw output file or undef # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted +# [5] an optional custom munge command # -# Arguments: none +# Arguments: Optionally, name of a single custom munge to run. # Returns: 0 if the output compared equal # 1 if 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", "spool/log/serverpaniclog", "test-paniclog-munged", - "paniclog/$testno", 0); + "paniclog/$testno", 0, + $munge->{'paniclog'}); $yield = 1 if check_file("spool/log/rejectlog", "spool/log/serverrejectlog", "test-rejectlog-munged", - "rejectlog/$testno", 0); + "rejectlog/$testno", 0, + $munge->{'rejectlog'}); $yield = 1 if check_file("spool/log/mainlog", "spool/log/servermainlog", "test-mainlog-munged", - "log/$testno", $sortlog); + "log/$testno", $sortlog, + $munge->{'mainlog'}); if (!$stdout_skip) { $yield = 1 if check_file("test-stdout", "test-stdout-server", "test-stdout-munged", - "stdout/$testno", 0); + "stdout/$testno", 0, + $munge->{'stdout'}); } if (!$stderr_skip) @@ -1248,7 +1461,8 @@ if (!$stderr_skip) $yield = 1 if check_file("test-stderr", "test-stderr-server", "test-stderr-munged", - "stderr/$testno", 0); + "stderr/$testno", 0, + $munge->{'stderr'}); } # Compare any delivered messages, unless this test is skipped. @@ -1287,7 +1501,8 @@ if (! $message_skip) print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug; $yield = 1 if check_file($mail, undef, "test-mail-munged", - "mail/$testno.$saved_mail", 0); + "mail/$testno.$saved_mail", 0, + $munge->{'mail'}); delete $expected_mails{"mail/$testno.$saved_mail"}; } @@ -1300,8 +1515,9 @@ if (! $message_skip) for (;;) { - interact("Continue, Update & retry, or Quit? [Q] ", $force_update); + 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; # For update, we not only have to unlink the file, but we must also @@ -1357,7 +1573,8 @@ if (! $msglog_skip) s/((?:[^\W_]{6}-){2}[^\W_]{2}) /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx; $yield = 1 if check_file("spool/msglog/$msglog", undef, - "test-msglog-munged", "msglog/$testno.$munged_msglog", 0); + "test-msglog-munged", "msglog/$testno.$munged_msglog", 0, + $munge->{'msglog'}); delete $expected_msglogs{"$testno.$munged_msglog"}; } } @@ -1382,8 +1599,9 @@ if (! $msglog_skip) for (;;) { - interact("Continue, Update, or Quit? [Q] ", $force_update); + 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) { @@ -1451,6 +1669,7 @@ system("$cmd"); # 4 EOF was encountered after an initial return code line # Optionally alse a second parameter, a hash-ref, with auxilliary information: # exim_pid: pid of a run process +# munge: name of a post-script results munger sub run_command{ my($testno) = $_[0]; @@ -1459,6 +1678,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]; @@ -1528,19 +1749,42 @@ if (/^dump\s+(\S+)/) my(@temp); 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(OUT, ">>test-stdout"); + print OUT "+++++++++++++++++++++++++++\n"; + + if ($which eq "retry") { + $/ = "\n "; + @temp = <IN>; + $/ = "\n"; + @temp = sort { - my($aa) = substr $a, 21; - my($bb) = substr $b, 21; - return $aa cmp $bb; + my($aa) = split(' ', $a); + my($bb) = split(' ', $b); + return $aa cmp $bb; } @temp; + + 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; + else + { + @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(OUT); return 1; } @@ -1636,14 +1880,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 -INT $pid"); wait; } } else { $pid = `cat $parm_cwd/spool/exim-daemon.*`; if ($pid) { - run_system("sudo /bin/kill -SIGINT $pid"); + run_system("sudo /bin/kill -INT $pid"); close DAEMONCMD; # Waits for process } } @@ -1663,6 +1907,18 @@ elsif (/^millisleep\s+(.*)$/) } +# The "munge" command selects one of a hardwired set of test-result modifications +# to be made before result compares are run agains the golden set. This lets +# us account for test-system dependent things which only affect a few, but known, +# test-cases. +# Currently only the last munge takes effect. + +if (/^munge\s+(.*)$/) + { + return (0, { munge => $1 }); + } + + # The "sleep" command does just that. For sleeps longer than 1 second we # tell the user what's going on. @@ -1713,7 +1969,8 @@ if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ || 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); @@ -1727,10 +1984,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; } @@ -1827,12 +2083,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; + $args = $6; my($envset) = (defined $1)? $1 : ""; - my($sudo) = (defined $3)? "sudo " : ""; - my($special)= (defined $4)? $4 : ""; + 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 @@ -1878,7 +2134,8 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) for ($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; } } @@ -1905,6 +2162,7 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/) if ($cmd =~ /\s-DSERVER=server\s/ && $cmd !~ /\s-DNOTDAEMON\s/) { + $pidfile = "$parm_cwd/spool/exim-daemon.pid"; if ($debug) { printf ">> daemon: $cmd\n"; } run_system("sudo mkdir spool/log 2>/dev/null"); run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); @@ -1915,12 +2173,23 @@ 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 + while (! stat("$pidfile") ) { select(undef, undef, undef, 0.3); } return 3; # Don't wait } elsif ($cmd =~ /\s-DSERVER=wait:(\d+)\s/) @@ -2016,6 +2285,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 # @@ -2053,9 +2331,10 @@ else ################################################## # If the first character of the first argument is '/', the argument is taken -# as the path to the binary. +# 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. -$parm_exim = (@ARGV > 0 && $ARGV[0] =~ m?^/?)? shift @ARGV : ""; +$parm_exim = (@ARGV > 0 && (-x $ARGV[0] or $ARGV[0] =~ m?^/?))? Cwd::abs_path(shift @ARGV) : ""; print "Exim binary is $parm_exim\n" if $parm_exim ne ""; @@ -2075,10 +2354,14 @@ while (@ARGV > 0 && $ARGV[0] =~ /^-/) { 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; } + if ($arg =~ /^-FLAVOU?R$/) { $flavour = shift; next; } } $optargs .= " $arg"; } @@ -2202,12 +2485,13 @@ symlink("$parm_cwd/confs/0000", "$parm_cwd/test-config") 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|") || + "-bP exim_user exim_group 2>&1|") || die "** Cannot run $parm_exim: $!\n"; while(<EXIMINFO>) { $parm_eximuser = $1 if /^exim_user = (.*)$/; $parm_eximgroup = $1 if /^exim_group = (.*)$/; + $parm_trusted_config_list = $1 if /^TRUSTED_CONFIG_LIST:.*?"(.*?)"$/; } close(EXIMINFO); @@ -2230,6 +2514,34 @@ if (defined $parm_eximgroup) else { $parm_exim_gid = getgrnam($parm_eximgroup); } } +# 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 { /^$test_config$/ } <TCL>; + } +else + { + die "Unable to check the TRUSTED_CONFIG_LIST, seems to be empty?\n"; + } + open(EXIMINFO, "$parm_exim -bV -C $parm_cwd/test-config -DDIR=$parm_cwd |") || die "** Cannot run $parm_exim: $!\n"; @@ -2588,7 +2900,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) @@ -2626,7 +2938,7 @@ while (($parm_ipv4 eq "" || $parm_ipv6 eq "") && ($_ = <IFCONFIG>)) $_ =~ /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)\s/i) { $ip = $1; - next if ($ip eq "127.0.0.1"); + next if ($ip =~ /^127\./ || $ip =~ /^10\./); $parm_ipv4 = $ip; } @@ -2877,7 +3189,7 @@ 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"; +print "\nTest range is $test_start to $test_end (flavour $flavour)\n"; print "Omitting \${dlfunc expansion tests (loadable module not present)\n" if $dlfunc_deleted; print "Omitting dbm tests (unable to copy exim_dbmbuild)\n" @@ -2983,7 +3295,7 @@ for ($i = 0; $i < @test_dirs; $i++) foreach $test (@testlist) { - next if $test !~ /^\d{4}$/; + next if $test !~ /^\d{4}(?:\.\d+)?$/; next if $test < $test_start || $test > $test_end; push @test_list, "$testdir/$test"; } @@ -3102,6 +3414,8 @@ if ($have_ipv6 && $parm_ipv6 ne "::1") $exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2; } elsif ( $parm_ipv6 =~ /^::(.+[^:])$/ ) { $exp_v6 = '0:' x (9-length($exp_v6)) . $1; + } else { + $exp_v6 = $parm_ipv6; } my(@components) = split /:/, $exp_v6; my(@nibbles) = reverse (split /\s*/, shift @components); @@ -3157,7 +3471,7 @@ closedir(DIR); open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!"); print "\nPress RETURN to run the tests: "; -$_ = <T>; +$_ = $force_continue ? "c" : <T>; print "\n"; $lasttestdir = ""; @@ -3167,7 +3481,7 @@ foreach $test (@test_list) local($lineno) = 0; local($commandno) = 0; local($subtestno) = 0; - local($testno) = substr($test, -4); + (local $testno = $test) =~ s|.*/||; local($sortlog) = 0; my($gnutls) = 0; @@ -3223,6 +3537,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 @@ -3230,9 +3545,20 @@ 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; } + } + # 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. @@ -3255,6 +3581,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; } @@ -3318,6 +3646,8 @@ foreach $test (@test_list) my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE); my($cmdrc) = $?; +$0 = "[runtest $testno]"; + if ($debug) { print ">> rc=$rc cmdrc=$cmdrc\n"; if (defined $run_extra) { @@ -3368,8 +3698,10 @@ foreach $test (@test_list) for (;;) { print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] "; - $_ = <T>; + $_ = $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; last if /^[rc]$/i; if (/^e$/i) { @@ -3405,8 +3737,10 @@ foreach $test (@test_list) for (;;) { print "\nShow server stdout, Retry, Continue, or Quit? [Q] "; - $_ = <T>; + $_ = $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; last if /^[rc]$/i; if (/^s$/i) @@ -3437,7 +3771,7 @@ foreach $test (@test_list) if ($docheck) { - if (check_output() != 0) + if (check_output($TEST_STATE->{munge}) != 0) { print (("#" x 79) . "\n"); redo;