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';
my $force_update = 0;
my $log_failed_filename = 'failed-summary.log';
my $log_summary_filename = 'run-summary.log';
-my $more = 'less -XF';
+my @more = qw'less -XF';
my $optargs = '';
my $save_output = 0;
my $server_opts = '';
$ENV{USER} = getpwuid($>) if not exists $ENV{USER};
my ($parm_configure_owner, $parm_configure_group);
-my ($parm_ipv4, $parm_ipv6);
+my ($parm_ipv4, $parm_ipv6, $parm_ipv6_stripped);
my $parm_hostname;
###############################################################################
# into the same standard values throughout the data from a single test.
# Message ids get this treatment (can't be made reliable for times), and
# times in dumped retry databases are also handled in a special way, as are
-# incoming port numbers.
+# incoming port numbers and PIDs.
# On entry to the subroutine, the file to write to is already opened with the
# name MUNGED. The input file name is the only argument to the subroutine.
$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.
LINE: while(<IN>)
{
RESET_AFTER_EXTRA_LINE_READ:
+ if ($munge_skip)
+ {
+ # Munging is a no-op.
+ # Useful when testing exim_msgdate so that
+ # we compare unmunged dates and message-ids.
+ print MUNGED;
+ next;
+ }
+
# Custom munges
if ($extra)
{
next if $extra =~ m%^/% && eval $extra;
eval $extra if $extra =~ m/^s/;
+ eval substr($extra, 1) if $extra =~ m/^R/;
}
# Check for "*** truncated ***"
# 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
# There are differences in error messages between OpenSSL versions
s/SSL_CTX_set_cipher_list/SSL_connect/;
+ s/error=\Kauthority and subject key identifier mismatch/self signed certificate/;
+ s/error=\Kself-signed certificate/self signed certificate/;
# One error test in expansions mentions base 62 or 36
s/is not a base (36|62) number/is not a base 36\/62 number/;
# Date/time in logs and in one instance of a filter test
s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d(\s[+-]\d\d\d\d)?\s/1999-03-02 09:44:33 /gx;
- s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\.\d{3}(\s[+-]\d\d\d\d)?\s/2017-07-30 18:51:05.712 /gx;
+ s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\.\d{3}(?:\s(?:[+-]\d\d\d\d|[A-Z]{2}T))?\s/2017-07-30 18:51:05.712 /gx;
s/^Logwrite\s"\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Logwrite "1999-03-02 09:44:33/gx;
# Date/time in syslog test
s/^SYSLOG:\s\'\K\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\s/2017-07-30 18:51:05 /gx;
# the older (comment) style, keeping only the Auth element
# (discarding kex, cipher, mac). For TLS 1.3 there is no kex
# element (and no _WITH); insert a spurious "RSA".
+ # Also in $tls_X_cipher_std reporting.
- s/^\s+by .+ with .+ \K tls TLS_.*?([^_]+)_WITH.+$/(TLS1.x:ke-$1-AES256-SHAnnn:xxx)/;
- s/^\s+by .+ with .+ \K tls TLS_.+$/(TLS1.x:ke-RSA-AES256-SHAnnn:xxx)/;
+ s/^\s+by \S+ with .+ \K \(TLS1(?:\.[0-3])?\) tls TLS_.*?([^_]+)_WITH.+$/(TLS1.x:ke-$1-AES256-SHAnnn:xxx)/;
+ s/^\s+by \S+ with .+ \K \(TLS1(?:\.[0-3])?\) tls TLS_.+$/(TLS1.x:ke-RSA-AES256-SHAnnn:xxx)/;
+
+ s/ cipher_ TLS_.*?([^_]+)_WITH.+$/ cipher_ TLS1.x:ke_$1_WITH_ci_mac/;
+ s/ cipher_ TLS_.*$/ cipher_ TLS1.x:ke_RSA_WITH_ci_mac/;
# Test machines might have various different TLS library versions supporting
# different protocols; can't rely upon TLS 1.2's AES256-GCM-SHA384, so we
# treat the standard algorithms the same.
#
- # TLSversion : KeyExchange? - Authentication/Signature - C_iph_er - MAC : ???
+ # TLSversion : KeyExchange? - Authentication/Signature - C_iph_er - MAC : bits
#
# So far, have seen:
# TLSv1:AES128-GCM-SHA256:128
#
# Retain the authentication algorith field as we want to test that.
- s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1(\.[123])?:/$1TLS1.x:/xg;
+ s/( (?: (?:\b|\s) [\(=] ) | \s )TLS1(\.[123])?:/$1TLS1.x:/xg;
s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-AES(128|256)-(GCM-SHA(256|384)|SHA)(?!:)/ke-$3-AES256-SHAnnn/g;
s/(?<!ke-)((EC)?DHE-)?(RSA|ECDSA)-AES(128|256)-(GCM-SHA(256|384)|SHA):(128|256)/ke-$3-AES256-SHAnnn:xxx/g;
# 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;
# DHE-RSA-AES256-SHA
# picking latter as canonical simply because regex easier that way.
s/\bDHE_RSA_AES_128_CBC_SHA1:128/RSA-AES256-SHA1:256/g;
- s/TLS1.[0123](-PKIX)?: # TLS version
+ s/TLS1.[x0123](-PKIX)?: # TLS version
((EC)?DHE(_((?<psk>PSK)_)?((?<auth>RSA|ECDSA)_)?
(SECP(256|521)R1|X25519))?__?)? # key-exchange
((?<auth>RSA|ECDSA)((_PSS_RSAE)?_SHA(512|256))?__?)? # authentication
+ (?<with>WITH_)? # stdname-with
AES_(256|128)_(CBC|GCM) # cipher
(__?AEAD)? # pseudo-MAC
(__?SHA(1|256|384))? # PRF
/"TLS1.x:ke-"
. (defined($+{psk}) ? $+{psk} : "")
. (defined($+{auth}) ? $+{auth} : "")
+ . (defined($+{with}) ? $+{with} : "")
. "-AES256-SHAnnn:xxx"/gex;
s/TLS1.2:RSA__CAMELLIA_256_GCM(_SHA384)?:256/TLS1.2:RSA_CAMELLIA_256_GCM-SHAnnn:256/g;
s/\b(ECDHE-(RSA|ECDSA)-AES256-SHA|DHE-RSA-AES256-SHA256)\b/ke-$2-AES256-SHAnnn/g;
+ # Separate reporting of TLS version
+ s/ver: TLS1(\.[0-3])?$/ver: TLS1.x/;
+ s/ \(TLS1(\.[0-3])?\) / (TLS1.x) /;
+
# GnuTLS library error message changes
s/(No certificate was found|Certificate is required)/The peer did not send any certificate/g;
#(dodgy test?) s/\(certificate verification failed\): invalid/\(gnutls_handshake\): The peer did not send any certificate./g;
s/\bgid=\d+/gid=gggg/;
s/\begid=\d+/egid=gggg/;
- s/\b(pid=|PID: )\d+/$1pppp/;
+ s/\b(?:pid=|pid\s|PID:\s|Process\s|child\s)\K(\d+)/new_value($1, "p%s", \$next_pid)/gxe;
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+\])/
s/waiting for children of \d+/waiting for children of pppp/;
s/waiting for (\S+) \(\d+\)/waiting for $1 (pppp)/;
+ # Most builds are without HAVE_LOCAL_SCAN
+ next if /^calling local_scan\(\); timeout=300$/;
+ next if /^local_scan\(\) returned 0 NULL$/;
+
# ======== Port numbers ========
# Incoming port numbers may vary, but not in daemon startup line.
# 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;
}
# Port in host address in spool file output from -Mvh
- s/^-host_address (.*)\.\d+/-host_address $1.9999/;
+ s/^(--?host_address) (.*[:.])\d+$/$1 ${2}9999/;
if ($dynamic_socket and $dynamic_socket->opened and my $port = $dynamic_socket->sockport) {
s/^Connecting to 127\.0\.0\.1 port \K$port/<dynamic port>/;
# Also, the length of space at the end of the host line is dependent
# on the length of the longest line, so strip it also on otherwise
# un-rewritten lines like localhost
+ #
+ # host 127.0.0.1 [127.0.0.1]
+ # host 10.0.0.1 [10.0.0.1]-
+ #
+ # host 127.0.0.1 [127.0.0.1]--
+ # host 169.16.16.16 [169.16.16.10]
s/^\s+host\s(\S+)\s+(\S+)/ host $1 $2/;
s/^\s+(host\s\S+\s\S+)\s+(port=.*)/ host $1 $2/;
s/host\s\Q$parm_ipv6\E\s\[\Q$parm_ipv6\E\]/host ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6 [ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6]/;
s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g;
s/(^|\W)\K\Q$parm_ipv6\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g;
+ s/(^|\W)\K\Q$parm_ipv6_stripped\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g;
s/\b\Q$parm_ipv4r\E\b/ip4-reverse/g;
s/(^|\W)\K\Q$parm_ipv6r\E/ip6-reverse/g;
- s/^(\s+host\s\S+\s+\[\S+\]) +$/$1 /;
+ s/^\s+host\s\S+\s+\[\S+\]\K +$//; # strip, not collapse the trailing whitespace
# ======== Test network IP addresses ========
# ======== 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 ========
# numbers, or handle specific bad conditions in different ways, leading to
# different wording in the error messages, so we cannot compare them.
-#XXX This loses any trailing "deliving unencypted to" which is unfortunate
+#XXX This loses any trailing "delivering unencypted to" which is unfortunate
# but I can't work out how to deal with that.
s/(TLS session: \(SSL_\w+\): error:)(.*)(?!: delivering)/$1 <<detail omitted>>/;
+ s/TLS error on connection from .*\K\(SSL_accept\): error:.*:unexpected eof while reading$/(tls lib accept fn): TCP connection closed by peer/;
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/;
+
+ # OpenSSL 1.1.1
+ s/error:\K0B080074:x509 certificate routines:X509_check_private_key(?=:key values mismatch$)/05800074:x509 certificate routines:/;
+ s/error:\K02001002:system library:fopen(?=:No such file or directory$)/80000002:system library:/;
+ s/error:\K0909006C:PEM routines:get_name(?=:no start line$)/0480006C:PEM routines:/;
+
# ======== 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*$/)
last if !defined $_;
+ # SRS timestamps and signatures vary by hostname and from run to run
+
+ s/(?i)SRS0=....=.[^=]?=([^=]+)=([^@]+)\@([^ ]+)/SRS0=ZZZZ=YY=$1=$2\@$3/g;
+
+
# ======== Output from the "fd" program about open descriptors ========
# The statuses seem to be different on different operating systems, but
# at least we'll still be checking the number of open fd's.
s/max fd = \d+/max fd = dddd/;
- s/status=0 RDONLY/STATUS/g;
- s/status=1 WRONLY/STATUS/g;
- s/status=2 RDWR/STATUS/g;
+ s/status=[0-9a-f]+ (?:RDONLY|WRONLY|RDWR)/STATUS/g;
# ======== Contents of spool files ========
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
next if /SSL verify error: depth=0 error=certificate not trusted/;
s/SSL3_READ_BYTES/ssl3_read_bytes/i;
s/CONNECT_CR_FINISHED/ssl3_read_bytes/i;
- s/^\d+:error:\d+(?:E\d+)?(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/;
- s/^error:[^:]*:(SSL routines:ssl3_read_bytes:(tls|ssl)v\d+ alert)/error:dddddddd:$1/;
+ s/^[[:xdigit:]]+:error:[[:xdigit:]]+(?:E[[:xdigit:]]+)?(:SSL routines:ssl3_read_bytes:[^:]+:).*(:SSL alert number \d\d)$/pppp:error:dddddddd$1\[...\]$2/;
+ s/^error:\K[^:]*:(SSL routines:ssl3_read_bytes:(tls|ssl)v\d+ alert)/dddddddd:$1/;
+ s/^error:\K[[:xdigit:]]+:SSL routines::(tlsv13 alert certificate required)$/dddddddd:SSL routines:ssl3_read_bytes:$1/;
+ s/^error:\K[[:xdigit:]]+:SSL routines::((tlsv1|sslv3) alert (unknown ca|certificate revoked))$/dddddddd:SSL routines:ssl3_read_bytes:$1/;
# gnutls version variances
next if /^Error in the pull function./;
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/;
+ next if /^host_name_extract = /;
+
+ # gsasl library version may not support some methods
+ s/250-AUTH ANONYMOUS PLAIN SCRAM-SHA-1\K SCRAM-SHA-256//;
}
# ======== stderr ========
elsif ($is_stderr)
{
# The very first line of debugging output will vary
-
s/^Exim version .*/Exim version x.yz ..../;
- # Debugging lines for Exim terminations and process-generation
+ # Skip some lines that Exim puts out at the start of debugging output
+ # because they will be different in different binaries.
+
+ 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;
+
+ # Lines with a leading pid. Only handle >= 4-digit PIDs to avoid converting SMTP respose codes
+ s/^\s*(\d{4,})\s(?!(?:previous message|in\s|bytes remain in|SMTP accept process running))/new_value($1, "p%s", \$next_pid) . ' '/e;
- s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
- s/^(proxy-proc \w{5}-pid) \d+$/$1 pppp/;
+ # Debugging lines for Exim terminations and process-generation
+ 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/;
+ # port numbers
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_d/PORT_D/;
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_d2/PORT_D2/;
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_d3/PORT_D3/;
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_d4/PORT_D4/;
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_s/PORT_S/;
+ s/(?:\[[^\]]*\]:|V4NET\.0\.0\.0:|localhost::?|127\.0\.0\.1[.:]:?|port[= ])\K$parm_port_n/PORT_N/;
+
+ # ========= 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+$/;
+ next if /^GnuTLS<3>: ASSERT: \.\.\/\.\.\/lib\/pkcs11.c\[find_multi_objs_cb\]:/;
+ next if /^GnuTLS<3>: ASSERT: \.\.\/\.\.\/lib\/pkcs11.c\[gnutls_pkcs11_obj_list_import_url3\]:/;
# drop openssl version strings
next if /OpenSSL compile-time version: OpenSSL \d+[\.\da-z]+/;
next if /OpenSSL runtime 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 \S+|ECDH curve \S+|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$/;
+
+ # some plaatforms are missing the standard CA bundle file
+ next if /^tls_set_watch\(\) fail on '\/usr\/lib\/ssl\/cert.pem': No such file or directory$/;
+
# 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
next if /name=localhost address=::1/;
# drop pdkim debugging header
- next if /^PDKIM( <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+|: no signatures)$/;
+ 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 if /get\[host\|ipnode\]byname\[2\]\(af=inet6\)/;
next if /DNS lookup of \S+ \(AAAA\) using fakens/;
next if / in dns_ipv4_lookup?/;
+ next if / writing neg-cache entry for .*AAAA/;
+ next if /^faking res_search\(AAAA\) response length as 65535/;
if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/)
{
next;
}
+ # 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>; $_= <IN>;
+ $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
+ $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>; next;
+ }
+
+
# Skip tls_advertise_hosts and hosts_require_tls checks when the options
# are unset, because tls ain't always there.
+ next if /^((>>>)?\s*host)? in tls_advertise_hosts\?$/;
next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?)
\sno\s\((option\sunset|end\sof\slist)\)/x;
# Platform-dependent error strings
s/Operation timed out/Connection timed out/;
+ # Platform differences on disconnect
+ s/unexpected disconnection while reading SMTP command from \[127.0.0.1\] \K\(error: Connection reset by peer\) //;
+
+ # Platform-dependent resolver option bits
+ s/^ (?:writing|update) neg-cache entry for [^,]+-\K[0-9a-f]+, ttl/xxxx, ttl/;
+
+ # 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;
- # DISABLE_OCSP
+ # daemon notifier socket
+ s% \@(?=[^ @]+/spool/exim_daemon_notify$)% %;
+ 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)/;
+ # and different numbers of lookup types result in different type-code letters,
+ # so convert them all to "0"
+ s%(?<!lsearch)[^ ](?=TESTSUITE/aux-fixed/(?:0414.list[12]|0464.domains)$)%0%;
+
+ # DISABLE_OCSP
next if /in hosts_requ(est|ire)_ocsp\? (no|yes)/;
# SUPPORT_PROXY
next if /host in hosts_proxy\?/;
# PIPE_CONNECT
- next if / in (pipelining_connect_advertise_hosts|hosts_pipe_connect)?\? no /;
+ if ( /^(>>>)?\s*host in pipelining_connect_advertise_hosts\?$/ )
+ {
+ $_ = <IN>;
+ while ( /^(>>>)?\s*list element:/ ) { $_ = <IN>; }
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
+ next if / in (?:pipelining_connect_advertise_hosts|hosts_pipe_connect)?\? no /;
# Experimental_International
next if / in smtputf8_advertise_hosts\? no \(option unset\)/;
# Experimental_REQUIRETLS
next if / in tls_advertise_requiretls?\? no \(end of list\)/;
+ # Experimental_LIMITS
+ if ( /^((>>>)?\s*host)? in limits_advertise_hosts\?$/ )
+ {
+ $_ = <IN>;
+ while ( /^(>>>)?\s*list element: !\*$/ ) { $_ = <IN>; }
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
+ next if / in limits_advertise_hosts?\? no \(matched "!\*"\)/;
+
# TCP Fast Open
next if /^(ppppp )?setsockopt FASTOPEN: Network Error/;
+ # DISABLE_TLS_RESUME
+ # TLS resumption is not always supported by the build
+ next if /in tls_resumption_hosts\?/;
+ next if /RE '.outlook.com/;
+
# Environment cleaning
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/;
}
# Not all platforms build with DKIM enabled
- next if /^PDKIM >> Body data for hash, canonicalized/;
+ next if /^DKIM >> Body data for hash, canonicalized/;
+
+ # Not all platforms build with SPF enabled
+ next if /^(spf_conn_init|SPF_dns_exim_new|spf_compile\.c)/;
# Not all platforms have sendfile support
next if /^cannot use sendfile for body: no support$/;
# Parts of DKIM-specific debug output depend on the time/date
next if /^date:\w+,\{SP\}/;
- next if /^PDKIM \[[^[]+\] (Header hash|b) computed:/;
+ next if /^DKIM \[[^[]+\] (Header hash|b) computed:/;
# Not all platforms support TCP Fast Open, and the compile omits the check
- if (s/\S+ in hosts_try_fastopen\? (no \(option unset\)|yes \(matched "\*"\))\n$//)
+ if (s/\S+ in hosts_try_fastopen\? (no \(option unset\)|no \(end of list\)|yes \(matched "\*"\))\n$//)
{
+ chomp;
$_ .= <IN>;
s/ \.\.\. >>> / ... /;
- if (s/ non-TFO mode connection attempt to 224.0.0.0, 0 data\b$//) { $_ .= <IN>; }
+ if (s/ non-TFO mode connection attempt to 224.0.0.0, 0 data\b$//) { chomp; $_ .= <IN>; }
s/Address family not supported by protocol family/Network Error/;
s/Network is unreachable/Network Error/;
}
- next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/;
+ next if /^(ppppp |\d+ )?setsockopt FASTOPEN: Protocol not available$/;
s/^(Connecting to .* \.\.\. sending) \d+ (nonTFO early-data)$/$1 dd $2/;
if (/^([0-9: ]* # possible timestamp
Connecting\ to\ [^ ]+\ [^ ]+(\ from\ [^ ]+)?)\ \.\.\.
- \ .*TFO\ mode\
+ \ .*TFO\ mode\x20
(sendto,\ no\ data:\ EINPROGRESS # Linux
|connection\ attempt\ to\ [^,]+,\ 0\ data) # MacOS & no-support
$/x)
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/;
+ # Postgre DB server PID
+ s/ \[\d+\] (?=(LOG: redirecting log|HINT: Future log output))/ [pppp] /;
+
# Not all builds include DMARC
next if /^DMARC: no (dmarc_tld_file|sender_host_address)$/ ;
- # TLS resumption is not always supported by the build
- next if /in tls_resumption_hosts\?/;
-
# Platform differences in errno strings
s/ SMTP\(Operation timed out\)<</ SMTP(Connection timed out)<</;
+ # Platform differences for errno values (eg. Hurd)
+ 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+)/$1 . new_value($2, "p%s", \$next_pid) . " "/mgxe;
+ s/(?<!post-)[Pp]rocess\K(\s\d+ )/new_value($1, "p%s", \$next_pid) . " "/gxe;
+
+ # Path in environment varies
+ s/ PATH=\K.*$/<munged>/;
+
# 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
@saved = ();
}
- # 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:/
- );
-
-
+ print MUNGED;
}
next;
# CHUNKING: exact sizes depend on hostnames in headers
s/(=>.* K C="250- \d)\d+ (byte chunk, total \d)\d+/$1nn $2nn/;
- # openssl version variances
- s/(TLS error on connection [^:]*: error:)[0-9A-F]{8}(:system library):(?:fopen|func\(4095\)):(No such file or directory)$/$1xxxxxxxx$2:fopen:$3/;
- s/(DANE attempt failed.*error:)[0-9A-F]{8}(:SSL routines:)(ssl3_get_server_certificate|tls_process_server_certificate|CONNECT_CR_CERT)(?=:certificate verify failed$)/$1xxxxxxxx$2ssl3_get_server_certificate/;
+ # OpenSSL version variances
+ s/(TLS error on connection [^:]*: error:)[0-9A-F]{8}(:system library):(?:fopen|func\(4095\)|):(No such file or directory)$/$1xxxxxxxx$2:fopen:$3/;
+ next if /TLS error \(SSL_read\): error:0A000126:SSL routines::unexpected eof while reading$/ ;
+ s/EVDATA: \K\(SSL_accept\): error:0A000126:SSL routines::unexpected eof while reading/SSL_accept: TCP connection closed by peer/;
+ s/(DANE attempt failed.*error:)[0-9A-F]{8}(:SSL routines:)(?:(?i)ssl3_get_server_certificate|tls_process_server_certificate|CONNECT_CR_CERT|)(?=:certificate verify failed$)/$1xxxxxxxx$2ssl3_get_server_certificate/;
s/(DKIM: validation error: )error:[0-9A-F]{8}:rsa routines:(?:(?i)int_rsa_verify|CRYPTO_internal):(?:bad signature|algorithm mismatch)$/$1Public key signature verification has failed./;
s/ARC: AMS signing: privkey PEM-block import: error:\K[0-9A-F]{8}:(PEM routines):get_name:(no start line)/0906D06C:$1:PEM_read_bio:$2/;
- # gnutls version variances
+ # GnuTLS version variances
if (/TLS error on connection \(recv\): .* (Decode error|peer did not send any certificate)/)
{
my $prev = $_;
else
{ $_ = $prev; }
}
- # translate gnutls error into the openssl one
+ # translate GnuTLS error into the OpenSSL one
s/ARC: AMS signing: privkey PEM-block import: \KThe requested data were not available.$/error:0906D06C:PEM routines:PEM_read_bio:no start line/;
+ # and then both into the OpenSSL 3.x one
+ s/ARC: AMS signing: privkey PEM-block import: error:\K[0-9A-F]{8}:PEM routines:PEM_read_bio:no start line$/1E08010C:DECODER routines::unsupported/;
# DKIM timestamps
if ( /(DKIM: d=.*) t=([0-9]*) x=([0-9]*) / )
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/;
+
+ # with GnuTLS we cannot log single bad ALPN. So ignore the with-OpenSSL log line.
+ # next if /TLS ALPN (http) rejected$/;
# port numbers
s/(?:\[[^\]]*\]:|port )\K$parm_port_d/PORT_D/;
s/(?:\[[^\]]*\]:|port )\K$parm_port_n/PORT_N/;
s/I=\[[^\]]*\]:\K\d+/ppppp/;
+ # 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\): rxd alert: 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 ========
log_failure($log_failed_filename, $testno, $rf);
log_test($log_summary_filename, $testno, 'F') if ($force_continue);
}
- return 1 if /^c$/i && $rf !~ /paniclog/ && $rsf !~ /paniclog/;
+ return 1 if /^c$/i && $rf !~ /paniclog/ && (!defined $rsf || $rsf !~ /paniclog/);
last if (/^[sc]$/);
}
print "\n";
print "------------ $f -----------\n"
if (defined $rf && -s $rf && defined $rsf && -s $rsf);
- system("$more '$f'");
+ system @more => $f;
}
}
}
}
- open(MUNGED, '>', $mf) || tests_exit(-1, "Failed to open $mf: $!");
- for ($i = 0; $i < @munged; $i++)
- { print MUNGED $munged[$i]; }
- close(MUNGED);
+ open(my $fh, '>', $mf) or tests_exit(-1, "Failed to open $mf: $!");
+ print $fh @munged;
}
# Deal with log sorting
if ($sortfile)
{
- my(@munged, $i, $j);
- open(MUNGED, $mf) || tests_exit(-1, "Failed to open $mf: $!");
- @munged = <MUNGED>;
- close(MUNGED);
+ my @munged = do {
+ open(my $fh, '<', $mf) or tests_exit(-1, "Failed to open $mf: $!");
+ <$fh>;
+ };
- for ($i = 0; $i < @munged; $i++)
+ for (my $i = 0; $i < @munged; $i++)
{
if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/)
{
+ my $j;
for ($j = $i + 1; $j < @munged; $j++)
{
last if $munged[$j] !~
}
}
- open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
- print MUNGED "**NOTE: The delivery lines in this file have been sorted.\n";
- for ($i = 0; $i < @munged; $i++)
- { print MUNGED $munged[$i]; }
- close(MUNGED);
+ open(my $fh, '>', $mf) or tests_exit(-1, "Failed to open $mf: $!");
+ print $fh "**NOTE: The delivery lines in this file have been sorted.\n";
+ print $fh @munged;
}
# Do the comparison
# Handle comparison failure
print "** Comparison of $mf with $sf_current failed";
- system("$more test-cf");
+ system @more => 'test-cf';
print "\n";
for (;;)
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
{
# 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);
+ open(my $fh, '>', $sf_current);
}
else {
tests_exit(-1, "Failed to unlink $sf_current") if !unlink($sf_current);
# Usable files are:
# paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail
# Search strings starting with 's' do substitutions;
-# with '/' do line-skips.
+# with '/' do line-skips,
+# with 'R' run given code.
# Triggered by a scriptfile line "munge <name>"
##################################################
$munges =
s! DN="[^,"]*\K,!/!;
',
'rejectlog' => 's/ X=TLS\S+ / X=TLS_proto_and_cipher /',
- 'mail' => 's/^\s+by .+ with .+ \K tls TLS_.+$/(TLS_proto_and_cipher)/;
- s/ \(TLS[^)]*\)/ (TLS_proto_and_cipher)/;
- ',
},
- 'debug_pid' =>
- { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d{1,5}/ppppp/g' },
-
'optional_dsn_info' =>
- { 'mail' => '/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/'
+ { 'mail' => 'Rif (/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/) {
+ while (1) {
+ $_ = <IN>;
+ next if /^ /;
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
+ }'
},
'optional_config' =>
{ '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 deferral .* errno) <\d+> /$1 <EEE> /' },
+ { 'mainlog' => 's/((?:host|message) deferral .* errno) <\d+> /$1 <EEE> /' },
'peer_terminated_conn' => # actual error differs FreedBSD vs. Linux
{ 'stderr' => 's/^( SMTP\()Connection reset by peer(\)<<)$/$1closed$2/' },
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);
}
our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
-if (/^(\d+)\s*$/) # Handle unusual return code
+if (/^(\d+)\s*(?:([A-Z]+)=(\S+))?$/) # Handle unusual return code
{
my($r) = $_[2];
$$r = $1 << 8;
+ $ENV{$2} = $3 if (defined $2);
$_ = <SCRIPT>;
return 4 if !defined $_; # Missing command
$lineno++;
if (/^dump\s+(\S+)/)
{
- my($which) = $1;
- my(@temp);
+ my $which = $1;
print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
- open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");
- open(OUT, ">>test-stdout");
- print OUT "+++++++++++++++++++++++++++\n";
+ open(my $in, "-|", './eximdir/exim_dumpdb', "$parm_cwd/spool", $which) or die "Can't run exim_dumpdb: $!";
+ open(my $out, ">>test-stdout");
+ print $out "+++++++++++++++++++++++++++\n";
if ($which eq "retry")
{
- $/ = "\n ";
- @temp = <IN>;
- $/ = "\n";
-
- @temp = sort {
- my($aa) = split(' ', $a);
- my($bb) = split(' ', $b);
- return $aa cmp $bb;
- } @temp;
-
+ # the sort key is the first part of the retry db dump line, but for
+ # sorting we (temporarly) replace the own hosts ipv4 with a munged
+ # version, which matches the munging that is done later
+ # Why? We must ensure sure, that 127.0.0.1 always sorts first
+ # map-sort-map: Schwartz's transformation
+ # test 0099
+ my @temp = map { $_->[1] }
+ 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\E/ip4.ip4.ip4.ip4/g;
+ [ $k, $_ ]
+ }
+ do { local $/ = "\n "; <$in> };
foreach $item (@temp)
{
$item =~ s/^\s*(.*)\n(.*)\n?\s*$/$1\n$2/m;
- print OUT " $item\n";
+ print $out " $item\n";
}
}
else
{
- @temp = <IN>;
+ my @temp = <$in>;
if ($which eq "callout")
{
@temp = sort {
return $aa cmp $bb;
} @temp;
}
- print OUT @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(OUT);
+ close($in); # close it explicitly, otherwise $? does not get set
return 1;
}
}
+# 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
}
}
if ($args =~ /\$msg/)
{
- my @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
+ my($queuespec);
+ if ($args =~ /-qG\w+/) { $queuespec = $&; }
+
+ my @listcmd;
+
+ if (defined $queuespec)
+ {
+ @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
+ $queuespec,
+ "-DEXIM_PATH=$parm_cwd/eximdir/exim",
+ -C => "$parm_cwd/test-config");
+ }
+ else
+ {
+ @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
"-DEXIM_PATH=$parm_cwd/eximdir/exim",
-C => "$parm_cwd/test-config");
+ }
print ">> Getting queue list from:\n>> @listcmd\n" if $debug;
# We need the message ids sorted in ascending order.
# Message id is: <timestamp>-<pid>-<fractional-time>. On some systems (*BSD) the
# 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
+###############################################################################
+###############################################################################
+
+##################################################
+# Check for SpamAssassin and ClamAV #
+##################################################
+
+# 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.
+
+sub check_running_spamassassin
+{
+my $sock = new FileHandle;
+
+if (system("spamc -h 2>/dev/null >/dev/null") == 0)
+ {
+ print "The spamc command works:\n";
+
+ # This test for an active SpamAssassin is courtesy of John Jetmore.
+ # The tests are hard coded to localhost:783, so no point in making
+ # this test flexible like the clamav test until the test scripts are
+ # changed. spamd doesn't have the nice PING/PONG protocol that
+ # clamd does, but it does respond to errors in an informative manner,
+ # so use that.
+
+ my($sint,$sport) = ('127.0.0.1',783);
+ eval
+ {
+ my $sin = sockaddr_in($sport, inet_aton($sint))
+ or die "** Failed packing $sint:$sport\n";
+ socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
+ or die "** Unable to open socket $sint:$sport\n";
+
+ local $SIG{ALRM} =
+ sub { die "** Timeout while connecting to socket $sint:$sport\n"; };
+ alarm(5);
+ connect($sock, $sin)
+ or die "** Unable to connect to socket $sint:$sport\n";
+ alarm(0);
+
+ select((select($sock), $| = 1)[0]);
+ print $sock "bad command\r\n";
+
+ $SIG{ALRM} =
+ sub { die "** Timeout while reading from socket $sint:$sport\n"; };
+ alarm(10);
+ my $res = <$sock>;
+ alarm(0);
+
+ $res =~ m|^SPAMD/|
+ or die "** Did not get SPAMD from socket $sint:$sport. "
+ ."It said: $res\n";
+ };
+ alarm(0);
+ if($@)
+ {
+ print " $@";
+ print " Assume SpamAssassin (spamd) is not running\n";
+ }
+ else
+ {
+ $parm_running{SpamAssassin} = ' ';
+ print " SpamAssassin (spamd) seems to be running\n";
+ }
+ }
+else
+ {
+ print "The spamc command failed: assume SpamAssassin (spamd) is not running\n";
+ }
+}
+
+sub check_running_clamav
+{
+my $sock;
+
+# For ClamAV, we need to find the clamd socket for use in the Exim
+# configuration. Search for the clamd configuration file.
+
+if (system("clamscan -h 2>/dev/null >/dev/null") == 0)
+ {
+ my($f, $clamconf, $test_prefix);
+
+ print "The clamscan command works";
+
+ $test_prefix = $ENV{EXIM_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", '')
+ {
+ if (-e $f)
+ {
+ $clamconf = $f;
+ last;
+ }
+ }
+
+ # Read the ClamAV configuration file and find the socket interface.
+
+ if ($clamconf ne '')
+ {
+ my $socket_domain;
+ open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
+ while (<IN>)
+ {
+ if (/^LocalSocket\s+(.*)/)
+ {
+ $parm_clamsocket = $1;
+ $socket_domain = AF_UNIX;
+ last;
+ }
+ if (/^TCPSocket\s+(\d+)/)
+ {
+ if (defined $parm_clamsocket)
+ {
+ $parm_clamsocket .= " $1";
+ $socket_domain = AF_INET;
+ last;
+ }
+ else
+ {
+ $parm_clamsocket = " $1";
+ }
+ }
+ elsif (/^TCPAddr\s+(\S+)/)
+ {
+ if (defined $parm_clamsocket)
+ {
+ $parm_clamsocket = $1 . $parm_clamsocket;
+ $socket_domain = AF_INET;
+ last;
+ }
+ else
+ {
+ $parm_clamsocket = $1;
+ }
+ }
+ }
+ close(IN);
+
+ if (defined $socket_domain)
+ {
+ print ":\n The clamd socket is $parm_clamsocket\n";
+ # This test for an active ClamAV is courtesy of Daniel Tiefnig.
+ eval
+ {
+ my $socket;
+ if ($socket_domain == AF_UNIX)
+ {
+ $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n";
+ }
+ elsif ($socket_domain == AF_INET)
+ {
+ my ($ca_host, $ca_port) = split(/\s+/,$parm_clamsocket);
+ my $ca_hostent = gethostbyname($ca_host) or die "** Failed to get raw address for host '$ca_host'\n";
+ $socket = sockaddr_in($ca_port, $ca_hostent) or die "** Failed packing '$parm_clamsocket'\n";
+ }
+ else
+ {
+ die "** Unknown socket domain '$socket_domain' (should not happen)\n";
+ }
+ socket($sock, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n";
+ local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; };
+ alarm(5);
+ connect($sock, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n";
+ alarm(0);
+
+ my $ofh = select $sock; $| = 1; select $ofh;
+ print $sock "PING\n";
+
+ $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; };
+ alarm(10);
+ my $res = <$sock>;
+ alarm(0);
+
+ $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n";
+ };
+ alarm(0);
+
+ if($@)
+ {
+ print " $@";
+ print " Assume ClamAV is not running\n";
+ }
+ else
+ {
+ $parm_running{ClamAV} = ' ';
+ print " ClamAV seems to be running\n";
+ }
+ }
+ else
+ {
+ print ", but the socket for clamd could not be determined\n";
+ print "Assume ClamAV is not running\n";
+ }
+ }
+
+ else
+ {
+ print ", but I can't find a configuration for clamd\n";
+ print "Assume ClamAV is not running\n";
+ }
+ }
+}
+
+
+sub check_running_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} = ' ';
+ }
+ else
+ {
+ print "The redis-server command failed: assume Redis not installed\n";
+ }
+ }
+}
+
+sub check_running_dovecot
+{
+system('dovecot --version >/dev/null');
+if ($? == 0)
+ {
+ print "Dovecot appears to be available\n";
+ $parm_running{dovecot} = ' ';
+ }
+else
+ {
+ print "Dovecot not found\n";
+ }
+}
+
+
+
###############################################################################
###############################################################################
# Check for the "less" command #
##################################################
-$more = 'more' if system('which less >/dev/null 2>&1') != 0;
+@more = 'more' if system('which less >/dev/null 2>&1') != 0;
GetOptions(
'debug' => sub { $debug = 1; $cr = "\n" },
'diff' => sub { $cf = 'diff -u' },
- 'continue' => sub { $force_continue = 1; $more = 'cat' },
+ 'continue' => sub { $force_continue = 1; @more = 'cat' },
'update' => \$force_update,
'ipv4!' => \$have_ipv4,
'ipv6!' => \$have_ipv6,
'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
{
unlink("$parm_cwd/test-config");
-##################################################
-# Check for SpamAssassin and ClamAV #
-##################################################
-# 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})
{
- my $sock = new FileHandle;
-
- if (system("spamc -h 2>/dev/null >/dev/null") == 0)
- {
- print "The spamc command works:\n";
-
- # This test for an active SpamAssassin is courtesy of John Jetmore.
- # The tests are hard coded to localhost:783, so no point in making
- # this test flexible like the clamav test until the test scripts are
- # changed. spamd doesn't have the nice PING/PONG protocol that
- # clamd does, but it does respond to errors in an informative manner,
- # so use that.
-
- my($sint,$sport) = ('127.0.0.1',783);
- eval
- {
- my $sin = sockaddr_in($sport, inet_aton($sint))
- or die "** Failed packing $sint:$sport\n";
- socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
- or die "** Unable to open socket $sint:$sport\n";
-
- local $SIG{ALRM} =
- sub { die "** Timeout while connecting to socket $sint:$sport\n"; };
- alarm(5);
- connect($sock, $sin)
- or die "** Unable to connect to socket $sint:$sport\n";
- alarm(0);
-
- select((select($sock), $| = 1)[0]);
- print $sock "bad command\r\n";
-
- $SIG{ALRM} =
- sub { die "** Timeout while reading from socket $sint:$sport\n"; };
- alarm(10);
- my $res = <$sock>;
- alarm(0);
-
- $res =~ m|^SPAMD/|
- or die "** Did not get SPAMD from socket $sint:$sport. "
- ."It said: $res\n";
- };
- alarm(0);
- if($@)
- {
- print " $@";
- print " Assume SpamAssassin (spamd) is not running\n";
- }
- else
- {
- $parm_running{SpamAssassin} = ' ';
- print " SpamAssassin (spamd) seems to be running\n";
- }
- }
- else
- {
- print "The spamc command failed: assume SpamAssassin (spamd) is not running\n";
- }
-
- # For ClamAV, we need to find the clamd socket for use in the Exim
- # configuration. Search for the clamd configuration file.
-
- if (system("clamscan -h 2>/dev/null >/dev/null") == 0)
- {
- my($f, $clamconf, $test_prefix);
-
- print "The clamscan command works";
-
- $test_prefix = $ENV{EXIM_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", '')
- {
- if (-e $f)
- {
- $clamconf = $f;
- last;
- }
- }
-
- # Read the ClamAV configuration file and find the socket interface.
-
- if ($clamconf ne '')
- {
- my $socket_domain;
- open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
- while (<IN>)
- {
- if (/^LocalSocket\s+(.*)/)
- {
- $parm_clamsocket = $1;
- $socket_domain = AF_UNIX;
- last;
- }
- if (/^TCPSocket\s+(\d+)/)
- {
- if (defined $parm_clamsocket)
- {
- $parm_clamsocket .= " $1";
- $socket_domain = AF_INET;
- last;
- }
- else
- {
- $parm_clamsocket = " $1";
- }
- }
- elsif (/^TCPAddr\s+(\S+)/)
- {
- if (defined $parm_clamsocket)
- {
- $parm_clamsocket = $1 . $parm_clamsocket;
- $socket_domain = AF_INET;
- last;
- }
- else
- {
- $parm_clamsocket = $1;
- }
- }
- }
- close(IN);
-
- if (defined $socket_domain)
- {
- print ":\n The clamd socket is $parm_clamsocket\n";
- # This test for an active ClamAV is courtesy of Daniel Tiefnig.
- eval
- {
- my $socket;
- if ($socket_domain == AF_UNIX)
- {
- $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n";
- }
- elsif ($socket_domain == AF_INET)
- {
- my ($ca_host, $ca_port) = split(/\s+/,$parm_clamsocket);
- my $ca_hostent = gethostbyname($ca_host) or die "** Failed to get raw address for host '$ca_host'\n";
- $socket = sockaddr_in($ca_port, $ca_hostent) or die "** Failed packing '$parm_clamsocket'\n";
- }
- else
- {
- die "** Unknown socket domain '$socket_domain' (should not happen)\n";
- }
- socket($sock, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n";
- local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; };
- alarm(5);
- connect($sock, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n";
- alarm(0);
-
- my $ofh = select $sock; $| = 1; select $ofh;
- print $sock "PING\n";
-
- $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; };
- alarm(10);
- my $res = <$sock>;
- alarm(0);
-
- $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n";
- };
- alarm(0);
-
- if($@)
- {
- print " $@";
- print " Assume ClamAV is not running\n";
- }
- else
- {
- $parm_running{ClamAV} = ' ';
- print " ClamAV seems to be running\n";
- }
- }
- else
- {
- print ", but the socket for clamd could not be determined\n";
- print "Assume ClamAV is not running\n";
- }
- }
-
- else
- {
- print ", but I can't find a configuration for clamd\n";
- print "Assume ClamAV is not running\n";
- }
- }
- }
-
-
-##################################################
-# Check for 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} = ' ';
- }
- else
- {
- print "The redis-server command failed: assume Redis not installed\n";
- }
+ check_running_spamassassin();
+ check_running_clamav();
}
+check_running_redis();
+check_running_dovecot();
##################################################
# Test for the basic requirements #
# Find this host's IP addresses - there may be many, of course, but we keep
# one of each type (IPv4 and IPv6).
+#XXX it would be good to avoid non-UP interfaces
open(IFCONFIG, '-|', (grep { -x "$_/ip" } split /:/, $ENV{PATH}) ? 'ip address' : 'ifconfig -a')
or die "** Cannot run 'ip address' or 'ifconfig -a'\n";
while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>))
{
- if (not $parm_ipv4 and /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
+ if (/^(?:[0-9]+: )?([a-z0-9]+): /) { $ifname = $1; }
+
+ if (not $parm_ipv4 and /^\s*inet(?:\saddr(?:ess))?:?\s*(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
{
- next if $1 =~ /^(?:127|10)\./;
+ # It would be nice to be able to vary the /16 used for manyhome; we could take
+ # an option to runtest used here - but we'd also have to pass it on to fakens.
+ # Possibly an environment variable?
+ next if $1 eq '0.0.0.0' or $1 =~ /^(?:127|10\.250)\./;
$parm_ipv4 = $1;
}
- if (not $parm_ipv6 and /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)(?:%[^ \/]+)?(?:\/\d+)?/i)
+ if ( (not $parm_ipv6 or $parm_ipv6 =~ /%/)
+ and /^\s*inet6(?:\saddr(?:ess))?:?\s*([abcdef\d:]+)(?:%[^ \/]+)?(?:\/\d+)?/i)
{
- next if $1 eq '::1' or $1 =~ /^fe80/i;
+ next if $1 eq '::' or $1 eq '::1' or $1 =~ /^ff00/i or $1 =~ /^fe80::1/i;
$parm_ipv6 = $1;
+ if ($1 =~ /^fe80/i) { $parm_ipv6 .= '%' . $ifname; }
}
}
close(IFCONFIG);
print "IPv4 address is $parm_ipv4\n";
print "IPv6 address is $parm_ipv6\n";
$parm_ipv6 =~ /^[^%\/]*/;
+# drop any %scope from the ipv6, for some uses
+($parm_ipv6_stripped = $parm_ipv6) =~ s/%.*//g;
# For munging test output, we need the reversed IP addresses.
$parm_ipv6r = $parm_ipv6; # Appropriate if not in use
if ($parm_ipv6 =~ /^[\da-f]/)
{
- my(@comps) = split /:/, $parm_ipv6;
+ my(@comps) = split /:/, $parm_ipv6_stripped;
my(@nibbles);
foreach $comp (@comps)
{
($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 exim_msgdate)) {
+ 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 exim_msgdate)) {
# fold (or unfold?) multiline output into a one-liner
print join(', ', map { chomp; $_ } `$_ --version`), "\n";
}
{
if (!defined $parm_malware{$1}) { $wantthis = 0; last; }
}
- elsif (/^feature (.*)$/)
+ elsif (/^(not )?feature (.*)$/)
{
# move to a subroutine?
- my $eximinfo = "$parm_exim -C $parm_cwd/test-config -DDIR=$parm_cwd -bP macro $1";
+ my $eximinfo = "$parm_exim -C $parm_cwd/test-config -DDIR=$parm_cwd -bP macro $2";
open (IN, "$parm_cwd/confs/0000") ||
tests_exit(-1, "Couldn't open $parm_cwd/confs/0000: $!\n");
close(OUT);
system($eximinfo . " >/dev/null 2>&1");
- if ($? != 0) {
- unlink("$parm_cwd/test-config");
+ if (!defined $1 && $? != 0 || defined $1 && $? == 0) {
$wantthis = 0;
- $_ = "feature $1";
+ unlink("$parm_cwd/test-config");
+ $_ = $1 || "" . "feature $2";
last;
}
unlink("$parm_cwd/test-config");
}
+ elsif (/^ipv6-non-linklocal/)
+ {
+ if ($parm_ipv6 =~ /%/) { $wantthis = 0; last; }
+ }
else
{
tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\"");
"; for queries that it cannot answer\n\n" .
"PASS ON NOT FOUND\n\n";
print OUT "$shortname A $parm_ipv4\n" if $have_ipv4;
- print OUT "$shortname AAAA $parm_ipv6\n" if $have_ipv6;
+ print OUT "$shortname AAAA $parm_ipv6_stripped\n" if $have_ipv6;
print OUT "\n; End\n";
close(OUT);
}
if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1")
{
my(@components) = $parm_ipv4 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
- open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") ||
- tests_exit(-1,
- "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!");
- print OUT "; This is a dynamically constructed fake zone file.\n" .
- "; The zone is $components[0].in-addr.arpa.\n\n" .
- "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n" .
- "; End\n";
- close(OUT);
+
+ if ($components[0]=='10')
+ {
+ open(OUT, ">>$parm_cwd/dnszones/db.ip4.$components[0]") ||
+ tests_exit(-1, "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!");
+ print OUT "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n";
+ close(OUT);
+ }
+ else
+ {
+ open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") ||
+ tests_exit(-1,
+ "Failed to open $parm_cwd/dnszones/db.ip4.$components[0]: $!");
+ print OUT "; This is a dynamically constructed fake zone file.\n" .
+ "; The zone is $components[0].in-addr.arpa.\n\n" .
+ "$components[3].$components[2].$components[1] PTR $parm_hostname.\n\n" .
+ "; End\n";
+ close(OUT);
+ }
}
-if ($have_ipv6 && $parm_ipv6 ne "::1")
+if ($have_ipv6 && $parm_ipv6_stripped ne "::1")
{
- my($exp_v6) = $parm_ipv6;
+ my($exp_v6) = $parm_ipv6_stripped;
$exp_v6 =~ s/[^:]//g;
- if ( $parm_ipv6 =~ /^([^:].+)::$/ ) {
+ if ( $parm_ipv6_stripped =~ /^([^:].+)::$/ ) {
$exp_v6 = $1 . ':0' x (9-length($exp_v6));
- } elsif ( $parm_ipv6 =~ /^(.+)::(.+)$/ ) {
+ } elsif ( $parm_ipv6_stripped =~ /^(.+)::(.+)$/ ) {
$exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2;
- } elsif ( $parm_ipv6 =~ /^::(.+[^:])$/ ) {
+ } elsif ( $parm_ipv6_stripped =~ /^::(.+[^:])$/ ) {
$exp_v6 = '0:' x (9-length($exp_v6)) . $1;
} else {
- $exp_v6 = $parm_ipv6;
+ $exp_v6 = $parm_ipv6_stripped;
}
my(@components) = split /:/, $exp_v6;
my(@nibbles) = reverse (split /\s*/, shift @components);
}
+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
$next_port = 1111;
$message_skip = 0;
$msglog_skip = 0;
+ $munge_skip = 0;
$stderr_skip = 0;
$stdout_skip = 0;
$rmfiltertest = 0;
{
if (/^no_message_check/) { $message_skip = 1; next; }
if (/^no_msglog_check/) { $msglog_skip = 1; next; }
+ if (/^no_munge/) { $munge_skip = 1; next; }
if (/^no_stderr_check/) { $stderr_skip = 1; next; }
if (/^no_stdout_check/) { $stdout_skip = 1; next; }
if (/^rmfiltertest/) { $rmfiltertest = 1; next; }
# set above, but doesn't hurt to leave them here.
if (/^no_message_check/) { $message_skip = 1; next; }
if (/^no_msglog_check/) { $msglog_skip = 1; next; }
+ if (/^no_munge/) { $munge_skip = 1; next; }
if (/^no_stderr_check/) { $stderr_skip = 1; next; }
if (/^no_stdout_check/) { $stdout_skip = 1; next; }
if (/^rmfiltertest/) { $rmfiltertest = 1; next; }
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";
print "==================>\n";
system("tail -20 test-stdout");
print "===================\n";
+
print "stderr tail:\n";
print "==================>\n";
- system("tail -20 test-stderr");
+ system("tail -30 test-stderr");
+ print "===================\n";
+
+ print "stdout-server tail:\n";
+ print "==================>\n";
+ system("tail -20 test-stdout-server");
print "===================\n";
+
+ print "stderr-server tail:\n";
+ print "==================>\n";
+ system("tail -30 test-stderr-server");
+ print "===================\n";
+
print "... continue forced\n";
}
last if /^[rc]$/i;
if (/^e$/i)
{
- system("$more test-stderr");
+ system @more => 'test-stderr';
}
elsif (/^o$/i)
{
- system("$more test-stdout");
+ system @more => 'test-stdout';
}
}
{
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__
git://git.exim.org / exim.git / blobdiff