# This gets embedded in the D-H params filename, and the value comes
# from asking GnuTLS for "normal", but there appears to be no way to
# use certtool/... to ask what that value currently is. *sigh*
-# This value is correct as of GnuTLS 2.12.18.
-#
-$gnutls_dh_bits_normal = 2432;
+# We also clamp it because of NSS interop, see addition of tls_dh_max_bits.
+# This value is correct as of GnuTLS 2.12.18 as clamped by tls_dh_max_bits.
+# normal = 2432 tls_dh_max_bits = 2236
+$gnutls_dh_bits_normal = 2236;
$cf = "bin/cf -exact";
$cr = "\r";
$debug = 0;
+$force_continue = 0;
$force_update = 0;
+$log_failed_filename = "failed-summary.log";
$more = "less -XF";
$optargs = "";
$save_output = 0;
$parm_port_d3 = 1227; # Additional for daemon
$parm_port_d4 = 1228; # Additional for daemon
+# Manually set locale
+$ENV{'LC_ALL'} = 'C';
+
###############################################################################
system("sudo /bin/rm -rf ./spool test-* ./dnszones/*")
if ($rc == 0 && !$save_output);
-system("sudo /bin/rm -rf ./eximdir/*");
+system("sudo /bin/rm -rf ./eximdir/*")
+ if (!$save_output);
print "\nYou were in test $test at the end there.\n\n" if defined $test;
exit $rc if ($rc >= 0);
sub munge {
my($file) = $_[0];
+my($extra) = $_[1];
my($yield) = 0;
my(@saved) = ();
# that are specific to certain file types, though there are also some of those
# inline too.
-while(<IN>)
+LINE: while(<IN>)
{
RESET_AFTER_EXTRA_LINE_READ:
+ # Custom munges
+ if ($extra)
+ {
+ next if $extra =~ m%^/% && eval $extra;
+ eval $extra if $extra =~ m/^s/;
+ }
+
# Check for "*** truncated ***"
$yield = 1 if /\*\*\* truncated \*\*\*/;
# But convert "name=the.local.host address=127.0.0.1" to use "localhost"
s/name=the\.local\.host address=127\.0\.0\.1/name=localhost address=127.0.0.1/g;
+ # The name of the shell may vary
+ s/\s\Q$parm_shell\E\b/ ENV_SHELL/;
+
# Replace the path to the testsuite directory
s?\Q$parm_cwd\E?TESTSUITE?g;
# The message for a non-listening FIFO varies
s/:[^:]+: while opening named pipe/: Error: while opening named pipe/;
- # The name of the shell may vary
- s/\s\Q$parm_shell\E\b/ SHELL/;
-
# 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+/;
# So far, have seen:
# TLSv1:AES256-SHA:256
# TLSv1.2:AES256-GCM-SHA384:256
+ # TLSv1.2:DHE-RSA-AES256-SHA:256
+ # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
# We also need to handle the ciphersuite without the TLS part present, for
# client-ssl's output. We also see some older forced ciphersuites, but
# negotiating TLS 1.2 instead of 1.0.
s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.2:/$1TLSv1:/xg;
s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
+ s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
+
+ # GnuTLS have seen:
+ # TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical)
+ # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
+ #
+ # X=TLS1.2:DHE_RSA_AES_256_CBC_SHA256:256
+ # X=TLS1.2:RSA_AES_256_CBC_SHA1:256
+ # X=TLS1.1:RSA_AES_256_CBC_SHA1:256
+ # X=TLS1.0:DHE_RSA_AES_256_CBC_SHA1:256
+ # and as stand-alone cipher:
+ # DHE-RSA-AES256-SHA256
+ # DHE-RSA-AES256-SHA
+ # picking latter as canonical simply because regex easier that way.
+ s/\bDHE_RSA_AES_128_CBC_SHA1:128/RSA_AES_256_CBC_SHA1:256/g;
+ s/TLS1.[012]:(DHE_)?RSA_AES_256_CBC_SHA(1|256):256/TLS1.x:xxxxRSA_AES_256_CBC_SHAnnn:256/g;
+ s/\bDHE-RSA-AES256-SHA256\b/DHE-RSA-AES256-SHA/g;
+
+ # -d produces a list of environement variables as they are checked if they exist in the
+ # in the environment. Unfortunately this list isn't always in the same order. For now we
+ # just remove this list
+ #
+ if (/^\w+ in keep_environment/)
+ {
+ my @lines = $_;
+ while (<IN>)
+ {
+ if (/^\w+ in keep_environment/)
+ {
+ push @lines, $_;
+ next;
+ }
+ print MUNGED sort grep { !/^(SHLVL|_) / } @lines;
+ redo LINE;
+ }
+ }
# ======== Caller's login, uid, gid, home, gecos ========
s/(TLS error on connection (?:from|to) .*? \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
-
# ======== Maildir things ========
# timestamp output in maildir processing
s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g;
# be the case
next if /^changing group to \d+ failed: Operation not permitted/;
+ # We might not keep this check; rather than change all the tests, just
+ # ignore it as long as it succeeds; then we only need to change the
+ # TLS tests where tls_require_ciphers has been set.
+ if (m{^changed uid/gid: calling tls_validate_require_cipher}) {
+ my $discard = <IN>;
+ next;
+ }
+ next if /^tls_validate_require_cipher child \d+ ended: status=0x0/;
+
# We invoke Exim with -D, so we hit this new messag as of Exim 4.73:
next if /^macros_trusted overridden to true by whitelisting/;
# Arguments: [0] the prompt string
# [1] if there is a U in the prompt and $force_update is true
+# [2] if there is a C in the prompt and $force_continue is true
# Returns: nothing (it sets $_)
sub interact{
print $_[0];
if ($_[1]) { $_ = "u"; print "... update forced\n"; }
+ elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; }
else { $_ = <T>; }
}
+##################################################
+# Subroutine to log in force_continue mode #
+##################################################
+
+# In force_continue mode, we just want a terse output to a statically
+# named logfile. If multiple files in same batch (stdout, stderr, etc)
+# all have mismatches, it will log multiple times.
+#
+# Arguments: [0] the logfile to append to
+# [1] the testno that failed
+# Returns: nothing
+
+
+
+sub log_failure {
+ my $logfile = shift();
+ my $testno = shift();
+ my $detail = shift() || '';
+ if ( open(my $fh, ">>", $logfile) ) {
+ print $fh "Test $testno $detail failed\n";
+ close $fh;
+ }
+}
+
+
##################################################
# Subroutine to compare one output file #
# [2] where to put the munged copy
# [3] the name of the saved file
# [4] TRUE if this is a log file whose deliveries must be sorted
+# [5] optionally, a custom munge command
#
# Returns: 0 comparison succeeded or differences to be ignored
# 1 comparison failed; files may have been updated (=> re-compare)
# Does not return if the user replies "Q" to a prompt.
sub check_file{
-my($rf,$rsf,$mf,$sf,$sortfile) = @_;
+my($rf,$rsf,$mf,$sf,$sortfile,$extra) = @_;
# If there is no saved file, the raw files must either not exist, or be
# empty. The test ! -s is TRUE if the file does not exist or is empty.
for (;;)
{
print "Continue, Show, or Quit? [Q] ";
- $_ = <T>;
+ $_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, $rf) if (/^c$/i && $force_continue);
return 0 if /^c$/i;
last if (/^s$/);
}
print "\n";
for (;;)
{
- interact("Continue, Update & retry, Quit? [Q] ", $force_update);
+ interact("Continue, Update & retry, Quit? [Q] ", $force_update, $force_continue);
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, $rsf) if (/^c$/i && $force_continue);
return 0 if /^c$/i;
last if (/^u$/i);
}
# data that does exist.
open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
-my($truncated) = munge($rf) if -e $rf;
+my($truncated) = munge($rf, $extra) if -e $rf;
if (defined $rsf && -e $rsf)
{
print MUNGED "\n******** SERVER ********\n";
- $truncated |= munge($rsf);
+ $truncated |= munge($rsf, $extra);
}
close(MUNGED);
print "\n";
for (;;)
{
- interact("Continue, Retry, Update & retry, Quit? [Q] ", $force_update);
+ interact("Continue, Retry, Update & retry, Quit? [Q] ", $force_update, $force_continue);
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, $sf) if (/^c$/i && $force_continue);
return 0 if /^c$/i;
return 1 if /^r$/i;
last if (/^u$/i);
+##################################################
+# Custom munges
+# keyed by name of munge; value is a ref to a hash
+# which is keyed by file, value a string to look for.
+# Usable files are:
+# paniclog, rejectlog, mainlog, stdout, stderr, msglog, mail
+# Search strings starting with 's' do substitutions;
+# with '/' do line-skips.
+##################################################
+$munges =
+ { 'dnssec' =>
+ { 'stderr' => '/^Reverse DNS security status: unverified\n/', },
+
+ 'gnutls_unexpected' =>
+ { 'mainlog' => '/\(recv\): A TLS packet with unexpected length was received./', },
+
+ 'gnutls_handshake' =>
+ { 'mainlog' => 's/\(gnutls_handshake\): Error in the push function/\(gnutls_handshake\): A TLS packet with unexpected length was received/', },
+
+ };
+
+
##################################################
# Subroutine to check the output of a test #
##################################################
# This function is called when the series of subtests is complete. It makes
-# use of check() file, whose arguments are:
+# use of check_file(), whose arguments are:
#
# [0] the name of the main raw output file
# [1] the name of the server raw output file or undef
# [2] where to put the munged copy
# [3] the name of the saved file
# [4] TRUE if this is a log file whose deliveries must be sorted
+# [5] an optional custom munge command
#
-# Arguments: none
+# Arguments: Optionally, name of a custom munge to run.
# Returns: 0 if the output compared equal
# 1 if re-run needed (files may have been updated)
sub check_output{
+my($mungename) = $_[0];
my($yield) = 0;
+my($munge) = $munges->{$mungename} if defined $mungename;
$yield = 1 if check_file("spool/log/paniclog",
"spool/log/serverpaniclog",
"test-paniclog-munged",
- "paniclog/$testno", 0);
+ "paniclog/$testno", 0,
+ $munge->{'paniclog'});
$yield = 1 if check_file("spool/log/rejectlog",
"spool/log/serverrejectlog",
"test-rejectlog-munged",
- "rejectlog/$testno", 0);
+ "rejectlog/$testno", 0,
+ $munge->{'rejectlog'});
$yield = 1 if check_file("spool/log/mainlog",
"spool/log/servermainlog",
"test-mainlog-munged",
- "log/$testno", $sortlog);
+ "log/$testno", $sortlog,
+ $munge->{'mainlog'});
if (!$stdout_skip)
{
$yield = 1 if check_file("test-stdout",
"test-stdout-server",
"test-stdout-munged",
- "stdout/$testno", 0);
+ "stdout/$testno", 0,
+ $munge->{'stdout'});
}
if (!$stderr_skip)
$yield = 1 if check_file("test-stderr",
"test-stderr-server",
"test-stderr-munged",
- "stderr/$testno", 0);
+ "stderr/$testno", 0,
+ $munge->{'stderr'});
}
# Compare any delivered messages, unless this test is skipped.
print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
$yield = 1 if check_file($mail, undef, "test-mail-munged",
- "mail/$testno.$saved_mail", 0);
+ "mail/$testno.$saved_mail", 0,
+ $munge->{'mail'});
delete $expected_mails{"mail/$testno.$saved_mail"};
}
for (;;)
{
- interact("Continue, Update & retry, or Quit? [Q] ", $force_update);
+ interact("Continue, Update & retry, or Quit? [Q] ", $force_update, $force_continue);
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, "missing email") if (/^c$/i && $force_continue);
last if /^c$/i;
# For update, we not only have to unlink the file, but we must also
s/((?:[^\W_]{6}-){2}[^\W_]{2})
/new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
$yield = 1 if check_file("spool/msglog/$msglog", undef,
- "test-msglog-munged", "msglog/$testno.$munged_msglog", 0);
+ "test-msglog-munged", "msglog/$testno.$munged_msglog", 0,
+ $munge->{'msglog'});
delete $expected_msglogs{"$testno.$munged_msglog"};
}
}
for (;;)
{
- interact("Continue, Update, or Quit? [Q] ", $force_update);
+ interact("Continue, Update, or Quit? [Q] ", $force_update, $force_continue);
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/i && $force_continue);
last if /^c$/i;
if (/^u$/i)
{
# 4 EOF was encountered after an initial return code line
# Optionally alse a second parameter, a hash-ref, with auxilliary information:
# exim_pid: pid of a run process
+# munge: name of a post-script results munger
sub run_command{
my($testno) = $_[0];
my($aux_info) = $_[4];
my($yield) = 1;
+our %ENV = map { $_ => $ENV{$_} } grep { /^(?:USER|SHELL|PATH|TERM|EXIM_TEST_.*)$/ } keys %ENV;
+
if (/^(\d+)\s*$/) # Handle unusual return code
{
my($r) = $_[2];
}
+# The "munge" command selects one of a hardwired set of test-result modifications
+# to be made before result compares are run agains the golden set. This lets
+# us account for test-system dependent things which only affect a few, but known,
+# test-cases.
+# Currently only the last munge takes effect.
+
+if (/^munge\s+(.*)$/)
+ {
+ return (0, { munge => $1 });
+ }
+
+
# The "sleep" command does just that. For sleeps longer than 1 second we
# tell the user what's going on.
# not drop privilege when -C and -D options are present. To run the exim
# command as root, we use sudo.
-elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/)
+elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+)?\s+(.*)$/)
{
- $args = $5;
+ $args = $6;
my($envset) = (defined $1)? $1 : "";
- my($sudo) = (defined $3)? "sudo " : "";
- my($special)= (defined $4)? $4 : "";
+ my($sudo) = (defined $3)? "sudo " . (defined $4 ? "-u $4 ":"") : "";
+ my($special)= (defined $5)? $5 : "";
$wait_time = (defined $2)? $2 : 0;
# Return 2 rather than 1 afterwards
{
if ($arg eq "-DEBUG") { $debug = 1; $cr = "\n"; next; }
if ($arg eq "-DIFF") { $cf = "diff -u"; next; }
+ if ($arg eq "-CONTINUE"){$force_continue = 1;
+ $more = "cat";
+ next; }
if ($arg eq "-UPDATE") { $force_update = 1; next; }
if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; }
if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; }
print "\n*** Host name is not fully qualified: this may cause problems ***\n\n";
}
-# Find the user's shell
+if ($parm_hostname =~ /[[:upper:]]/)
+ {
+ print "\n*** Host name has upper case characters: this may cause problems ***\n\n";
+ }
-$parm_shell = $ENV{'SHELL'};
##################################################
}
}
+# Set a user's shell, distinguishable from /bin/sh
+
+symlink("/bin/sh","aux-var/sh");
+$ENV{'SHELL'} = $parm_shell = $parm_cwd . "/aux-var/sh";
##################################################
# Create fake DNS zones for this host #
$exp_v6 = $1 . ':0' x (8-length($exp_v6)) . ':' . $2;
} elsif ( $parm_ipv6 =~ /^::(.+[^:])$/ ) {
$exp_v6 = '0:' x (9-length($exp_v6)) . $1;
+ } else {
+ $exp_v6 = $parm_ipv6;
}
my(@components) = split /:/, $exp_v6;
my(@nibbles) = reverse (split /\s*/, shift @components);
open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!");
print "\nPress RETURN to run the tests: ";
-$_ = <T>;
+$_ = $force_continue ? "c" : <T>;
print "\n";
$lasttestdir = "";
for (;;)
{
print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
- $_ = <T>;
+ $_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue);
+ print "... continue forced\n" if $force_continue;
last if /^[rc]$/i;
if (/^e$/i)
{
for (;;)
{
print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
- $_ = <T>;
+ $_ = $force_continue ? "c" : <T>;
tests_exit(1) if /^q?$/i;
+ log_failure($log_failed_filename, $testno, "exit code unexpected") if (/^c$/i && $force_continue);
+ print "... continue forced\n" if $force_continue;
last if /^[rc]$/i;
if (/^s$/i)
if ($docheck)
{
- if (check_output() != 0)
+ if (check_output($TEST_STATE->{munge}) != 0)
{
print (("#" x 79) . "\n");
redo;
git://git.exim.org / exim.git / blobdiff