X-Git-Url: https://git.exim.org/users/heiko/exim.git/blobdiff_plain/2d47f67729aecd3dcbacdfd303b719893f2d61fa..cd1a5fe0ed22087c6afbe585ab0206c2a4a267aa:/test/runtest diff --git a/test/runtest b/test/runtest index a0d7fd14b..bbb46542a 100755 --- a/test/runtest +++ b/test/runtest @@ -26,9 +26,9 @@ use Socket; use Time::Local; use Cwd; use File::Basename; -use FindBin qw'$Bin'; +use FindBin qw'$RealBin'; -use lib "$Bin/lib"; +use lib "$RealBin/lib"; use Exim::Runtest; use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); @@ -36,7 +36,7 @@ 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 @@ -44,33 +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; +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 $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 @@ -83,17 +84,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 +104,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 +358,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 +421,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 +455,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 +547,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 @@ -886,15 +884,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 ======== @@ -1073,11 +1081,17 @@ RESET_AFTER_EXTRA_LINE_READ: # 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$/; @@ -1200,6 +1214,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 +1240,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,8 +1270,11 @@ 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; + 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$/); } @@ -1267,8 +1294,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); } } @@ -1279,8 +1309,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"; @@ -1310,7 +1342,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: $!"); @@ -1335,7 +1367,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); @@ -1347,7 +1379,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); @@ -1389,9 +1421,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 +1435,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; } @@ -1496,6 +1531,12 @@ $munges = }; +sub max { + my ($a, $b) = @_; + return $a if ($a > $b); + return $b; +} + ################################################## # Subroutine to check the output of a test # ################################################## @@ -1512,47 +1553,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 +1632,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 +1649,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 +1707,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 +1736,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$/) { @@ -1722,9 +1770,14 @@ return $yield; # Returns: nothing sub run_system { - my $cmd = shift; - print '>> ' . $cmd =~ s/; /;\n>>/r . "\n" if $debug; - system $cmd; +my($cmd) = $_[0]; +if ($debug) + { + my($prcmd) = $cmd; + $prcmd =~ s/; /;\n>> /; + print ">> $prcmd\n"; + } +system("$cmd"); } @@ -1875,8 +1928,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"; @@ -2113,7 +2174,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) @@ -2172,9 +2233,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 @@ -2229,7 +2290,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 " . @@ -2251,7 +2312,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\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 mkdir spool/log 2>/dev/null"); run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); # Before running the command, convert the -bd option into -bdf so that an @@ -2287,7 +2348,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ my $listen_port = $1; if ($debug) { printf ">> wait-mode daemon: $cmd\n"; } - run_system('sudo mkdir spool/log 2>/dev/null'); + run_system("sudo mkdir spool/log 2>/dev/null"); run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); my $pid = fork(); @@ -2357,7 +2418,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"); @@ -2454,7 +2515,7 @@ else # '/' but exists in the file system, it's assumed to be the Exim binary. ($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV); -print "Exim binary is $parm_exim\n" if $parm_exim ne ""; +print "Exim binary is $parm_exim\n" if $parm_exim ne ''; @@ -2469,7 +2530,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; } @@ -2522,7 +2583,7 @@ $parm_cwd = Cwd::getcwd(); # 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++) @@ -2540,7 +2601,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 ''; } @@ -2560,10 +2621,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*'`; @@ -2589,21 +2653,21 @@ ___ if /^Configure owner:\s*(\d+):(\d+)/; print if /wrong owner/; } -close(EXIMINFO); -if (defined $parm_eximuser) - { - if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; } - else { $parm_exim_uid = getpwnam($parm_eximuser); } - } -else - { - print "Unable to extract exim_user from binary.\n"; - print "Check if Exim refused to run; if so, consider:\n"; - print " TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS\n"; - print "If debug permission denied, are you in the exim group?\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]"} = " "; } } @@ -2733,7 +2797,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; @@ -2784,7 +2848,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'SpamAssassin'} = ' '; + $parm_running{SpamAssassin} = ' '; print " SpamAssassin (spamd) seems to be running\n"; } } @@ -2803,11 +2867,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) { @@ -2818,7 +2882,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"; @@ -2905,7 +2969,7 @@ if (defined $parm_support{'Content_Scanning'}) } else { - $parm_running{'ClamAV'} = ' '; + $parm_running{ClamAV} = ' '; print " ClamAV seems to be running\n"; } } @@ -2928,12 +2992,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 { @@ -2948,21 +3012,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"; @@ -2984,8 +3048,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"; @@ -2999,9 +3063,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; } @@ -3086,7 +3150,7 @@ elsif ($have_ipv4 == 0) } else { - $parm_running{"IPv4"} = " "; + $parm_running{IPv4} = " "; } if (not $parm_ipv6) @@ -3094,15 +3158,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 = ""; @@ -3110,7 +3174,7 @@ elsif (!defined $parm_support{'IPv6'}) } else { - $parm_running{"IPv6"} = " "; + $parm_running{IPv6} = " "; } print "IPv4 address is $parm_ipv4\n"; @@ -3118,7 +3182,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 @@ -3180,9 +3244,13 @@ if ($parm_hostname =~ /[[:upper:]]/) # that was done above. Furthermore, we ensure that the binary is deleted at the # end of the test. First ensure the directory exists. -unlink 'eximdir/exim'; # Just in case --d 'eximdir' or mkdir('eximdir', 0710) or die "** Unable to mkdir $parm_cwd/eximdir: $!\n"; -system("sudo chgrp $parm_eximgroup eximdir"); +if (-d "eximdir") + { unlink "eximdir/exim"; } # Just in case +else + { + mkdir("eximdir", 0710) || die "** Unable to mkdir $parm_cwd/eximdir: $!\n"; + system("sudo chgrp $parm_eximgroup eximdir"); + } # The construction of the patched binary must be done as root, so we use # a separate script. As well as indicating that this is a test-harness binary, @@ -3203,10 +3271,10 @@ $SIG{PIPE} = \&pipehandler; # For some tests, we need another copy of the binary that is setuid exim rather # than root. -system('sudo cp eximdir/exim eximdir/exim_exim;' . +system("sudo cp eximdir/exim eximdir/exim_exim;" . "sudo chown $parm_eximuser eximdir/exim_exim;" . "sudo chgrp $parm_eximgroup eximdir/exim_exim;" . - 'sudo chmod 06755 eximdir/exim_exim'); + "sudo chmod 06755 eximdir/exim_exim"); ################################################## @@ -3219,10 +3287,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; } @@ -3330,6 +3398,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]; @@ -3399,7 +3469,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 @@ -3412,9 +3481,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"; + } } } @@ -3482,8 +3557,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 # @@ -3536,7 +3611,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") || @@ -3596,7 +3671,7 @@ print "\nPress RETURN to run the tests: "; $_ = $force_continue ? "c" : ; print "\n"; -$lasttestdir = ""; +$lasttestdir = ''; foreach $test (@test_list) { @@ -3617,7 +3692,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"); @@ -3661,7 +3736,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 @@ -3748,7 +3823,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 @@ -3756,7 +3831,7 @@ foreach $test (@test_list) last; } - last unless /^(#|\s*$)/; + last unless /^(?:#(?!##\s)|\s*$)/; } last if !defined $_; # Hit EOF @@ -3767,12 +3842,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"; @@ -3826,7 +3901,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"; @@ -3873,7 +3951,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; @@ -3893,9 +3974,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) { @@ -3906,14 +3987,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; } } }