#use strict;
use 5.010;
+use feature 'state'; # included in 5.010
use warnings;
use Errno;
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' => '####');
# 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 $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
# 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);
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
next if /^SSL info: SSLv2\/v3 write client hello A/;
next if /^SSL info: SSLv3 read server key exchange A/;
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/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";
}
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);
+ $_ = 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;
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);
+ $_ = 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;
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;
+ $_ = 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?$/;
log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue);
return 0 if /^c$/i;
return 1 if /^r$/i;
"spool/log/serverpaniclog",
"test-paniclog-munged",
"paniclog/$testno", 0,
- $munge->{'paniclog'});
+ $munge->{paniclog});
$yield = 1 if 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",
"spool/log/servermainlog",
"test-mainlog-munged",
"log/$testno", $sortlog,
- $munge->{'mainlog'});
+ $munge->{mainlog});
if (!$stdout_skip)
{
"test-stdout-server",
"test-stdout-munged",
"stdout/$testno", 0,
- $munge->{'stdout'});
+ $munge->{stdout});
}
if (!$stderr_skip)
"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",
"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?$/;
+ log_failure($log_failed_filename, $testno, "missing email") if (/^c$/ && $force_continue);
+ 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)
{
/new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
$yield = 1 if 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?$/;
+ log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/ && $force_continue);
+ 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 '';
}
$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 ($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;
}
# 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") ||
$_ = $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 (/^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";
# 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.
if ($retry)
projects / exim.git / blobdiff