X-Git-Url: https://git.exim.org/users/jgh/exim.git/blobdiff_plain/b057ad118a14ea2e8f9bc483eaf636e84b25c4be..7baddd6a8e224cde645a1ddd044e04940f4fa3b6:/test/runtest?ds=inline diff --git a/test/runtest b/test/runtest index 62281656d..c656cc50b 100755 --- a/test/runtest +++ b/test/runtest @@ -17,21 +17,26 @@ #use strict; use 5.010; +use feature 'state'; # included in 5.010 use warnings; use Errno; use FileHandle; -use IO::Socket::INET; use Socket; use Time::Local; use Cwd; use File::Basename; +use FindBin qw'$RealBin'; + +use lib "$RealBin/lib"; +use Exim::Runtest; + use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); # 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 @@ -39,30 +44,34 @@ $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; -$flavour = '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 $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 $valgrind = 0; + +my $have_ipv4 = 1; +my $have_ipv6 = 1; +my $have_largefiles = 0; + +my $test_start = 1; +my $test_end = $test_top = 8999; +my $test_special_top = 9999; +my @test_list = (); +my @test_dirs = (); # Networks to use for DNS tests. We need to choose some networks that will @@ -75,26 +84,28 @@ $test_special_top = 9999; # are defined, so it is trivially possible to change them should that ever # become necessary. -$parm_ipv4_test_net = "224"; -$parm_ipv6_test_net = "ff00"; +my $parm_ipv4_test_net = 224; +my $parm_ipv6_test_net = 'ff00'; # Port numbers are currently hard-wired -$parm_port_n = 1223; # Nothing listening on this port -$parm_port_s = 1224; # Used for the "server" command -$parm_port_d = 1225; # Used for the Exim daemon -$parm_port_d2 = 1226; # Additional for daemon -$parm_port_d3 = 1227; # Additional for daemon -$parm_port_d4 = 1228; # Additional for daemon +my $parm_port_n = 1223; # Nothing listening on this port +my $parm_port_s = 1224; # Used for the "server" command +my $parm_port_d = 1225; # Used for the Exim daemon +my $parm_port_d2 = 1226; # Additional for daemon +my $parm_port_d3 = 1227; # Additional for daemon +my $parm_port_d4 = 1228; # Additional for daemon my $dynamic_socket; # allocated later for PORT_DYNAMIC +# Find a suiteable group name for test (currently only 0001 +# uses a group name. A numeric group id would do +my $parm_mailgroup = Exim::Runtest::mailgroup('mail'); + # Manually set locale $ENV{LC_ALL} = 'C'; -# In some environments USER does not 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); @@ -149,6 +160,7 @@ 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; } @@ -408,12 +420,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/; @@ -448,7 +454,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 @@ -540,6 +546,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 @@ -873,12 +883,18 @@ 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/; + 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./; @@ -1045,6 +1061,32 @@ RESET_AFTER_EXTRA_LINE_READ: # 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/; + + # 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 @@ -1119,11 +1161,22 @@ return $yield; # [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 { $_ = ; } +sub interact { + my ($prompt, $have_u, $have_c) = @_; + + print $prompt; + + if ($have_u) { + print "... update forced\n"; + return 'u'; + } + + if ($have_c) { + print "... continue forced\n"; + return 'c'; + } + + return lc ; } @@ -1143,13 +1196,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"; } @@ -1169,8 +1231,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. @@ -1196,11 +1259,13 @@ if (! -e $sf_current) 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; + $_ = 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; last if (/^s$/); } @@ -1218,10 +1283,13 @@ if (! -e $sf_current) 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); } } @@ -1232,8 +1300,10 @@ if (! -e $sf_current) # 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"; @@ -1263,7 +1333,7 @@ if (-e $sf_current) { 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_current) || tests_exit(-1, "Failed to open $sf_current: $!"); @@ -1288,7 +1358,7 @@ if (-e $sf_current) } } - 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); @@ -1300,7 +1370,7 @@ if (-e $sf_current) { 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); @@ -1338,13 +1408,16 @@ if (-e $sf_current) print "\n"; for (;;) { - 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; + $_ = 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); } } @@ -1353,23 +1426,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; } @@ -1443,9 +1516,18 @@ $munges = { '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 # ################################################## @@ -1462,47 +1544,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. @@ -1540,9 +1623,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"}; } @@ -1555,16 +1638,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) { @@ -1612,9 +1698,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"}; } } @@ -1639,11 +1725,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) { @@ -1830,8 +1919,16 @@ if (/^dump\s+(\S+)/) } -# 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"; @@ -2068,7 +2165,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) @@ -2127,9 +2224,9 @@ if (/^client/ || /^(sudo\s+)?perl\b/) elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/) { $args = $6; - my($envset) = (defined $1)? $1 : ""; - my($sudo) = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":"") : ""; - my($special)= (defined $5)? $5 : ""; + 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 @@ -2184,7 +2281,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/; - my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : ""; + 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 " . @@ -2312,7 +2409,7 @@ else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); } # -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"); @@ -2408,8 +2505,8 @@ else # 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 && (-x $ARGV[0] or $ARGV[0] =~ m?^/?))? Cwd::abs_path(shift @ARGV) : ""; -print "Exim binary is $parm_exim\n" if $parm_exim ne ""; +($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV); +print "Exim binary is $parm_exim\n" if $parm_exim ne ''; @@ -2424,7 +2521,7 @@ print "Exim binary is $parm_exim\n" if $parm_exim ne ""; while (@ARGV > 0 && $ARGV[0] =~ /^-/) { my($arg) = shift @ARGV; - if ($optargs eq "") + if ($optargs eq '') { if ($arg eq "-DEBUG") { $debug = 1; $cr = "\n"; next; } if ($arg eq "-DIFF") { $cf = "diff -u"; next; } @@ -2475,58 +2572,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" || $f eq 'src') - { $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 ($parm_exim eq '') { print "** Did not find an Exim binary to test\n"; for ($i = 0; $i < 5; $i++) @@ -2544,7 +2592,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 ''; } @@ -2564,10 +2612,13 @@ 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 2>&1|") || - die "** Cannot run $parm_exim: $!\n"; -while() + +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*'`; @@ -2576,7 +2627,13 @@ while() $version =~ s/^\d+\K\./_/; $git =~ s/^exim-//i; $git =~ s/.*-\Kg([[:xdigit:]]+(?:-XX)?)/$1/; - print "\n*** Version mismatch (Exim: $version vs. GIT: $git). ***\n\n" + print <<___ + +*** Version mismatch +*** Exim binary: $version +*** Git : $git + +___ if not $version eq $git; } } @@ -2585,22 +2642,23 @@ while() $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/; + 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 <) 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]"} = " "; } } @@ -2730,7 +2788,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; @@ -2781,7 +2839,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'SpamAssassin'} = ' '; + $parm_running{SpamAssassin} = ' '; print " SpamAssassin (spamd) seems to be running\n"; } } @@ -2800,11 +2858,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) { @@ -2815,7 +2873,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"; @@ -2902,7 +2960,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'ClamAV'} = ' '; + $parm_running{ClamAV} = ' '; print " ClamAV seems to be running\n"; } } @@ -2925,12 +2983,12 @@ if (defined $parm_support{'Content_Scanning'}) ################################################## # Check for redis # ################################################## -if (defined $parm_lookups{'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'} = ' '; + $parm_running{redis} = ' '; } else { @@ -2945,21 +3003,21 @@ if (defined $parm_lookups{'redis'}) # 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"; @@ -2981,8 +3039,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"; @@ -2996,9 +3054,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; } @@ -3083,7 +3141,7 @@ elsif ($have_ipv4 == 0) } else { - $parm_running{"IPv4"} = " "; + $parm_running{IPv4} = " "; } if (not $parm_ipv6) @@ -3091,15 +3149,15 @@ if (not $parm_ipv6) $have_ipv6 = 0; $parm_ipv6 = ""; $server_opts .= " -noipv6"; - delete($parm_support{"IPv6"}); + delete($parm_support{IPv6}); } elsif ($have_ipv6 == 0) { $parm_ipv6 = ""; $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 = ""; @@ -3107,7 +3165,7 @@ elsif (!defined $parm_support{'IPv6'}) } else { - $parm_running{"IPv6"} = " "; + $parm_running{IPv6} = " "; } print "IPv4 address is $parm_ipv4\n"; @@ -3115,7 +3173,7 @@ print "IPv6 address is $parm_ipv6\n"; # 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 @@ -3135,8 +3193,15 @@ if ($parm_ipv6 =~ /^[\da-f]/) chomp($temp = `hostname`); die "'hostname' didn't return anything\n" unless defined $temp and length $temp; -$parm_hostname = (gethostbyname($temp))[0]; -$parm_hostname = "no.host.name.found" unless defined $parm_hostname and length $parm_hostname; +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 !~ /\./) @@ -3191,8 +3256,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. @@ -3213,10 +3278,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; } @@ -3324,6 +3389,8 @@ for ($i = 0; $i < @test_dirs; $i++) # Scan for relevant tests +tests_exit(-1, "Failed to unlink $log_summary_filename") + if (-e $log_summary_filename && !unlink($log_summary_filename)); for ($i = 0; $i < @test_dirs; $i++) { my($testdir) = $test_dirs[$i]; @@ -3393,7 +3460,6 @@ 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 @@ -3406,9 +3472,15 @@ for ($i = 0; $i < @test_dirs; $i++) foreach $test (@testlist) { - next if $test !~ /^\d{4}(?:\.\d+)?$/; - next if $test < $test_start || $test > $test_end; - push @test_list, "$testdir/$test"; + next if ($test !~ /^\d{4}(?:\.\d+)?$/); + if (!$wantthis || $test < $test_start || $test > $test_end) + { + log_test($log_summary_filename, $test, '.'); + } + else + { + push @test_list, "$testdir/$test"; + } } } @@ -3476,8 +3548,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 # @@ -3530,7 +3602,7 @@ if ($have_ipv6 && $parm_ipv6 ne "::1") } my(@components) = split /:/, $exp_v6; my(@nibbles) = reverse (split /\s*/, shift @components); - my($sep) = ""; + my($sep) = ''; $" = "."; open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") || @@ -3579,13 +3651,18 @@ 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: $!"); +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: "; $_ = $force_continue ? "c" : ; print "\n"; -$lasttestdir = ""; +$lasttestdir = ''; foreach $test (@test_list) { @@ -3606,7 +3683,7 @@ foreach $test (@test_list) $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"); @@ -3650,7 +3727,7 @@ foreach $test (@test_list) $stdout_skip = 0; $rmfiltertest = 0; $is_ipv6test = 0; - $TEST_STATE->{munge} = ""; + $TEST_STATE->{munge} = ''; # Remove the associative arrays used to hold checked mail files and msglogs @@ -3669,16 +3746,7 @@ foreach $test (@test_list) if (/^no_stdout_check/) { $stdout_skip = 1; next; } if (/^rmfiltertest/) { $rmfiltertest = 1; next; } if (/^sortlog/) { $sortlog = 1; next; } - if (/\bPORT_DYNAMIC\b/) { - for (my $port = 1024; $port < 65000; $port++) { - $dynamic_socket = IO::Socket::INET->new( - LocalHost => '127.0.0.1', - LocalPort => $port, - Listen => 10, - ReuseAddr => 1, - ) and last; - } - } + 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); @@ -3746,7 +3814,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 @@ -3754,7 +3822,7 @@ foreach $test (@test_list) last; } - last unless /^(#|\s*$)/; + last unless /^(?:#(?!##\s)|\s*$)/; } last if !defined $_; # Hit EOF @@ -3765,12 +3833,12 @@ foreach $test (@test_list) # 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) = $?; -$0 = "[runtest $testno]"; + $0 = "[runtest $testno]"; if ($debug) { print ">> rc=$rc cmdrc=$cmdrc\n"; @@ -3824,7 +3892,10 @@ $0 = "[runtest $testno]"; print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] "; $_ = $force_continue ? "c" : ; 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') + } if ($force_continue) { print "\nstderr tail:\n"; @@ -3871,7 +3942,10 @@ $0 = "[runtest $testno]"; print "\nShow server stdout, Retry, Continue, or Quit? [Q] "; $_ = $force_continue ? "c" : ; 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; @@ -3891,9 +3965,9 @@ $0 = "[runtest $testno]"; 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 - # 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) { @@ -3904,14 +3978,16 @@ $0 = "[runtest $testno]"; if ($docheck) { - if (check_output($TEST_STATE->{munge}) != 0) + 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; } } }