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 = '';
# 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})
# 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;
# 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;
# 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/(^|\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 ========
last if !defined $_;
+ # SRS timestamps and signatures vary by hostname and from run to run
+
+ s/SRS0=....=..=[^=]+=[^@]+\@test.ex/SRS0=ZZZZ=YY=the.local.host.name=CALLER\@test.ex/;
+
+
# ======== 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 ========
# TLS resumption is not always supported by the build
next if /^tls_resumption_hosts =/;
next if /^-tls_resumption/;
+
+ # gsasl library version may not support some methods
+ s/250-AUTH ANONYMOUS PLAIN SCRAM-SHA-1\K SCRAM-SHA-256//;
}
# ======== stderr ========
s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
s/^(proxy-proc \w{5}-pid) \d+$/$1 pppp/;
+ s/^(?:\s*\d+ )(exec .* -oPX)$/pppp $1/;
+ next if /(?:postfork: | fork(?:ing|ed) for )/;
# IP address lookups use gethostbyname() when IPv6 is not supported,
# and gethostbyname2() or getipnodebyname() when it is.
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$/;
+
# drop lookups
next if /^Lookups \(built-in\):/;
next if /^Loading lookup modules from/;
# 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;
+ # daemon notifier socket
+ s/^(\s*\d+|ppppp) (creating notifier socket)$/ppppp $2/;
+ s/^ \@(.*exim_daemon_notify)$/ $1/;
+ s/^(\s*\d+|ppppp) \@?(.*exim_daemon_notify)$/ppppp $2/;
+ next if /unlinking notifier socket/;
+
# DISABLE_OCSP
next if /in hosts_requ(est|ire)_ocsp\? (no|yes)/;
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/;
}
# 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: /;
+
+ # Some platforms have to flip to slow-mode taint-checking
+ next if /switching to slow-mode taint checking/;
+
# 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
my ($prefix, $t_diff) = ($1, $3 - $2);
s/DKIM: d=.* t=[0-9]* x=[0-9]* /${prefix} t=T x=T+${t_diff} /;
}
+ # GnuTLS reports a different keysize vs. OpenSSL, for ed25519 keys
+ s/signer: [^ ]* bits:\K 256/ 253/;
+ s/public key too short:\K 256 bits/ 253 bits/;
# port numbers
s/(?:\[[^\]]*\]:|port )\K$parm_port_d/PORT_D/;
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/;
}
# ======== 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 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);
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' },
+ { '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;)/'
},
'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/' },
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/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;
+ print $out @temp;
}
-
- close(IN);
- close(OUT);
+ close($in); # close it explicitly, otherwise $? does not get set
return 1;
}
# 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
}
}
# 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,
{
if (/^(?:[0-9]+: )?([a-z0-9]+): /) { $ifname = $1; }
- if (not $parm_ipv4 and /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
+ if (not $parm_ipv4 and /^\s*inet(?:\saddr(?:ess))?:?\s*(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
{
# 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.
$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 '::' or $1 eq '::1' or $1 =~ /^ff00/i or $1 =~ /^fe80::1/i;
$parm_ipv6 = $1;
}
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\": \"$_\"");
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]") ||
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';
}
}
git://git.exim.org / exim.git / blobdiff