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.
#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/;
my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
$expired = '' if !defined $expired;
- # Round the time-difference down to nearest even value
- my($increment) = ((date_seconds($date3) - date_seconds($date2)) >> 1) << 1;
+ # Round the time-difference up to nearest even value
+ my($increment) = ((date_seconds($date3) - date_seconds($date2) + 1) >> 1) << 1;
# We used to use globally unique replacement values, but timing
# differences make this impossible. Just show the increment on the
# 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\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+\])/
# 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+/$1 $2.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>/;
# 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/;
+
# ======== Maildir things ========
# timestamp output in maildir processing
s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/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/;
elsif ($is_stderr)
{
# The very first line of debugging output will vary
-
s/^Exim version .*/Exim version x.yz ..../;
+ # 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
+ s/^(\d+)\s(?!(?:previous message|in\s))/new_value($1, "p%s", \$next_pid) . ' '/e;
+
# Debugging lines for Exim terminations and process-generation
- s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
- s/^(proxy-proc \w{5}-pid) \d+$/$1 pppp/;
- s/^(?:\s*\d+ )(exec .* -oPX)$/pppp $1/;
+ s/^\s*\K(\d+)(?=\sexec\s.*\s-oPX$)/new_value($1, "%s", \$next_pid)/xe;
next if /(?:postfork: | fork(?:ing|ed) for )/;
# IP address lookups use gethostbyname() when IPv6 is not supported,
# 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
# 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 for server/;
+ 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 /^TLS: preloading ECDH curve for server/;
- next if /^ECDH OpenSSL [< ]?[\d.+]+ temp key parameter settings:/;
- next if /^ECDH: .'*prime256v1'/;
- next if /^watch dir/;
+ 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 /^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;
}
$_ = $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/;
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
s/^errno = \d+$/errno = EEE/;
s/^writing error \d+: /writing error EEE: /;
- # Some platforms have to flip to slow-mode taint-checking
- next if /switching to slow-mode taint checking/;
+ # 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;
# When Exim is checking the size of directories for maildir, it uses
# the check_dir_size() function to scan directories. Of course, the order
@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;
# 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
{
'rejectlog' => 's/ X=TLS\S+ / X=TLS_proto_and_cipher /',
},
- 'debug_pid' =>
- { 'stderr' => 's/(^\s{0,4}|(?<=Process )|(?<=child ))\d+/ppppp/g' },
-
'optional_dsn_info' =>
{ 'mail' => '/^(X-(Remote-MTA-(smtp-greeting|helo-response)|Exim-Diagnostic|(body|message)-linecount):|Remote-MTA: X-ip;)/'
},
{ '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+(.*)/)
'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__
git://git.exim.org / exim.git / blobdiff