# We use env, because in some environments of our build farm
# the Perl 5.010 interpreter is only reachable via $PATH
+# Copyright (c) The Exim Maintainers 2024
+# SPDX-License-Identifier: GPL-2.0-or-later
+
###############################################################################
# This is the controlling script for the "new" test suite for Exim. It should #
# be possible to export this suite for running on a wide variety of hosts, in #
#use strict;
use v5.10.1;
use warnings;
-use if $^V >= v5.19.11, experimental => 'smartmatch';
use Errno;
use FileHandle;
my ($parm_ipv4, $parm_ipv6, $parm_ipv6_stripped);
my $parm_hostname;
+# Convenience for regex'
+# for tighter, see https://metacpan.org/dist/IO-Socket-IP/source/lib/IO/Socket/IP.pm#L37
+my $re_ipv4 = qr/\d{1,3}(?:\.\d{1,3}){3}/;
+my $re_6g = qr/[[:xdigit:]]{1,4}/;
+my $re_6s = qr/${re_6g}:/;
+my $re_ipv6 = qr/${re_6s}{0,7}${re_6g}(?:::${re_6s}{0,5}${re_6g})?/;
+my $re_ip = qr/(?:${re_ipv4}|${re_ipv6})/;
+
###############################################################################
###############################################################################
sub new_value {
my($oldid, $base, $sequence) = @_;
my($newid) = $cache{$oldid};
+print ">> replace $oldid -> $newid\n" if ($debug && defined $newid);
if (! defined $newid)
{
$newid = sprintf($base, $$sequence++);
+ print ">> new $oldid -> $newid\n" if $debug;
$cache{$oldid} = $newid;
}
return $newid;
RESET_AFTER_EXTRA_LINE_READ:
if ($munge_skip)
{
- # Munging is a no-op.
+ # Munging is a no-op, except for exim_msgdate specials.
# Useful when testing exim_msgdate so that
# we compare unmunged dates and message-ids.
+ s%^localhost \d+ from message-id != given number \d+ at \K/.+(?=/test/eximdir/exim_msgdate line 387.$)%DIR%;
+
print MUNGED;
next;
}
{
next if $extra =~ m%^/% && eval $extra;
eval $extra if $extra =~ m/^s/;
+ eval substr($extra, 1) if $extra =~ m/^R/;
}
# Check for "*** truncated ***"
# patchexim should have fixed this for us
#s/Exim \K\d+[._]\d+[\w_-]*/x.yz/i;
- # Replace Exim message ids by a unique series
+ # Replace Exim message ids by a unique series.
+ # Both old and new formats, with separate replace series, for now.
s/(\d[^\W_]{5}-[^\W_]{6}-[^\W_]{2})
- /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
+ /new_value($1, "10Hm%s-0005vi-00", \$next_msgid_old)/egx;
+ s/(\d[^\W_]{5}-[^\W_]{11}-[^\W_]{4})
+ /new_value($1, "10Hm%s-000000005vi-0000", \$next_msgid)/egx;
# The names of lock files appear in some error and debug messages
s/\.lock(\.[-\w]+)+(\.[\da-f]+){2}/.lock.test.ex.dddddddd.pppppppp/;
s/:[^:]+: while opening named pipe/: Error: while opening named pipe/;
# Debugging output of lists of hosts may have different sort keys
- s/sort=\S+/sort=xx/ if /^\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\S+/;
+ s/^\s*\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\K\S+/xx/;
# Random local part in callout cache testing
s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/;
s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /;
# port numbers in dumpdb output
- s/T:([a-z.]+(:[0-9.]+)?):$parm_port_n /T:$1:PORT_N /;
+ s/T:([a-z0-9.]+(:[0-9.]+|:\[[^]]+])?):$parm_port_n /T:$1:PORT_N /;
+ s/T:([a-z0-9.[\]]+(:[0-9.]+|:\[[^]]+])?):$parm_port_s /T:$1:PORT_S /;
+ # and exinext
+ s/Transport: (?:[a-z0-9.]+|\[[^\]]+]) (?:[0-9.]+|\[[^\]]+]):\K$parm_port_s /PORT_S /;
# port numbers in stderr
s/^set_process_info: .*\]:\K$parm_port_d /PORT_D /;
# time used was fixed when I first started running automatic Exim tests.
# Date/time in header lines and SMTP responses
- s/[A-Z][a-z]{2},\s\d\d?\s[A-Z][a-z]{2}\s\d{4}\s\d\d\:\d\d:\d\d\s[-+]\d{4}
- /Tue, 2 Mar 1999 09:44:33 +0000/gx;
+ s/[A-Z][a-z]{2},
+ (\s|\xE2\x96\x91)
+ \d\d?
+ (\s|\xE2\x96\x91)
+ [A-Z][a-z]{2}
+ (\s|\xE2\x96\x91)
+ \d{4}
+ (\s|\xE2\x96\x91)
+ \d\d\:\d\d:\d\d
+ (\s|\xE2\x96\x91)
+ [-+]\d{4}
+ /Tue,${1}2${2}Mar${3}1999${4}09:44:33${5}+0000/gx;
# and in a French locale
s/\S{4},\s\d\d?\s[^,]+\s\d{4}\s\d\d\:\d\d:\d\d\s[-+]\d{4}
/dim., 10 f\xE9vr 2019 20:05:49 +0000/gx;
s/((D|[RQD]T)=)\d\.\d{3}s/$1q.qqqs/g;
# Date/time in message separators
- s/(?:[A-Z][a-z]{2}\s){2}\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d
- /Tue Mar 02 09:44:33 1999/gx;
+ s/(?:[A-Z][a-z]{2}
+ (\s|\xE2\x96\x91)
+ ){2}\d\d
+ (\s|\xE2\x96\x91)
+ \d\d:\d\d:\d\d
+ (\s|\xE2\x96\x91)
+ \d\d\d\d
+ /Tue${1}Mar${1}02${2}09:44:33${3}1999/gx;
# Date of message arrival in spool file as shown by -Mvh
s/^\d{9,10}\s0$/ddddddddd 0/;
s/\d\d-\w\w\w-\d\d\d\d\s\d\d:\d\d:\d\d\s[-+]\d\d\d\d,/06-Sep-1999 15:52:48 +0100,/gx;
# Dates/times in debugging output for writing retry records
- if (/^ first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/)
+ if (/^(\s+)first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/)
{
- my($next) = $3 - $2;
- $_ = " first failed=dddd last try=dddd next try=+$next $4\n";
+ my($next) = $4 - $3;
+ $_ = "$1first failed=dddd last try=dddd next try=+$next $5\n";
}
s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\w)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/;
s/^(\s*)received_time=\d+ diff=\d+ timeout=(\d+)/$1received_time=tttt diff=tttt timeout=$2/;
s/TLS error on connection \(gnutls_handshake\): Error in the pull function\./a TLS session is required but an attempt to start TLS failed/g;
# (replace old with new, hoping that old only happens in one situation)
- s/TLS error on connection to \d{1,3}(.\d{1,3}){3} \[\d{1,3}(.\d{1,3}){3}\] \(gnutls_handshake\): A TLS packet with unexpected length was received./a TLS session is required for ip4.ip4.ip4.ip4 [ip4.ip4.ip4.ip4], but an attempt to start TLS failed/g;
+ s/TLS error on connection to ${re_ipv4} \[${re_ipv4}\] \(gnutls_handshake\): A TLS packet with unexpected length was received./a TLS session is required for ip4.ip4.ip4.ip4 [ip4.ip4.ip4.ip4], but an attempt to start TLS failed/g;
s/TLS error on connection from \[127.0.0.1\] \(recv\): A TLS packet with unexpected length was received./TLS error on connection from [127.0.0.1] (recv): The TLS connection was non-properly terminated./g;
# signature algorithm names
s/\bgid=\d+/gid=gggg/;
s/\begid=\d+/egid=gggg/;
s/\b(?:pid=|pid\s|PID:\s|Process\s|child\s)\K(\d+)/new_value($1, "p%s", \$next_pid)/gxe;
+ s/ Ci=\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/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e;
# This handles "connection from" and the like, when the port is given
- if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/
- && !/\*>/&& !/==/ && !/\*\*/ && !/Connection refused/ && !/in response to/)
- {
- s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie;
- }
+ s/(\[${re_ip}\]:)(\d+)/$1.new_value($2,"%s",\$next_port)/ie
+ unless ( /listening for SMTP on/ || /Connecting to/
+ || /[=*-]>/ || /==/ || /\*\*/
+ || /Connection refused/ || /in response to/
+ || /T(?:ransport)?:/
+ );
# Port in host address in spool file output from -Mvh
s/^(--?host_address) (.*[:.])\d+$/$1 ${2}9999/;
# ======== IP error numbers and messages ========
# These vary between operating systems
- s/Can(no|')t assign requested address/Network Error/;
+ s/(?:Can(?:no|')t assign requested address|Address not available)/Netwk addr not available/;
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/;
s/([\s,])S=\d+\b/$1S=sss/;
s/:S\d+\b/:Ssss/;
- s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout;
+ s/^(\s*\d+[mhd]\s+)\d+(\s+(?:[[:alnum:]-]{23}|[[:alnum:]-]{16}) <)/TTT sss$2/i if $is_stdout;
s/\sSIZE=\d+\b/ SIZE=ssss/;
s/\ssize=\d+\b/ size=sss/ if $is_stderr;
s/old size = \d+\b/old size = sssss/;
# remote IPv6 addrs vary
s/^(Connection request from) \[.*:.*:.*\]$/$1 \[ipv6\]/;
+ # Hints DB use of lockfiles is provider-dependent
+ s/Failed to open \K(?:DBM|database lock) file (.*\/spool\/db\/[^.]*)(?:.lockfile)?(?=(?: for reading)?: No such file or directory$)/hintsdb $1/;
+
# openssl version variances
# Error lines on stdout from SSL contain process id values and file names.
# They also contain a source file name and line number, which may vary from
# gnutls version variances
next if /^Error in the pull function./;
+ # Retry DB record gets truncated when TESTDIR is a long string
+ s/T:.*\(MTA-imposed quota exceeded while writing to\K.*$/ <elided>)/;
+
# optional IDN2 variant conversions. Accept either IDN1 or IDN2
s/conversion strasse.de/conversion xn--strae-oqa.de/;
s/conversion: german.xn--strae-oqa.de/conversion: german.straße.de/;
# DMARC is not always supported by the build
next if /^dmarc_tld_file =/;
+ # timestamp in dmarc history file
+ s/received \K\d{10}$/1692480217/;
# 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 =/;
+ # PRDR
+ next if /^hosts_try_prdr = \*$/;
+
# 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//;
+
+ # mailq times change with when the run is done, vs. static-source spoolfiles
+ s/\s*\d*[hd](?= 317 (?:[-0-9A-Za-z]{23}|[-0-9A-Za-z]{16}) <nobody\@test.ex>)/DDd/;
+ # mailq sizes change with caller running the test
+ s/\s[01]m [34]\d\d(?= (?:[-0-9A-Za-z]{23}|[-0-9A-Za-z]{16}) <CALLER\@the.local.host.name>)/ 1m 396/;
+
+ # Not all builds include EXPERIMENTAL_DSN_INFO (1 of 2)
+ if (/^X-Exim-Diagnostic:/)
+ {
+ while (<IN>) {
+ last if (/^$/ || !/^\s/);
+ }
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
}
# ======== stderr ========
# because they will be different in different binaries.
next if /^$time_pid?
- (?: Berkeley\ DB:\s
- | Probably\ (?:Berkeley\ DB|ndbm|GDBM)
- | Using\ tdb
+ (?: .*\sBerkeley\ DB
+ | \sProbably\ (?:Berkeley\ DB|ndbm|GDBM)
+ | \sUsing\ (?:tdb|sqlite3)
| Authenticators:
| Lookups(?:\(built-in\))?:
| Support\ for:
)
/x;
+ # Hints DB use of lockfiles is provider-dependent
+ next if /lock(?:ing|ed) .*\/spool\/db\/[^.]+\.lockfile$/;
+ s/closed hints database\K and lockfile$//;
+
# 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;
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$/;
+ # some platforms are missing the standard CA bundle file
+ next if /^tls_set_watch\(\) fail on '\/usr\/(?:lib\/ssl|local\/openssl3\/etc\/pki\/tls)\/cert.pem': No such file or directory$/;
# drop lookups
next if /^$time_pid?(?: Lookups\ \(built-in\):
if (/looked up these IP addresses/);
next if /name=localhost address=::1/;
- # drop pdkim debugging header
+ # DKIM: Not all builds include
next if /^DKIM( <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+|: no signatures)$/;
+ next if /try option acl_smtp_dkim$/;
- # Some platforms have TIOCOUTome do not
+ # Some platforms have TIOCOUT, some 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/;
+ next if /^ *faking res_search\(AAAA\) response length as 65535/;
+ if (/ in dns_ipv4_lookup\?$/)
+ {
+ $_= <IN>;
+ if (/ list element: \*$/)
+ {
+ $_= <IN>;
+ next if / in dns_ipv4_lookup\? yes \(matched "\*"\)/;
+ }
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/)
{
$_= <IN>; # Gets "returning DNS_NODATA"
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/;
+ 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/;
}
# Different builds will have different lookup types included
- s/^\s*search_type \K\d+ \((\w+)\) quoting -1 \(none\)$/NN ($1) quoting -1 (none)/;
+ 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%;
+ # CONTENT_SCAN
+ next if /try option acl_(?:not_)?smtp_mime$/;
+
# DISABLE_OCSP
next if /in hosts_requ(est|ire)_ocsp\? (no|yes)/;
+ # WELLKNOWN
+ next if / in wellknown_advertise_hosts\?/;
+
# SUPPORT_PROXY
next if /host in hosts_proxy\?/;
}
next if / in limits_advertise_hosts?\? no \(matched "!\*"\)/;
+ # Experimental_XCLIENT
+ next if / in hosts_xclient\? no \(option unset\)/;
+
+ # Experimental_WELLKNOWN
+ next if / in hosts_wellknown\? no \(option unset\)/;
+
# TCP Fast Open
next if /^(ppppp )?setsockopt FASTOPEN: Network Error/;
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/((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/;
# Non-TLS builds have different expansions for received_header_text
if (s/(with \$received_protocol)\}\} \$\{if def:tls_cipher \{\(\$tls_cipher\)\n$/$1/)
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)/;
+ next if /(^spf_conn_init|^SPF_dns_exim_new|spf_compile\.c)/;
+ next if /try option spf_smtp_comment_template$/;
# Not all platforms have sendfile support
next if /^cannot use sendfile for body: no support$/;
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\)|no \(end of list\)|yes \(matched "\*"\))\n$//)
- {
- chomp;
- $_ .= <IN>;
- s/ \.\.\. >>> / ... /;
+ next if /\S+ in hosts_try_fastopen\? (no \(option unset\)|no \(end of list\)|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$//) { chomp; $_ .= <IN>; }
s/Address family not supported by protocol family/Network Error/;
- s/Network is unreachable/Network Error/;
- }
+ s/Network(?: is)? unreachable/Network Error/;
+# }
next if /^(ppppp |\d+ )?setsockopt FASTOPEN: Protocol not available$/;
- s/^(Connecting to .* \.\.\. sending) \d+ (nonTFO early-data)$/$1 dd $2/;
+ s/^(sending) \d+ (nonTFO early-data)$/$1 dd $2/;
- if (/^([0-9: ]* # possible timestamp
- Connecting\ to\ [^ ]+\ [^ ]+(\ from\ [^ ]+)?)\ \.\.\.
+ if (/^[0-9: ]* # possible timestamp
\ .*TFO\ mode\x20
(sendto,\ no\ data:\ EINPROGRESS # Linux
|connection\ attempt\ to\ [^,]+,\ 0\ data) # MacOS & no-support
$/x)
{
- $_ = $1 . " ... " . <IN>;
- s/^(.* \.\.\.) [0-9: ]*connected$/$1 connected/;
-
- if (/^Connecting to .* \.\.\. connected$/)
+ $_ = <IN>;
+ if (/^connected$/)
{
$_ .= <IN>;
- if (/^(Connecting to .* \.\.\. )connected\n\s+SMTP(\(close\)>>|\(Connection refused\)<<)$/)
+ if (/^connected\n\s+SMTP(\(close\)>>|\(Connection refused\)<<)$/)
{
- $_ = $1 . "failed: Connection refused\n" . <IN>;
- s/^(Connecting .*)\n\s+SMTP\(close\)>>$/$1/;
+ $_ = "failed: Connection refused\n" . <IN>;
+ s/^\n\s+SMTP\(close\)>>$/$1/;
}
- elsif (/^(Connecting to .* \.\.\. connected\n)read response data: size=/)
+ elsif (/^(connected\n)read response data: size=/)
{ $_ = $1; }
# Date/time in SMTP banner
next if / Berkeley DB error: /;
# CHUNKING: exact sizes depend on hostnames in headers
- s/(=>.* K C="250- \d)\d+ (byte chunk, total \d)\d+/$1nn $2nn/;
+ s/(=>.* K (?:DKIM=\S+ )?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/;
- next if /TLS error \(SSL_read\): error:0A000126:SSL routines::unexpected eof while reading$/ ;
+ 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:PEM_read_bio:no start line$/1E08010C:DECODER routines::unsupported/;
# DKIM timestamps
- if ( /(DKIM: d=.*) t=([0-9]*) x=([0-9]*) / )
+ 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} /;
}
+ else
+ { s/DKIM: d=.* \Kt=[0-9]* \[/t=T [/; }
# 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/;
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>>/;
+
+ # Not all buildfarm animals have ipv6
+ next if /<dns:fail> <DNS_(?:NOMATCH|AGAIN):.*:AAAA>$/ ;
}
# ======== mail ========
<IN>;
<IN>;
}
+ elsif ( /^(\s+)t=([0-9]*); b=[A-Za-z0-9+\/]+$/ )
+ {
+ my $indent = $1;
+ s/.*/${indent}t=T; b=bbbb;/;
+ <IN>;
+ <IN>;
+ }
+
+ # Not all builds include EXPERIMENTAL_DSN_INFO (2 of 2)
+ if (/^X-Exim-Diagnostic:/)
+ {
+ while (<IN>) {
+ last if (/^$/ || !/^\s/);
+ }
+ goto RESET_AFTER_EXTRA_LINE_READ;
+ }
}
# ======== All files other than stderr ========
for (my $i = 0; $i < @munged; $i++)
{
- if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/)
+ if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}(\.\d{3})?\s[-A-Za-z\d]{23}\s[-=*]>/)
{
my $j;
for ($j = $i + 1; $j < @munged; $j++)
{
last if $munged[$j] !~
- /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/;
+ /^[-\d]{10}\s[:\d]{8}(\.\d{3})?\s[-A-Za-z\d]{23}\s[-=*]>/;
}
@temp = splice(@munged, $i, $j - $i);
@temp = sort(@temp);
# 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 =
},
'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' =>
'timeout_errno' => # actual errno differs Solaris vs. Linux
{ 'mainlog' => 's/((?:host|message) deferral .* errno) <\d+> /$1 <EEE> /' },
- 'peer_terminated_conn' => # actual error differs FreedBSD vs. Linux
+ 'peer_terminated_conn' => # actual error differs FreedBS/Solaris vs. Linux
{ 'stderr' => 's/^( SMTP\()Connection reset by peer(\)<<)$/$1closed$2/' },
'perl_variants' => # result of hash-in-scalar-context changed from bucket-fill to keycount
foreach $msglog (@msglogs)
{
next if ($msglog eq "." || $msglog eq ".." || $msglog eq "CVS");
+
($munged_msglog = $msglog) =~
s/((?:[^\W_]{6}-){2}[^\W_]{2})
- /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
+ /new_value($1, "10Hm%s-0005vi-00", \$next_msgid_old)/egx;
+
+ $munged_msglog =~
+ s/([^\W_]{6}-[^\W_]{11}-[^\W_]{4})
+ /new_value($1, "10Hm%s-000000005vi-0000", \$next_msgid)/egx;
+
$yield = max($yield, check_file("spool/msglog/$msglog", undef,
"test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
$munge->{msglog}));
# Arguments: the current test number
# reference to the subtest number, holding previous value
# reference to the expected return code value
+# reference to flag for not-expected return value
# reference to where to put the command name (for messages)
# auxiliary information returned from a previous run
#
sub run_command{
my($testno) = $_[0];
my($subtestref) = $_[1];
-my($commandnameref) = $_[3];
-my($aux_info) = $_[4];
+my($commandnameref) = $_[4];
+my($aux_info) = $_[5];
my($yield) = 1;
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;
+ my($r, $rn) = ($_[2], $_[3]);
+ $$r = $2 << 8;
+ $$rn = 1 if (defined $1);
+ $ENV{$3} = $4 if (defined $3);
$_ = <SCRIPT>;
return 4 if !defined $_; # Missing command
$lineno++;
}
+# The "exim_id_update" command runs exim_id_update on the current spool
+
+if (/^exim_id_update(\s+.*)?$/)
+ {
+ run_system("(sudo ./eximdir/exim_id_update" . ($1 || '') . " $parm_cwd/spool/input;" .
+ "echo exim_id_update exit code = \$?)" .
+ ">>test-stdout 2>>test-stderr");
+ return 1;
+ }
+
+
# The "gnutls" command makes a copy of saved GnuTLS parameter data in the
# spool directory, to save Exim from re-creating it each time.
# Various Unix management commands are recognized
if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ ||
- /^sudo\s(rmdir|rm|mv|chown|chmod)\s/)
+ /^sudo\s(mkdir|rmdir|rm|mv|cp|chown|chmod)\s/)
{
run_system("$_ >>test-stdout 2>>test-stderr");
return 1;
}
+if (/^cat2\s/)
+ {
+ s/^cat2/cat/;
+ run_system("$_ 2>&1 >test-stderr");
+ return 1;
+ }
if (/^client/ || /^(sudo\s+)?perl\b/)
{
+ if (defined($tls)) {
+ s/^client-anytls/client-ssl/ if ($tls eq 'openssl');
+ s/^client-anytls/client-gnutls/ if ($tls eq 'gnutls');
+ }
s"client"./bin/client";
$cmd = "$_ >>test-stdout 2>>test-stderr";
}
if (defined $queuespec)
{
- @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
+ @listcmd = ("$parm_cwd/$exim_server", '-bp',
$queuespec,
- "-DEXIM_PATH=$parm_cwd/eximdir/exim",
+ "-DEXIM_PATH=$parm_cwd$exim_server",
-C => "$parm_cwd/test-config");
}
else
{
- @listcmd = ("$parm_cwd/eximdir/exim", '-bp',
- "-DEXIM_PATH=$parm_cwd/eximdir/exim",
+ @listcmd = ("$parm_cwd/$exim_server", '-bp',
+ "-DEXIM_PATH=$parm_cwd/$exim_server",
-C => "$parm_cwd/test-config");
}
print ">> Getting queue list from:\n>> @listcmd\n" if $debug;
my $opt_valgrind = $valgrind ? "valgrind --leak-check=yes --suppressions=$parm_cwd/aux-fixed/valgrind.supp " : '';
- $cmd = "$envset$sudo$opt_valgrind" .
- "$parm_cwd/eximdir/exim$special$optargs " .
- "-DEXIM_PATH=$parm_cwd/eximdir/exim$special " .
- "-C $parm_cwd/test-config $args " .
+ $cmd = "$envset$sudo$opt_valgrind";
+
+ if ($special ne '') {
+ $cmd .= "$parm_cwd/eximdir/exim$special$optargs " .
+ "-DEXIM_PATH=$parm_cwd/eximdir/exim$special ";
+ }
+ elsif ($args =~ /(^|\s)-DSERVER=server\s/) {
+ $cmd .= "$parm_cwd/$exim_server$optargs " .
+ "-DEXIM_PATH=$parm_cwd/$exim_server ";
+ }
+ else {
+ $cmd .= "$parm_cwd/$exim_client$optargs " .
+ "-DEXIM_PATH=$parm_cwd/$exim_client ";
+ }
+
+ $cmd .= "-C $parm_cwd/test-config $args " .
">>test-stdout 2>>test-stderr";
+
# If the command is starting an Exim daemon, we run it in the same
# way as the "server" command above, that is, we don't want to wait
# for the process to finish. That happens when "killdaemon" is obeyed later
sub check_running_dovecot
{
-system('dovecot --version >/dev/null');
+system('dovecot --version >/dev/null 2>&1');
if ($? == 0)
{
print "Dovecot appears to be available\n";
'ipv6!' => \$have_ipv6,
'keep' => \$save_output,
'slow' => \$slow,
+ 'tls=s' => \my $tls,
'valgrind' => \$valgrind,
'range=s{2}' => \my @range_wanted,
'test=i@' => \my @tests_wanted,
print "Exim binary is `$parm_exim'\n" if defined $parm_exim;
+my %wanted;
my @wanted = sort numerically uniq
@tests_wanted ? @tests_wanted : (),
@range_wanted ? $range_wanted[0] .. $range_wanted[1] : (),
0+$ARGV[0]..0+$ARGV[1] # add 0 to cope with test numbers starting with zero
: ();
@wanted = 1..TEST_TOP if not @wanted;
+map { $wanted{sprintf("%04d",$_)}= $_; } @wanted;
##################################################
# Check for sudo access to root #
}
elsif (/^Support for: (.*)/)
- {
+ { # Compile-time features - exim -bV
print;
@temp = split /(\s+)/, $1;
push(@temp, ' ');
die "** Unable to make patched exim: $!\n"
if (system("sudo ./patchexim $parm_exim") != 0);
+# If TLS-library-specific binaries have been made, grab them too
+
+$suff = 'openssl';
+$f = $parm_exim . '_' . $suff;
+if (-f $f) {
+ $exim_openssl = "eximdir/exim_$suff";
+ die "** Unable to make patched exim: $!\n"
+ if (system("sudo ./patchexim -o $exim_openssl $f") != 0);
+ }
+$suff = 'gnutls';
+$f = $parm_exim . '_' . $suff;
+if (-f $f) {
+ $exim_gnutls = "eximdir/exim_$suff";
+ die "** Unable to make patched exim: $!\n"
+ if (system("sudo ./patchexim -o $exim_gnutls $f") != 0);
+ }
+
+if (defined($tls))
+ {
+ die "** Need both $exim_openssl and $exim_gnutls for cross-library teting\n"
+ if ( !defined($exim_openssl) || !defined($exim_gnutls) );
+ if ($tls eq 'openssl')
+ {
+ $exim_client = $exim_openssl;
+ $exim_server = $exim_gnutls;
+ }
+ elsif ($tls eq 'gnutls')
+ {
+ $exim_client = $exim_gnutls;
+ $exim_server = $exim_openssl;
+ }
+ else
+ { die "** need eother openssl or gnutls speified as the client for cross-library testing, saw $tls\n"; }
+ }
+else
+ { $exim_client = $exim_server = 'eximdir/exim'; }
+print ">> \$exim_client <$exim_client>\n";;
+print ">> \$exim_server <$exim_server>\n";;
+
# From this point on, exits from the program must go via the subroutine
# tests_exit(), so that suitable cleaning up can be done when required.
# Arrange to catch interrupting signals, to assist with this.
$dbm_build_deleted = 1;
}
-foreach my $tool (qw(exim_dumpdb exim_lock exinext exigrep eximstats exiqgrep exim_msgdate)) {
+foreach my $tool (qw(exim_dumpdb exim_lock exinext exigrep eximstats exiqgrep exim_msgdate exim_id_update)) {
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 exiqgrep)) {
+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 (.*)$/)
+ { #a macro name, or lack thereof - -bP macros
# 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");
# We want the tests from this subdirectory, provided they are in the
# range that was selected.
- @testlist = grep { $_ ~~ @wanted } grep { /^\d+(?:\.\d+)?$/ } map { basename $_ } glob "scripts/$testdir/*";
+ undef @testlist;
+ map { push @testlist, $_ if exists $wanted{$_} } grep { /^\d+(?:\.\d+)?$/ } map { basename $_ } glob "scripts/$testdir/*";
+
tests_exit(-1, "Failed to read test scripts from `scripts/$testdir/*': $!")
if not @testlist;
# set up the initial sequence strings.
undef %cache;
+ $next_msgid_old = "aX";
$next_msgid = "aX";
$next_pid = 1234;
$next_port = 1111;
# was run and not waited for (usually a daemon or server startup).
my($commandname) = '';
- my($expectrc) = 0;
- my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$commandname, $TEST_STATE);
+ my($expectrc, $expect_not) = (0, 0);
+ my($rc, $run_extra) = run_command($testno, \$subtestno, \$expectrc, \$expect_not, \$commandname, $TEST_STATE);
my($cmdrc) = $?;
if ($debug) {
# We ran and waited for a command. Check for the expected result unless
# it died.
- if ($cmdrc != $expectrc && !$sigpipehappened)
+ if (!$sigpipehappened && ($expect_not ? ($cmdrc == $expectrc) : ($cmdrc != $expectrc)))
{
printf("** Command $commandno (\"$commandname\", starting at line $subtest_startline)\n");
if (($cmdrc & 0xff) == 0)
{
- printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256);
+ if ($expect_not)
+ { printf("** Return code %d (expected anything but that)", $cmdrc/256); }
+ else
+ { printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256); }
}
elsif (($cmdrc & 0xff00) == 0)
{ printf("** Killed by signal %d", $cmdrc & 255); }
=cut
+# vi: aw ai sw=2
# End of runtest script
git://git.exim.org / exim.git / blobdiff