use Pod::Usage;
use Getopt::Long;
use FindBin qw'$RealBin';
+use File::Copy;
use lib "$RealBin/lib";
use Exim::Runtest;
-use Exim::Utils qw(uniq numerically);
+use Exim::Utils qw(uniq numerically cp);
use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Smart::Comments' => '####';
use if $ENV{DEBUG} && scalar($ENV{DEBUG} =~ /\bruntest\b/) => 'Data::Dumper';
$date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}";
+# Debug time & pid
+
+$time_pid = "(?:\\d{2}:\\d{2}:\\d{2}\\s+\\d+\\s)";
+
# Pattern for matching pids at start of stderr lines; initially something
# that won't match.
# Replace the Exim version number (may appear in various places)
# patchexim should have fixed this for us
- #s/(Exim) \d+\.\d+[\w_-]*/$1 x.yz/i;
+ #s/Exim \K\d+[._]\d+[\w_-]*/x.yz/i;
# Replace Exim message ids by a unique series
- s/((?:[^\W_]{6}-){2}[^\W_]{2})
+ s/(\d[^\W_]{5}-[^\W_]{6}-[^\W_]{2})
/new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
# The names of lock files appear in some error and debug messages
# LibreSSL
# TLSv1:AES256-GCM-SHA384:256
# TLSv1:ECDHE-RSA-CHACHA20-POLY1305:256
+ # TLS1.3:AEAD-AES256-GCM-SHA384:256
#
# ECDHE-RSA-CHACHA20-POLY1305
# AES256-GCM-SHA384
s/(?<!-)(AES256-GCM-SHA384)/RSA-$1/;
+ s/AEAD-(AES256-GCM-SHA384)/RSA-$1/g;
s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-(AES256|CHACHA20)-(GCM-SHA384|POLY1305)(?!:)/ke-$3-AES256-SHAnnn/g;
s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-(AES256|CHACHA20)-(GCM-SHA384|POLY1305):256/ke-$3-AES256-SHAnnn:xxx/g;
s/\bgid=\d+/gid=gggg/;
s/\begid=\d+/egid=gggg/;
- s/\b(pid=|PID: )\d+/$1pppp/;
+ s/\b(pid=|pid |PID: )\d+/$1pppp/;
s/\buid=\d+/uid=uuuu/;
s/\beuid=\d+/euid=uuuu/;
s/set_process_info:\s+\d+/set_process_info: pppp/;
- s/queue run pid \d+/queue run pid ppppp/;
s/process \d+ running as transport filter/process pppp running as transport filter/;
s/process \d+ writing to transport filter/process pppp writing to transport filter/;
s/reading pipe for subprocess \d+/reading pipe for subprocess pppp/;
s/remote delivery process \d+ ended/remote delivery process pppp ended/;
# Pid in temp file in appendfile transport
- s"test-mail/temp\.\d+\."test-mail/temp.pppp.";
+ s"test-mail/(subdir/)?temp\K\.\d+\.".pppp.";
# Optional pid in log lines
s/^(\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d)(\.\d{3}|)(\s[+-]\d{4}|)(\s\[\d+\])/
# This handles "connection from" and the like, when the port is given
if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/
- && !/\*>/ && !/Connection refused/)
+ && !/\*>/&& !/==/ && !/\*\*/ && !/Connection refused/ && !/in response to/)
{
s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie;
}
# ======== IP error numbers and messages ========
# These vary between operating systems
- s/Can't assign requested address/Network Error/;
- s/Cannot assign requested address/Network Error/;
+ s/Can(no|')t assign requested address/Network Error/;
s/Operation timed out/Connection timed out/;
s/Address family not supported by protocol family/Network Error/;
- s/Network is unreachable/Network Error/;
+ s/Network( is)? unreachable/Network Error/;
s/Invalid argument/Network Error/;
s/\(\d+\): Network/(dd): Network/;
# The sizes of filter files may vary because of the substitution of local
# filenames, logins, etc.
- s/^\d+(?= bytes read from )/ssss/;
+ s/^\d+(?= (\(tainted\) )?bytes read from )/ssss/;
# ======== OpenSSL error messages ========
s/(TLS error on connection from .* \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
next if /SSL verify error: depth=0 error=certificate not trusted/;
+ # OpenSSL 3.0.0
+ s/TLS error \(D-H param setting .* error:\K.*dh key too small/xxxxxxxx:SSL routines::dh key too small/;
+
# ======== Maildir things ========
# timestamp output in maildir processing
s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g;
s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/;
# Maildir file names in general
- s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/;
+ s/\b\d+\.M\d+P\d+\b/dddddddddd.HddddddPddddd/;
# Maildirsize data
while (/^\d+S,\d+C\s*$/)
# SRS timestamps and signatures vary by hostname and from run to run
- s/SRS0=....=..=[^=]+=[^@]+\@test.ex/SRS0=ZZZZ=YY=the.local.host.name=CALLER\@test.ex/;
+ s/(?i)SRS0=....=.[^=]?=([^=]+)=([^@]+)\@([^ ]+)/SRS0=ZZZZ=YY=$1=$2\@$3/g;
# ======== Output from the "fd" program about open descriptors ========
s/^\d\d\d(?=[PFS*])/ddd/;
- # ========= Exim lookups ==================
- # Lookups have a char which depends on the number of lookup types compiled in,
- # in stderr output. Replace with a "0". Recognising this while avoiding
- # other output is fragile; perhaps the debug output should be revised instead.
- s%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
-
# ==========================================================
# MIME boundaries in RFC3461 DSN messages
s/\d{8,10}-eximdsn-\d+/NNNNNNNNNN-eximdsn-MMMMMMMMMM/;
+ # Cyrus SASL library version differences (rejectlog)
+ s/Cyrus SASL permanent failure: \Kuser not found$/generic failure/;
+
# ==========================================================
# Some munging is specific to the specific file types
s/conversion: german.xn--strae-oqa.de/conversion: german.straße.de/;
# subsecond timstamp info in reported header-files
- s/^(-received_time_usec \.)\d{6}$/$1uuuuuu/;
+ s/^-received_time_usec \.\K\d{6}$/uuuuuu/;
+ s/^-received_time_complete \K\d+\.\d{6}$/tttt.uuuuuu/;
# Postgres server takes varible time to shut down; lives in various places
s/^waiting for server to shut down\.+ done$/waiting for server to shut down.... done/;
# ARC is not always supported by the build
next if /^arc_sign =/;
+ # LIMITS is not always supported by the build
+ next if /^limits_advertise_hosts =/;
+
# TLS resumption is not always supported by the build
next if /^tls_resumption_hosts =/;
next if /^-tls_resumption/;
+
+ # gsasl library version may not support some methods
+ s/250-AUTH ANONYMOUS PLAIN SCRAM-SHA-1\K SCRAM-SHA-256//;
}
# ======== stderr ========
s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
s/^(proxy-proc \w{5}-pid) \d+$/$1 pppp/;
s/^(?:\s*\d+ )(exec .* -oPX)$/pppp $1/;
+ next if /(?:postfork: | fork(?:ing|ed) for )/;
# IP address lookups use gethostbyname() when IPv6 is not supported,
# and gethostbyname2() or getipnodebyname() when it is.
s/\b(gethostbyname2?|\bgetipnodebyname)(\(af=inet\))?/get[host|ipnode]byname[2]/;
+ # Extra lookups done when ipv6 is supported
+ next if /^host_fake_gethostbyname\(af=inet6\) returned 1 \(HOST_NOT_FOUND\)$/;
+
# we don't care what TZ enviroment the testhost was running
next if /^Reset TZ to/;
+ # ========= Exim lookups ==================
+ # Lookups have a char which depends on the number of lookup types compiled in,
+ # in stderr output. Replace with a "0". Recognising this while avoiding
+ # other output is fragile; perhaps the debug output should be revised instead.
+ s%^\s+(:?closing )?\K[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
+
# drop gnutls version strings
next if /GnuTLS compile-time version: \d+[\.\d]+$/;
next if /GnuTLS runtime version: \d+[\.\d]+$/;
+ # and unwanted debug
+ next if /^GnuTLS<2>: FIPS140-2 (context is not set|operation mode switched from initial to not-approved)$/;
+ next if /^GnuTLS<3>: ASSERT: sign.c\[_gnutls_sign_is_secure2\]:\d+$/;
# drop openssl version strings
next if /OpenSSL compile-time version: OpenSSL \d+[\.\da-z]+/;
# this is timing-dependent
next if /^OpenSSL: creating STEK$/;
+ next if /^selfsign cert rotate$/;
+
+ # TLS preload
+ # only OpenSSL speaks of these
+ next if /^TLS: (preloading (DH params|ECDH curve|CA bundle) for server|generating selfsigned server cert)/;
+ next if /^Diffie-Hellman initialized from default/;
+ next if /^ECDH OpenSSL (< )?[\d.+]+: temp key parameter settings:/;
+ next if /^ECDH: .*'prime256v1'/;
+ next if /^tls_verify_certificates: system$/;
+ next if /^tls_set_watch: .*\/cert.pem/;
+ next if /^Generating 2048 bit RSA key/;
+
+ # TLS preload
+ # only GnuTLS speaks of these
+ next if /^GnuTLS global init required$/;
+ next if /^TLS: basic cred init, server/;
+ next if /^TLS: preloading cipher list for server: NULL$/;
+ s/^GnuTLS using default session cipher\/priority "NORMAL"$/TLS: not preloading cipher list for server/;
+ next if /^GnuTLS<2>: added \d+ protocols, \d+ ciphersuites, \d+ sig algos and \d+ groups into priority list$/;
+ next if /^GnuTLS<2>: (Disabling X.509 extensions|signing structure using RSA-SHA256)/;
+ next if /^GnuTLS.*(wrap_nettle_mpi_print|gnutls_subject_alt_names_get|get_alt_name)/;
+ next if /^GnuTLS<[23]>: (p11|ASSERT: pkcs11.c|Initializing needed PKCS #11 modules)/;
+ next if /^GnuTLS<2>: Intel (AES|GCM) accelerator was detected/;
+ next if /^Added \d{3} certificate authorities/;
+ next if /^TLS: not preloading CRL for server/;
+ next if /^GnuTLS<3>: ASSERT: extensions.c\[_gnutls_get_extension/;
+ next if /^GnuTLS<3>: ASSERT: \.\.\/\.\.\/\.\.\/lib\/x509\//;
+ next if /^GnuTLS<2>: Initializing PKCS #11 modules/;
+
+
+ # only kevent platforms (FreeBSD, OpenBSD) say this
+ next if /^watch dir/;
+ next if /^watch file .*\/usr\/local/;
+ next if /^watch file .*\/etc\/ssl/;
+ next if /^closing watch fd:/;
+
+ # TLS preload
+ # there happen in different orders for OpenSSL/GnuTLS/noTLS
+ next if /^TLS: generating selfsigned server cert/;
+ next if /^TLS: not preloading (CA bundle|cipher list) for server$/;
+ next if /^TLS: not preloading server certs$/;
# drop lookups
- next if /^Lookups \(built-in\):/;
- next if /^Loading lookup modules from/;
- next if /^Loaded \d+ lookup modules/;
- next if /^Total \d+ lookups/;
+ next if /^$time_pid?(?: Lookups\ \(built-in\):
+ | Loading\ lookup\ modules\ from
+ | Loaded\ \d+\ lookup\ modules
+ | Total\ \d+\ lookups)/x;
# drop compiler information
- next if /^Compiler:/;
+ next if /^$time_pid?Compiler:/;
# and the ugly bit
# different libraries will have different numbers (possibly 0) of follow-up
# lines, indenting with more data
- if (/^Library version:/) {
+ if (/^$time_pid?Library version:/) {
while (1) {
$_ = <IN>;
- next if /^\s/;
+ next if /^$time_pid?\s/;
goto RESET_AFTER_EXTRA_LINE_READ;
}
}
# drop other build-time controls emitted for debugging
- next if /^WHITELIST_D_MACROS:/;
- next if /^TRUSTED_CONFIG_LIST:/;
+ next if /^$time_pid?WHITELIST_D_MACROS:/;
+ next if /^$time_pid?TRUSTED_CONFIG_LIST:/;
# As of Exim 4.74, we log when a setgid fails; because we invoke Exim
# with -be, privileges will have been dropped, so this will always
# drop pdkim debugging header
next if /^DKIM( <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+|: no signatures)$/;
+ # Some platforms have TIOCOUTome do not
+ next if /\d+ bytes remain in socket output buffer$/;
# Various other IPv6 lines must be omitted too
next if /using host_fake_gethostbyname for \S+ \(IPv6\)/;
next;
}
- # Non-TLS bulds have a different Recieved: header expansion
- s/^((.*)\t}}}}by \$primary_hostname \$\{if def:received_protocol \{with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
- s/^((\s*).*considering: with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
- if (/condition: def:tls_in_cipher_std$/)
+ # Non-TLS builds have a different default Recieved: header expansion
+ s/^((.*)\t}}}}by \$primary_hostname \$\{if def:received_protocol \{with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_ver { (\$tls_in_ver)}}\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
+ s/^((\s*).*considering: with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_ver { (\$tls_in_ver)}}\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
+ if (/condition: def:tls_in_ver$/)
{
$_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
$_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
- $_= <IN>; $_= <IN>; $_= <IN>; next;
+ $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
+ $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
+ $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; next;
}
# timing variance, run-to-run
s/^time on queue = \K1s/0s/;
+ # content-scan: file order can vary in directory
+ s%unspool_mbox\(\): unlinking 'TESTSUITE/spool/scan/[^/]*/\K[^\']*%FFFFFFFFF%;
+
# Skip hosts_require_dane checks when the options
# are unset, because dane ain't always there.
next if /in\shosts_require_dane\?\sno\s\(option\sunset\)/x;
+ # daemon notifier socket
+ s/^(\s*\d+|ppppp) (creating notifier socket)$/ppppp $2/;
+ s/^ \@(.*exim_daemon_notify)$/ $1/;
+ s/^(\s*\d+|ppppp) \@?(.*exim_daemon_notify)$/ppppp $2/;
+ next if /unlinking notifier socket/;
+
+ # daemon notifier socket
+ # Timing variance over runs. Collapse repeated memssages.
+ if (/notify triggered queue run/)
+ {
+ my $line = $_;
+ while (/notify triggered queue run/) { $_ = <IN>; }
+ $_ = $line . $_;
+ }
+
+ # Different builds will have different lookup types included
+ s/^\s*search_type \K\d+ \((\w+)\) quoting -1 \(none\)$/NN ($1) quoting -1 (none)/;
+
# DISABLE_OCSP
next if /in hosts_requ(est|ire)_ocsp\? (no|yes)/;
# Experimental_REQUIRETLS
next if / in tls_advertise_requiretls?\? no \(end of list\)/;
+ # Experimental_LIMITS
+ next if / in limits_advertise_hosts?\? no \(matched "!\*"\)/;
+
# TCP Fast Open
next if /^(ppppp )?setsockopt FASTOPEN: Network Error/;
next if /\w+ in keep_environment\? (yes|no)/;
# Sizes vary with test hostname
- s/^cmd buf flush \d+ bytes$/cmd buf flush ddd bytes/;
+ s/^cmd buf flush \d+ bytes/cmd buf flush ddd bytes/;
# Spool filesystem free space changes on different systems.
s/^((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/;
next if /^Waiting for MySQL server to answer/;
next if /mysqladmin: CREATE DATABASE failed; .* database exists/;
+ # Postgres version-dependent differences
+ s/^initdb: warning: (enabling "trust" authentication for local connections)$/\nWARNING: $1/;
+
# Not all builds include DMARC
next if /^DMARC: no (dmarc_tld_file|sender_host_address)$/ ;
s/^errno = \d+$/errno = EEE/;
s/^writing error \d+: /writing error EEE: /;
+ # Time-only, in debug output
+ # we have to handle double lines from the DBOPEN, hence placed down here and /mg
+ s/^\d\d:\d\d:\d\d\s+/01:01:01 /mg;
+
+ # pid in debug lines
+ s/^(\d\d:\d\d:\d\d)(\s+\d+\s)/"$1 " . new_value($2, "%s", \$next_pid) . " "/mgxe;
+ s/(?<!post-)[Pp]rocess\K(\s\d+ )/new_value($1, "%s", \$next_pid) . " "/gxe;
+
# When Exim is checking the size of directories for maildir, it uses
# the check_dir_size() function to scan directories. Of course, the order
# of the files that are obtained using readdir() varies from system to
# Skip some lines that Exim puts out at the start of debugging output
# because they will be different in different binaries.
- print MUNGED
- unless (/^Berkeley DB: / ||
- /^Probably (?:Berkeley DB|ndbm|GDBM)/ ||
- /^Authenticators:/ ||
- /^Lookups:/ ||
- /^Support for:/ ||
- /^Routers:/ ||
- /^Transports:/ ||
- /^Malware:/ ||
- /^log selectors =/ ||
- /^cwd=/ ||
- /^Fixed never_users:/ ||
- /^Configure owner:/ ||
- /^Size of off_t:/
- );
-
-
+ next if /^$time_pid?
+ (?: Berkeley\ DB:\s
+ | Probably\ (?:Berkeley\ DB|ndbm|GDBM)
+ | Using\ tdb
+ | Authenticators:
+ | Lookups(?:\(built-in\))?:
+ | Support\ for:
+ | Routers:
+ | Transports:
+ | Malware:
+ | log\ selectors\ =
+ | cwd=
+ | Fixed\ never_users
+ | Configure\ owner
+ | Size\ of\ off_t:
+ )
+ /x;
+
+ print MUNGED;
}
next;
my ($prefix, $t_diff) = ($1, $3 - $2);
s/DKIM: d=.* t=[0-9]* x=[0-9]* /${prefix} t=T x=T+${t_diff} /;
}
+ # GnuTLS reports a different keysize vs. OpenSSL, for ed25519 keys
+ s/signer: [^ ]* bits:\K 256/ 253/;
+ s/public key too short:\K 256 bits/ 253 bits/;
# port numbers
s/(?:\[[^\]]*\]:|port )\K$parm_port_d/PORT_D/;
# Platform differences for errno values (eg. Hurd). Leave 0 and negative numbers alone.
s/R=\w+ T=\w+ defer\K \([1-9]\d*\): / (EEE): /;
+
+ # Platform differences in errno strings
+ s/Arg list too long/Argument list too long/;
+
+ # OpenSSL vs. GnuTLS
+ s/session: \K\((SSL_connect|gnutls_handshake)\): timed out/(tls lib connect fn): timed out/;
+ s/TLS error on connection from .*\K\((SSL_accept|gnutls_handshake)\): timed out/(tls lib accept fn): timed out/;
+ s/TLS error on connection from .*\K(SSL_accept: TCP connection closed by peer|\(gnutls_handshake\): The TLS connection was non-properly terminated.)/(tls lib accept fn): TCP connection closed by peer/;
+ s/TLS session: \K\(gnutls_handshake\): No supported application protocol could be negotiated/(SSL_connect): error: <<detail omitted>>/;
+ s/\(gnutls_handshake\): No common application protocol could be negotiated./(SSL_accept): error: <<detail omitted>>/;
}
# ======== mail ========
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;
+ copy($mf, $sf) or tests_exit(-1, "Failed to copy $mf $sf");
}
else
{
{ 'mainlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/',
'rejectlog' => 's/^(.* SMTP protocol synchronization error .* next input=.{8}).*$/$1<suppressed>/'},
- 'debuglog_stdout' =>
- { 'stdout' => 's/^\d\d:\d\d:\d\d\s+\d+ //;
- s/Process \d+ is ready for new message/Process pppp is ready for new message/'
- },
-
'timeout_errno' => # actual errno differs Solaris vs. Linux
{ 'mainlog' => 's/((?:host|message) deferral .* errno) <\d+> /$1 <EEE> /' },
foreach $mail (@mails)
{
- next if $mail eq "test-mail/oncelog";
+ next if $mail =~ /^test-mail\/oncelog(.(dir|pag|db))?$/;
$saved_mail = substr($mail, 10); # Remove "test-mail/"
$saved_mail =~ s/^$parm_caller(\/|$)/CALLER/; # Convert caller name
$prcmd =~ s/; /;\n>> /;
print ">> $prcmd\n";
}
-system("$cmd");
+system($cmd);
}
sort { $a->[0] cmp $b->[0] }
#map { [ (split)[0] =~ s/\Q$parm_ipv4/ip4.ip4.ip4.ip4/gr, $_ ] } # this is too modern for 5.10.1
map {
- (my $k = (split)[0]) =~ s/\Q$parm_ipv4/ip4.ip4.ip4.ip4/g;
+ (my $k = (split)[0]) =~ s/\Q$parm_ipv4\E/ip4.ip4.ip4.ip4/g;
[ $k, $_ ]
}
do { local $/ = "\n "; <$in> };
return $aa cmp $bb;
} @temp;
}
+ elsif ($which eq "seen")
+ {
+ @temp = sort {
+ (my $aa = $a) =~ s/^([\d.]+)/$1/;
+ (my $bb = $b) =~ s/^([\d.]+)/$1/;
+ $aa =~ s/\Q$parm_ipv4\E/ip4.ip4.ip4.ip4/;
+ $bb =~ s/\Q$parm_ipv4\E/ip4.ip4.ip4.ip4/;
+ return $aa cmp $bb;
+ } @temp;
+ }
print $out @temp;
}
close($in); # close it explicitly, otherwise $? does not get set
}
+# The "exiqgrep" command runs exiqgrep on the current spool
+
+if (/^exiqgrep(\s+.*)?/)
+ {
+ run_system("(./eximdir/exiqgrep -E ./eximdir/exim -C $parm_cwd/test-config" . ($1 || '') . ";" .
+ "echo exiqgrep exit code = \$?)" .
+ ">>test-stdout");
+ return 1;
+ }
+
+
# The "eximstats" command runs eximstats on the current mainlog
if (/^eximstats\s+(.*)/)
# The "killdaemon" command should ultimately follow the starting of any Exim
-# daemon with the -bd option. We kill with SIGINT rather than SIGTERM to stop
-# it outputting "Terminated" to the terminal when not in the background.
+# daemon with the -bd option.
if (/^killdaemon/)
{
print ">> killdaemon: recovered pid $pid\n" if $debug;
if ($pid)
{
- run_system("sudo /bin/kill -INT $pid");
+ run_system("sudo /bin/kill -TERM $pid");
wait;
}
} else {
$pid = `cat $parm_cwd/spool/exim-daemon.*`;
if ($pid)
{
- run_system("sudo /bin/kill -INT $pid");
+ run_system("sudo /bin/kill -TERM $pid");
close DAEMONCMD; # Waits for process
}
}
# Run the command, with stdin connected to a pipe, and write the stdin data
-# to it, with appropriate substitutions. If a line ends with \NONL\, chop off
-# the terminating newline (and the \NONL\). If the command contains
+# to it, with appropriate substitutions. If a starts with '>>> ', process it
+# via Perl's string eval().
+# If the command contains
# -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.
open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
CMD->autoflush(1);
-while (<SCRIPT>)
+LINE: while (<SCRIPT>)
{
$lineno++;
last if /^\*{4}\s*$/;
do_substitute($testno);
- if (/^(.*)\\NONL\\\s*$/) { print CMD $1; } else { print CMD; }
+ if (my ($cmd, $line) = /^(:\S+?:)(.*)/) {
+ $_ = $line;
+ {
+ $cmd eq ':eval:' and do {
+ $_ = eval "\"$_\"";
+ last;
+ };
+ $cmd eq ':noeol:' and do {
+ s/[\r\n]*$//;
+ last;
+ };
+ $cmd eq ':sleep:' and do {
+ sleep $_;
+ next LINE;
+ };
+ }
+ }
+ print CMD;
}
# For timeout tests, wait before closing the pipe; we expect a
'valgrind' => \$valgrind,
'range=s{2}' => \my @range_wanted,
'test=i@' => \my @tests_wanted,
+ 'fail-any!' => \my $fail_any,
'flavor|flavour=s' => \$flavour,
'help' => sub { pod2usage(-exit => 0) },
'man' => sub {
chomp(my @eximinfo = `$eximinfo 2>&1`);
die "$0: Can't run $eximinfo\n" if $? == -1;
-warn 'Got ' . $?>>8 . " from $eximinfo\n" if $?;
+warn 'Got ' . ($?>>8) . " from $eximinfo\n" if $?;
foreach (@eximinfo)
{
if (my ($version) = /^Exim version (\S+)/) {
open(TCL, $parm_trusted_config_list) or die "Can't open $parm_trusted_config_list: $!\n";
my $test_config = getcwd() . '/test-config';
die "Can't find '$test_config' in TRUSTED_CONFIG_LIST $parm_trusted_config_list."
- if not grep { /^\Q$test_config\E$/ } <TCL>;
+ if not grep { /^\Q$test_config\E$/ } <TCL>;
}
else
{
($parm_exim_dir) = $parm_exim =~ m?^(.*)/exim?;
$dbm_build_deleted = 0;
-if (defined $parm_lookups{dbm} &&
- system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
+if (defined $parm_lookups{dbm} && not cp("$parm_exim_dir/exim_dbmbuild", "eximdir/exim_dbmbuild"))
{
delete $parm_lookups{dbm};
$dbm_build_deleted = 1;
}
-if (system("cp $parm_exim_dir/exim_dumpdb eximdir") != 0)
- {
- tests_exit(-1, "Failed to make a copy of exim_dumpdb: $!");
- }
-
-if (system("cp $parm_exim_dir/exim_lock eximdir") != 0)
- {
- tests_exit(-1, "Failed to make a copy of exim_lock: $!");
- }
-
-if (system("cp $parm_exim_dir/exinext eximdir") != 0)
- {
- tests_exit(-1, "Failed to make a copy of exinext: $!");
- }
-
-if (system("cp $parm_exim_dir/exigrep eximdir") != 0)
- {
- tests_exit(-1, "Failed to make a copy of exigrep: $!");
- }
-
-if (system("cp $parm_exim_dir/eximstats eximdir") != 0)
- {
- tests_exit(-1, "Failed to make a copy of eximstats: $!");
- }
+foreach my $tool (qw(exim_dumpdb exim_lock exinext exigrep eximstats exiqgrep)) {
+ cp("$parm_exim_dir/$tool" => "eximdir/$tool")
+ or tests_exit(-1, "Failed to make a copy of $tool: $!");
+}
# Collect some version information
print '-' x 78, "\n";
print "Perl version for runtest: $]\n";
-foreach (map { "./eximdir/$_" } qw(exigrep exinext eximstats)) {
+foreach (map { "./eximdir/$_" } qw(exigrep exinext eximstats exiqgrep)) {
# fold (or unfold?) multiline output into a one-liner
print join(', ', map { chomp; $_ } `$_ --version`), "\n";
}
}
+my $failures = 0;
foreach $test (@test_list)
{
state $lasttestdir = '';
# the test-mail directory for appendfile deliveries.
system "sudo /bin/rm -rf spool test-*";
- system "mkdir test-mail 2>/dev/null";
+ mkdir "test-mail";
# A privileged Exim will normally make its own spool directory, but some of
# the tests run in unprivileged modes that don't always work if the spool
# directory isn't already there. What is more, we want anybody to be able
# to read it in order to find the daemon's pid.
- system "mkdir spool; " .
- "sudo chown $parm_eximuser:$parm_eximgroup spool; " .
+ mkdir "spool";
+ system "sudo chown $parm_eximuser:$parm_eximgroup spool; " .
"sudo chmod 0755 spool";
# Empty the cache that keeps track of things like message id mappings, and
print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
$_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
- if (/^c$/ && $force_continue) {
- log_failure($log_failed_filename, $testno, "exit code unexpected");
- log_test($log_summary_filename, $testno, 'F')
- }
+ if (/^c$/ && $force_continue)
+ {
+ log_failure($log_failed_filename, $testno, "exit code unexpected");
+ log_test($log_summary_filename, $testno, 'F');
+ $failures++;
+ }
if ($force_continue)
{
print "\nstdout tail:\n";
{
if (($? & 0xff) == 0)
{ printf("Server return code %d for test %d starting line %d", $?/256,
- $testno, $subtest_startline); }
+ $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;
- if (/^c$/ && $force_continue) {
- log_failure($log_failed_filename, $testno, "exit code unexpected");
- log_test($log_summary_filename, $testno, 'F')
- }
+ if (/^c$/ && $force_continue)
+ {
+ log_failure($log_failed_filename, $testno, "exit code unexpected");
+ log_test($log_summary_filename, $testno, 'F');
+ $failures++;
+ }
print "... continue forced\n" if $force_continue;
last if /^[rc]$/i;
{
sleep 1 if $slow;
my $rc = check_output($TEST_STATE->{munge});
- log_test($log_summary_filename, $testno, 'P') if ($rc == 0);
+ if ($rc == 0)
+ {
+ log_test($log_summary_filename, $testno, 'P');
+ }
+ else
+ {
+ $failures++;
+ }
if ($rc < 2)
{
print (" Script completed\n");
##################################################
tests_exit(-1, "No runnable tests selected") if not @test_list;
-tests_exit(0);
+tests_exit($fail_any ? $failures : 0);
__END__