X-Git-Url: https://git.exim.org/exim.git/blobdiff_plain/6023a6ad2ac0294879b14127f62795095da573b5..77c27011669fef957e1b70877dbd3612a8b1014e:/test/runtest diff --git a/test/runtest b/test/runtest index 4a4427839..12b091acf 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` || ''); # 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 = '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); +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; } @@ -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() +LINE: while() { RESET_AFTER_EXTRA_LINE_READ: # Custom munges @@ -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/; @@ -417,7 +449,7 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 ======== @@ -427,7 +459,7 @@ 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; + $expired = '' if !defined $expired; my($increment) = date_seconds($date3) - date_seconds($date2); # We used to use globally unique replacement values, but timing @@ -519,6 +551,10 @@ RESET_AFTER_EXTRA_LINE_READ: s/\bAES256-GCM-SHA384\b/AES256-SHA/g; s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g; + # LibreSSL + # TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256 + s/\bECDHE-RSA-CHACHA20-POLY1305\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 @@ -643,6 +679,9 @@ 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)/; + # The spool header file name varies with PID + s%^(Writing spool header file: .*/hdr).[0-9]{1,5}%$1.pppp%; + # ======== Port numbers ======== # Incoming port numbers may vary, but not in daemon startup line. @@ -659,6 +698,10 @@ RESET_AFTER_EXTRA_LINE_READ: # Port in host address in spool file output from -Mvh s/^-host_address (.*)\.\d+/-host_address $1.9999/; + if ($dynamic_socket and $dynamic_socket->opened and my $port = $dynamic_socket->sockport) { + s/^Connecting to 127\.0\.0\.1 port \K$port//; + } + # ======== Local IP addresses ======== # The amount of space between "host" and the address in verification output @@ -704,6 +747,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 @@ -732,8 +778,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)/; @@ -758,7 +804,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 .* )?\(SSL_\w+\): error:)(.*)/$1 <>/; +#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 <>/; + s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <>/; + next if /SSL verify error: depth=0 error=certificate not trusted/; # ======== Maildir things ======== # timestamp output in maildir processing @@ -841,10 +891,25 @@ RESET_AFTER_EXTRA_LINE_READ: } } + # remote IPv6 addrs vary + s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/; + # 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/; + # 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/^\d+:error:\d+(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/; + + # 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/; } # ======== stderr ======== @@ -862,7 +927,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]+$/; @@ -910,7 +975,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 @@ -940,7 +1005,7 @@ RESET_AFTER_EXTRA_LINE_READ: # 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. @@ -985,6 +1050,59 @@ RESET_AFTER_EXTRA_LINE_READ: while () { last if !/^\s/; } } + # 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; + + # SUPPORT_PROXY + next if /host in hosts_proxy\?/; + + # Experimental_International + next if / in smtputf8_advertise_hosts\? no \(option unset\)/; + + # 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/) + { + $_ .= ; + s/\s+\}\}(?=\(Exim )/\}\} /; + } + if (/^ condition: def:tls_cipher$/) + { + ; ; ; ; ; ; + ; ; ; ; ; next; + } + + # Not all platforms build with DKIM enabled + next if /^PDKIM >> Body data for hash, canonicalized/; + + # Parts of DKIM-specific debug output depend on the time/date + next if /^date:\w+,\{SP\}/; + next if /^PDKIM \[[^[]+\] (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\)\n$//) + { + $_ .= ; + s/ \.\.\. >>> / ... /; + s/Address family not supported by protocol family/Network Error/; + s/Network is unreachable/Network Error/; + } + + next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/; + # 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 @@ -1006,14 +1124,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; - - # 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. @@ -1028,6 +1138,7 @@ RESET_AFTER_EXTRA_LINE_READ: /^log selectors =/ || /^cwd=/ || /^Fixed never_users:/ || + /^Configure owner:/ || /^Size of off_t:/ ); @@ -1064,13 +1175,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) = @_; + + print $prompt; -sub interact{ -print $_[0]; -if ($_[1]) { $_ = "u"; print "... update forced\n"; } - elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; } - else { $_ = ; } + if ($have_u) { + print "... update forced\n"; + return 'u'; + } + + if ($have_c) { + print "... continue forced\n"; + return 'c'; + } + + return lc ; } @@ -1090,13 +1212,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"; } @@ -1116,8 +1247,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. @@ -1127,7 +1259,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)); @@ -1137,12 +1275,14 @@ if (! -e $sf) for (;;) { - print "Continue, Show, or Quit? [Q] "; - $_ = $force_continue ? "c" : ; - 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/ && $rsf !~ /paniclog/; + last if (/^[sc]$/); } foreach $f ($rf, $rsf) @@ -1159,20 +1299,27 @@ if (! -e $sf) 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"; @@ -1194,7 +1341,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 @@ -1202,10 +1349,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 = ; 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 = ; close(SAVED); @@ -1227,7 +1374,7 @@ if (-e $sf) } } - open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); + open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!"); for ($i = 0; $i < @munged; $i++) { print MUNGED $munged[$i]; } close(MUNGED); @@ -1239,7 +1386,7 @@ if (-e $sf) { my(@munged, $i, $j); - open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!"); + open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!"); @munged = ; close(MUNGED); @@ -1267,33 +1414,51 @@ 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, $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(FOO, ">$sf_current"); + close(FOO); + } + else { + tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current); + } + } -return 1; +return 2; } @@ -1324,18 +1489,61 @@ $munges = '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' }, + + '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) + |gnutls_require_(kx|mac|protocols) + |hosts_(requ(est|ire)|try)_(dane|ocsp) + |hosts_(avoid|nopass|require|verify_avoid)_tls + |socks_proxy + |tls_[^ ]* + )($|[ ]=)/x' }, + + 'sys_bindir' => + { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' }, + + 'sync_check_data' => + { 'mainlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1/', + 'rejectlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1/'}, + + '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 deferral .* errno) <\d+> /$1 /' }, }; +sub max { + my ($a, $b) = @_; + return $a if ($a > $b); + return $b; +} + ################################################## # Subroutine to check the output of a test # ################################################## @@ -1352,47 +1560,48 @@ $munges = # # 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. @@ -1430,9 +1639,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"}; } @@ -1445,16 +1654,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) { @@ -1502,9 +1714,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"}; } } @@ -1529,11 +1741,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) { @@ -1581,7 +1796,7 @@ system("$cmd"); # The