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 = '';
# 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;
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.
# 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 ========
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/)
{
# TLS resumption is not always supported by the build
next if /in tls_resumption_hosts\?/;
- # Most builds are without HAVE_LOCAL_SCAN
- next if /^calling local_scan\(\); timeout=300$/;
- next if /^local_scan\(\) returned 0 NULL$/;
-
# Platform differences in errno strings
s/ SMTP\(Operation timed out\)<</ SMTP(Connection timed out)<</;
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;)/'
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;
}
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
# 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,
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';
}
}
projects / exim.git / blobdiff