# 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
# 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
# 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
# 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
-$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 = ();
-$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
my $dynamic_socket; # allocated later for PORT_DYNAMIC
# Find a suiteable group name for test (currently only 0001
-# 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);
my ($parm_configure_owner, $parm_configure_group);
my ($parm_ipv4, $parm_ipv6);
if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
{
my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
{
my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
my($increment) = date_seconds($date3) - date_seconds($date2);
# We used to use globally unique replacement values, but timing
my($increment) = date_seconds($date3) - date_seconds($date2);
# We used to use globally unique replacement values, but timing
+# 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
#
# [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)
{
$_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue);
tests_exit(1) if /^q?$/;
{
$_ = 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;
{
$_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue);
tests_exit(1) if /^q?$/;
{
$_ = 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;
-open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
+open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
{
my(@munged, @saved, $i, $j, $k);
{
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: $!");
. ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : '')
. ' & retry, Quit? [Q] ', $force_update, $force_continue);
tests_exit(1) if /^q?$/;
. ($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;
- 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;
- # 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);
+ }
##################################################
# Subroutine to check the output of a test #
##################################################
##################################################
# 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
#
# Arguments: Optionally, name of a single custom munge to run.
# Returns: 0 if the output compared equal
- $yield = 1 if check_file($mail, undef, "test-mail-munged",
+ $yield = max($yield, check_file($mail, undef, "test-mail-munged",
{
$_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue);
tests_exit(1) if /^q?$/;
{
$_ = 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')
+ }
($munged_msglog = $msglog) =~
s/((?:[^\W_]{6}-){2}[^\W_]{2})
/new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
($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,
"test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
{
$_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue);
tests_exit(1) if /^q?$/;
{
$_ = 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')
+ }
-# 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;
+}
while (scalar @sizes > 0)
{
($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
while (scalar @sizes > 0)
{
($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
- 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 : '';
# -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.
# -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.
print ">> |${cmd}${stderrsuffix}\n" if ($debug);
open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
print ">> |${cmd}${stderrsuffix}\n" if ($debug);
open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
# '/' but exists in the file system, it's assumed to be the Exim binary.
($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);
# '/' but exists in the file system, it's assumed to be the Exim binary.
($parm_exim, @ARGV) = Exim::Runtest::exim_binary(@ARGV);
{
if ($arg eq "-DEBUG") { $debug = 1; $cr = "\n"; next; }
if ($arg eq "-DIFF") { $cf = "diff -u"; next; }
{
if ($arg eq "-DEBUG") { $debug = 1; $cr = "\n"; next; }
if ($arg eq "-DIFF") { $cf = "diff -u"; next; }
# 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.
# 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.
foreach $f ("$test_prefix/etc/clamd.conf",
"$test_prefix/usr/local/etc/clamd.conf",
foreach $f ("$test_prefix/etc/clamd.conf",
"$test_prefix/usr/local/etc/clamd.conf",
##################################################
# Check for redis #
##################################################
##################################################
# Check for 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.
# 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 .= " 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});
for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
"fakens", "iefbr14", "server")
{
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});
join(".", reverse(split /\./, $parm_ipv4));
$parm_ipv6r = $parm_ipv6; # Appropriate if not in use
join(".", reverse(split /\./, $parm_ipv4));
$parm_ipv6r = $parm_ipv6; # Appropriate if not in use
# tests_exit(), so that suitable cleaning up can be done when required.
# Arrange to catch interrupting signals, to assist with this.
# tests_exit(), so that suitable cleaning up can be done when required.
# Arrange to catch interrupting signals, to assist with this.
- 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";
+ }
-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";
}
my(@components) = split /:/, $exp_v6;
my(@nibbles) = reverse (split /\s*/, shift @components);
}
my(@components) = split /:/, $exp_v6;
my(@nibbles) = reverse (split /\s*/, shift @components);
print "\n>>> The following tests require: ";
open(IN, "scripts/$thistestdir/REQUIRES") ||
tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1");
print "\n>>> The following tests require: ";
open(IN, "scripts/$thistestdir/REQUIRES") ||
tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1");
print ">>> move frozen message support is needed for test $testno, " .
"but is not\n>>> available: skipping\n";
$docheck = 0; # don't check output
print ">>> move frozen message support is needed for test $testno, " .
"but is not\n>>> available: skipping\n";
$docheck = 0; # don't check output
# command was run and waited for, and 3 if a command
# was run and not waited for (usually a daemon or server startup).
# command was run and waited for, and 3 if a command
# was run and not waited for (usually a daemon or server startup).
my($expectrc) = 0;
my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
my($cmdrc) = $?;
my($expectrc) = 0;
my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
my($cmdrc) = $?;
print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
$_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
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')
+ }
print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
$_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
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')
+ }
- # 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.