#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` || '<unknown>');
# 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
-$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
# 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);
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;
}
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
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
}
# 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/;
+ 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;
# gnutls version variances
next if /^Error in the pull function./;
{
$_ .= <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$/;
# [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 { $_ = <T>; }
+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 <T>;
}
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";
}
# [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.
for (;;)
{
- print "Continue, Show, or Quit? [Q] ";
- $_ = $force_continue ? "c" : <T>;
- 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$/);
}
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);
}
}
# 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";
{
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 = <MUNGED>;
close(MUNGED);
open(SAVED, $sf_current) || tests_exit(-1, "Failed to open $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);
{
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 = <MUNGED>;
close(MUNGED);
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);
}
}
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;
}
};
+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"};
}
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)
{
($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"};
}
}
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)
{
}
-# 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";
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)
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
$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 " .
# -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");
# 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 '';
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; }
# 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++)
print "** $trybin does not exist\n";
}
}
- die "** Too many tries\n" if $parm_exim eq "";
+ die "** Too many tries\n" if $parm_exim eq '';
}
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*'`;
$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;
}
}
$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";
- 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)
{
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]"} = " "; }
}
# 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;
}
else
{
- $parm_running{'SpamAssassin'} = ' ';
+ $parm_running{SpamAssassin} = ' ';
print " SpamAssassin (spamd) seems to be running\n";
}
}
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)
{
# 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";
}
else
{
- $parm_running{'ClamAV'} = ' ';
+ $parm_running{ClamAV} = ' ';
print " ClamAV seems to be running\n";
}
}
##################################################
# 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
{
# 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";
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";
# 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;
}
}
else
{
- $parm_running{"IPv4"} = " ";
+ $parm_running{IPv4} = " ";
}
if (not $parm_ipv6)
$have_ipv6 = 0;
$parm_ipv6 = "<no IPv6 address found>";
$server_opts .= " -noipv6";
- delete($parm_support{"IPv6"});
+ delete($parm_support{IPv6});
}
elsif ($have_ipv6 == 0)
{
$parm_ipv6 = "<IPv6 testing disabled>";
$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 = "<no IPv6 support in Exim binary>";
}
else
{
- $parm_running{"IPv6"} = " ";
+ $parm_running{IPv6} = " ";
}
print "IPv4 address is $parm_ipv4\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
# 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.
($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;
}
# 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";
+ }
}
}
# 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 #
}
my(@components) = split /:/, $exp_v6;
my(@nibbles) = reverse (split /\s*/, shift @components);
- my($sep) = "";
+ my($sep) = '';
$" = ".";
open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||
# 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" : <T>;
print "\n";
-$lasttestdir = "";
+$lasttestdir = '';
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");
$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
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);
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
last;
}
- last unless /^(#|\s*$)/;
+ last unless /^(?:#(?!##\s)|\s*$)/;
}
last if !defined $_; # Hit EOF
# 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";
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";
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
- # 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)
+ 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 / users / jgh / exim.git / blobdiff