my $cr = "\r";
my $debug = 0;
my $flavour = do {
- my $f = Exim::Runtest::flavour();
+ 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($is_log) = $file =~ /log/;
my($is_stdout) = $file =~ /stdout/;
my($is_stderr) = $file =~ /stderr/;
+my($is_mail) = $file =~ /mail/;
# Date pattern
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/;
# 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 <<detail omitted>>/;
+#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 <<detail omitted>>/;
+ s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
next if /SSL verify error: depth=0 error=certificate not trusted/;
# ======== Maildir things ========
}
}
+ # 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 ========
}
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
# 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$//)
{
$_ .= <IN>;
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$/;
. "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";
+}
+
##################################################
# [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.
{
$_ = 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$/);
}
{
$_ = 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);
}
}
. ($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);
}
}
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;
}
)($|[ ]=)/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<suppressed>/',
'timeout_errno' => # actual errno differs Solaris vs. Linux
{ 'mainlog' => 's/(host deferral .* errno) <\d+> /$1 <EEE> /' },
-
- 'net_unreach' => # platforms not supporting TCP Fast Open difference
- { 'stderr' => 's/failed: Network Error/failed: Network is unreachanble/' },
};
+sub max {
+ my ($a, $b) = @_;
+ return $a if ($a > $b);
+ return $b;
+}
+
##################################################
# Subroutine to check the output of a test #
##################################################
#
# 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.
}
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"};
}
{
$_ = 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
($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"};
}
}
{
$_ = 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$/)
{
# The <SCRIPT> file is open for us to read an optional return code line,
# followed by the command line and any following data lines for stdin. The
# command line can be continued by the use of \. Data lines are not continued
-# in this way. In all lines, the following substutions are made:
+# in this way. In all lines, the following substitutions are made:
#
# DIR => the current directory
# CALLER => the caller of this script
# reference to the subtest number, holding previous value
# reference to the expected return code value
# reference to where to put the command name (for messages)
-# auxilliary information returned from a previous run
+# auxiliary information returned from a previous run
#
-# Returns: 0 the commmand was executed inline, no subprocess was run
+# Returns: 0 the command was executed inline, no subprocess was run
# 1 a non-exim command was run and waited for
# 2 an exim command was run and waited for
# 3 a command was run and not waited for (daemon, server, exim_lock)
# 4 EOF was encountered after an initial return code line
-# Optionally alse a second parameter, a hash-ref, with auxilliary information:
+# Optionally also a second parameter, a hash-ref, with auxiliary information:
# exim_pid: pid of a run process
# munge: name of a post-script results munger
if ($args =~ /\$msg/)
{
- my($listcmd) = "$parm_cwd/eximdir/exim -bp " .
- "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
- "-C $parm_cwd/test-config |";
- print ">> Getting queue list from:\n>> $listcmd\n" if ($debug);
- open (QLIST, $listcmd) || tests_exit(-1, "Couldn't run \"exim -bp\": $!\n");
- my(@msglist) = ();
- while (<QLIST>) { push (@msglist, $1) if /^\s*\d+[smhdw]\s+\S+\s+(\S+)/; }
- close(QLIST);
+ my @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
+ "-DEXIM_PATH=$parm_cwd/eximdir/exim",
+ -C => "$parm_cwd/test-config");
+ print ">> Getting queue list from:\n>> @listcmd\n" if $debug;
+ # We need the message ids sorted in ascending order.
+ # Message id is: <timestamp>-<pid>-<fractional-time>. On some systems (*BSD) the
+ # PIDs are randomized, so sorting just the whole PID doesn't work.
+ # We do the Schartz' transformation here (sort on
+ # <timestamp><fractional-time>). Thanks to Kirill Miazine
+ my @msglist =
+ map { $_->[1] } # extract the values
+ sort { $a->[0] cmp $b->[0] } # sort by key
+ map { [join('.' => (split /-/, $_)[0,2]) => $_] } # key (timestamp.fractional-time) => value(message_id)
+ map { /^\s*\d+[smhdw]\s+\S+\s+(\S+)/ } `@listcmd` or tests_exit(-1, "No output from `exim -bp` (@listcmd)\n");
# Done backwards just in case there are more than 9
if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; }
if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; }
if ($arg eq "-KEEP") { $save_output = 1; next; }
+ if ($arg eq "-SLOW") { $slow = 1; next; }
if ($arg eq "-VALGRIND") { $valgrind = 1; next; }
if ($arg =~ /^-FLAVOU?R$/) { $flavour = shift; next; }
}
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(<EXIMINFO>)
+
+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*'`;
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 <<XXX, map { "|$_\n" } @eximinfo;
+Unable to extract exim_user from binary.
+Check if Exim refused to run; if so, consider:
+ TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS
+If debug permission denied, are you in the exim group?
+Failing to get information from binary.
+Output from $eximinfo:
+XXX
+
+}
+
+if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
+else { $parm_exim_uid = getpwnam($parm_eximuser); }
if (defined $parm_eximgroup)
{
# This test for an active SpamAssassin is courtesy of John Jetmore.
# The tests are hard coded to localhost:783, so no point in making
# this test flexible like the clamav test until the test scripts are
- # changed. spamd doesn't have the nice PING/PONG protoccol that
+ # changed. spamd doesn't have the nice PING/PONG protocol that
# clamd does, but it does respond to errors in an informative manner,
# so use that.
# 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];
{
chomp;
print "Omitting tests in $testdir (missing $_)\n";
- next;
}
# We want the tests from this subdirectory, provided they are in the
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";
+ }
}
}
print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
$_ = $force_continue ? "c" : <T>;
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";
if ($? != 0)
{
if (($? & 0xff) == 0)
- { printf("Server return code %d", $?/256); }
+ { printf("Server return code %d for test %d starting line %d", $?/256,
+ $testno, $subtest_startline); }
elsif (($? & 0xff00) == 0)
{ printf("Server killed by signal %d", $? & 255); }
else
print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
$_ = $force_continue ? "c" : <T>;
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;
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
- # 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)
{
if ($docheck)
{
- if (check_output($TEST_STATE->{munge}) != 0)
+ sleep 1 if $slow;
+ 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;
}
}
}
git://git.exim.org / exim.git / blobdiff