X-Git-Url: https://git.exim.org/users/heiko/exim.git/blobdiff_plain/9edef117a1372fa54f898d172be1661eb058e940..refs/remotes/ius/master:/test/runtest diff --git a/test/runtest b/test/runtest index 4ad1fc060..f68b3c057 100755 --- a/test/runtest +++ b/test/runtest @@ -16,9 +16,9 @@ ############################################################################### #use strict; -use 5.010; -use feature 'state'; # included in 5.010 +use v5.10.1; use warnings; +use if $^V >= v5.19.11, experimental => 'smartmatch'; use Errno; use FileHandle; @@ -26,17 +26,24 @@ use Socket; use Time::Local; use Cwd; use File::Basename; -use FindBin qw'$Bin'; +use Pod::Usage; +use Getopt::Long; +use FindBin qw'$RealBin'; -use lib "$Bin/lib"; +use lib "$RealBin/lib"; use Exim::Runtest; +use Exim::Utils qw(uniq numerically); -use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); +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 @@ -44,33 +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; +my $gnutls_dh_bits_normal = 2236; -$cf = "bin/cf -exact"; -$cr = "\r"; -$debug = 0; -$flavour = do { - my $f = Exim::Runtest::flavour(); +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'; }; -$force_continue = 0; -$force_update = 0; -$log_failed_filename = "failed-summary.log"; -$more = "less -XF"; -$optargs = ""; -$save_output = 0; -$server_opts = ""; -$valgrind = 0; - -$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 $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 @@ -83,17 +88,17 @@ $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 @@ -103,10 +108,8 @@ my $parm_mailgroup = Exim::Runtest::mailgroup('mail'); # 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}; +# 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); @@ -359,6 +362,7 @@ 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 @@ -421,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/; @@ -461,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 @@ -553,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 @@ -802,7 +804,10 @@ 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 ======== @@ -886,15 +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 ======== @@ -960,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 @@ -1073,11 +1088,20 @@ RESET_AFTER_EXTRA_LINE_READ: # Not all platforms build with DKIM enabled next if /^PDKIM >> Body data for hash, canonicalized/; + # 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 /^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$/; @@ -1133,6 +1157,9 @@ RESET_AFTER_EXTRA_LINE_READ: { # 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/; } # ======== All files other than stderr ======== @@ -1200,6 +1227,15 @@ sub log_failure { . "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"; +} + ################################################## @@ -1217,8 +1253,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. @@ -1246,9 +1283,12 @@ if (! -e $sf_current) { $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue); tests_exit(1) if /^q?$/; - log_failure($log_failed_filename, $testno, $rf) if (/^c$/ && $force_continue); - return 0 if /^c$/i; - last if (/^s$/); + 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) @@ -1267,8 +1307,11 @@ if (! -e $sf_current) { $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue); tests_exit(1) if /^q?$/; - log_failure($log_failed_filename, $testno, $rsf) if (/^c$/ && $force_continue); - return 0 if /^c$/i; + 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); } } @@ -1281,6 +1324,8 @@ if (! -e $sf_current) 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"; @@ -1389,9 +1434,12 @@ if (-e $sf_current) . ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : '') . ' & retry, Quit? [Q] ', $force_update, $force_continue); tests_exit(1) if /^q?$/; - log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue); - return 0 if /^c$/i; - return 1 if /^r$/i; + 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); } } @@ -1400,23 +1448,23 @@ if (-e $sf_current) if (-s $mf) { - my $sf = /^u/i ? $sf_current : $sf_flavour; - 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 { - # 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); - } + # 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; } @@ -1480,7 +1528,7 @@ $munges = )($|[ ]=)/x' }, 'sys_bindir' => - { 'mainlog' => 's%/(usr/)?bin/%SYSBINDIR/%' }, + { 'mainlog' => 's%/(usr/(local/)?)?bin/%SYSBINDIR/%' }, 'sync_check_data' => { 'mainlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1/', @@ -1496,6 +1544,12 @@ $munges = }; +sub max { + my ($a, $b) = @_; + return $a if ($a > $b); + return $b; +} + ################################################## # Subroutine to check the output of a test # ################################################## @@ -1512,47 +1566,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. @@ -1590,9 +1645,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"}; } @@ -1607,7 +1662,10 @@ if (! $message_skip) { $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue); tests_exit(1) if /^q?$/; - log_failure($log_failed_filename, $testno, "missing email") if (/^c$/ && $force_continue); + 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 @@ -1662,9 +1720,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"}; } } @@ -1691,7 +1749,10 @@ if (! $msglog_skip) { $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue); tests_exit(1) if /^q?$/; - log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/ && $force_continue); + if (/^c$/ && $force_continue) { + log_failure($log_failed_filename, $testno, "missing msglog"); + log_test($log_summary_filename, $testno, 'F') + } last if /^c$/; if (/^u$/) { @@ -1741,7 +1802,7 @@ system("$cmd"); # The