X-Git-Url: https://git.exim.org/users/jgh/exim.git/blobdiff_plain/7d99e6a1f26e03dea6988a18bf950c428ff4b5aa..2ce45f59d7f070fa3d96f88523a6e19a0e68aae2:/test/runtest?ds=inline diff --git a/test/runtest b/test/runtest index 3e961ca98..57caa2c1f 100755 --- a/test/runtest +++ b/test/runtest @@ -36,7 +36,9 @@ $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; @@ -75,6 +77,9 @@ $parm_port_d2 = 1226; # Additional for daemon $parm_port_d3 = 1227; # Additional for daemon $parm_port_d4 = 1228; # Additional for daemon +# Manually set locale +$ENV{'LC_ALL'} = 'C'; + ############################################################################### @@ -188,7 +193,8 @@ close(T); 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); @@ -310,6 +316,7 @@ return @yield; sub munge { my($file) = $_[0]; +my($extra) = $_[1]; my($yield) = 0; my(@saved) = (); @@ -335,6 +342,13 @@ $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; while() { 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 \*\*\*/; @@ -344,6 +358,9 @@ RESET_AFTER_EXTRA_LINE_READ: # 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; @@ -391,9 +408,6 @@ RESET_AFTER_EXTRA_LINE_READ: # 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+/; @@ -484,7 +498,9 @@ RESET_AFTER_EXTRA_LINE_READ: # treat the standard algorithms the same. # So far, have seen: # TLSv1:AES256-SHA:256 + # TLSv1.1: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 @@ -492,10 +508,13 @@ RESET_AFTER_EXTRA_LINE_READ: # Mail headers (...), log-lines X=..., client-ssl output ... # (and \b doesn't match between ' ' and '(' ) - s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.2:/$1TLSv1:/xg; + s/( (?: (?:\b|\s) [\(=] ) | \s )TLSv1\.[12]:/$1TLSv1:/xg; s/\bAES256-GCM-SHA384\b/AES256-SHA/g; + s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g; # GnuTLS have seen: + # TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256 + # TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128 # TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical) # TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128 # @@ -504,12 +523,29 @@ RESET_AFTER_EXTRA_LINE_READ: # X=TLS1.1:RSA_AES_256_CBC_SHA1:256 # X=TLS1.0:DHE_RSA_AES_256_CBC_SHA1:256 # and as stand-alone cipher: + # ECDHE-RSA-AES256-SHA # 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; + s/TLS1.[012]:((EC)?DHE_)?RSA_AES_(256|128)_(CBC|GCM)_SHA(1|256|384):(256|128)/TLS1.x:xxxxRSA_AES_256_CBC_SHAnnn:256/g; + s/\b(ECDHE-RSA-AES256-SHA|DHE-RSA-AES256-SHA256)\b/AES256-SHA/g; + + # GnuTLS library error message changes + s/No certificate was found/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/\(gnutls_priority_set\): No or insufficient priorities were set/\(gnutls_handshake\): Could not negotiate a supported cipher suite/g; + + # (this new one is a generic channel-read error, but the testsuite + # only hits it in one place) + s/TLS error on connection to \d{1,3}(.\d{1,3}){3} \[\d{1,3}(.\d{1,3}){3}\] \(gnutls_handshake\): Error in the pull function\./a TLS session is required for ip4.ip4.ip4.ip4 [ip4.ip4.ip4.ip4], 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 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/RSA-SHA1/RSA-SHA/; # ======== Caller's login, uid, gid, home, gecos ======== @@ -524,7 +560,7 @@ RESET_AFTER_EXTRA_LINE_READ: s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g; s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g; - s/\bname=$parm_caller_gecos\b/name=CALLER_GECOS/g; + s/\bname="?$parm_caller_gecos"?/name=CALLER_GECOS/g; # When looking at spool files with -Mvh, we will find not only the caller # login, but also the uid and gid. It seems that $) in some Perls gives all @@ -765,6 +801,10 @@ RESET_AFTER_EXTRA_LINE_READ: # other output is fragile; perhaps the debug output should be revised instead. s%(?; } } +################################################## +# 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 # @@ -1017,6 +1089,7 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } # [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) @@ -1024,7 +1097,7 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } # 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. @@ -1040,8 +1113,9 @@ if (! -e $sf) for (;;) { print "Continue, Show, or Quit? [Q] "; - $_ = ; + $_ = $force_continue ? "c" : ; 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$/); } @@ -1060,8 +1134,9 @@ if (! -e $sf) 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); } @@ -1072,11 +1147,11 @@ if (! -e $sf) # 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); @@ -1177,8 +1252,9 @@ if (-e $sf) 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); @@ -1197,47 +1273,79 @@ return 1; +################################################## +# 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/', }, + + 'tpda' => + { 'stdout' => '/tpda_event_action =/', }, + + }; + + ################################################## # 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) @@ -1245,7 +1353,8 @@ 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. @@ -1284,7 +1393,8 @@ if (! $message_skip) 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"}; } @@ -1297,8 +1407,9 @@ if (! $message_skip) 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 @@ -1354,7 +1465,8 @@ if (! $msglog_skip) 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"}; } } @@ -1379,8 +1491,9 @@ if (! $msglog_skip) 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) { @@ -1448,6 +1561,7 @@ system("$cmd"); # 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]; @@ -1660,6 +1774,18 @@ elsif (/^millisleep\s+(.*)$/) } +# 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. @@ -2072,6 +2198,9 @@ while (@ARGV > 0 && $ARGV[0] =~ /^-/) { 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; } @@ -2728,9 +2857,6 @@ if ($parm_hostname =~ /[[:upper:]]/) print "\n*** Host name has upper case characters: this may cause problems ***\n\n"; } -# Find the user's shell - -$parm_shell = $ENV{'SHELL'}; ################################################## @@ -3051,6 +3177,10 @@ foreach $basedir ("aux-var", "dnszones") } } +# 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 # @@ -3098,6 +3228,8 @@ if ($have_ipv6 && $parm_ipv6 ne "::1") $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); @@ -3153,7 +3285,7 @@ closedir(DIR); open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!"); print "\nPress RETURN to run the tests: "; -$_ = ; +$_ = $force_continue ? "c" : ; print "\n"; $lasttestdir = ""; @@ -3226,9 +3358,20 @@ foreach $test (@test_list) undef %expected_msglogs; # Open the test's script - open(SCRIPT, "scripts/$test") || tests_exit(-1, "Failed to open \"scripts/$test\": $!"); + # Run through the script once to set variables which should be global + while (