Fix CVE-2016-1531

[exim.git] / test / runtest

diff --git a/test/runtest b/test/runtest
index aa242d589e27d9f42fa179ffb287be81e465b900..a05bc48edefbba672f60d34a3079d4fc42cbce8f 100755 (executable)
--- a/test/runtest
+++ b/test/runtest
@@ -36,7 +36,9 @@ $gnutls_dh_bits_normal = 2236;
 $cf = "bin/cf -exact";
 $cr = "\r";
 $debug = 0;
 $cf = "bin/cf -exact";
 $cr = "\r";
 $debug = 0;

+$force_continue = 0;

 $force_update = 0;
 $force_update = 0;

+$log_failed_filename = "failed-summary.log";

 $more = "less -XF";
 $optargs = "";
 $save_output = 0;
 $more = "less -XF";
 $optargs = "";
 $save_output = 0;


@@ -163,7 +165,7 @@ if (exists $TEST_STATE->{exim_pid})
   {
   $pid = $TEST_STATE->{exim_pid};
   print "Tidyup: killing wait-mode daemon pid=$pid\n";
   {
   $pid = $TEST_STATE->{exim_pid};
   print "Tidyup: killing wait-mode daemon pid=$pid\n";

-  system("sudo kill -SIGINT $pid");
+  system("sudo kill -INT $pid");

   }
 
 if (opendir(DIR, "spool"))
   }
 
 if (opendir(DIR, "spool"))


@@ -177,7 +179,7 @@ if (opendir(DIR, "spool"))
     chomp($pid = <PID>);
     close(PID);
     print "Tidyup: killing daemon pid=$pid\n";
     chomp($pid = <PID>);
     close(PID);
     print "Tidyup: killing daemon pid=$pid\n";

-    system("sudo rm -f spool/$spool; sudo kill -SIGINT $pid");
+    system("sudo rm -f spool/$spool; sudo kill -INT $pid");

     }
   }
 else
     }
   }
 else


@@ -191,7 +193,8 @@ close(T);
 system("sudo /bin/rm -rf ./spool test-* ./dnszones/*")
   if ($rc == 0 && !$save_output);
 
 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);
 
 print "\nYou were in test $test at the end there.\n\n" if defined $test;
 exit $rc if ($rc >= 0);


@@ -313,6 +316,7 @@ return @yield;
 
 sub munge {
 my($file) = $_[0];
 
 sub munge {
 my($file) = $_[0];

+my($extra) = $_[1];

 my($yield) = 0;
 my(@saved) = ();
 
 my($yield) = 0;
 my(@saved) = ();
 


@@ -335,9 +339,16 @@ $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
 # that are specific to certain file types, though there are also some of those
 # inline too.
 
 # 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:
   {
 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 \*\*\*/;
 
   # Check for "*** truncated ***"
   $yield = 1 if /\*\*\* truncated \*\*\*/;
 


@@ -474,19 +485,24 @@ RESET_AFTER_EXTRA_LINE_READ:
   s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g;
 
   # Time on queue tolerance
   s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g;
 
   # Time on queue tolerance

-  s/QT=1s/QT=0s/;
+  s/(QT|D)=1s/$1=0s/;

 
   # Eximstats heading
   s/Exim\sstatistics\sfrom\s\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\sto\s
     \d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Exim statistics from <time> to <time>/x;
 
 
   # Eximstats heading
   s/Exim\sstatistics\sfrom\s\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\sto\s
     \d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Exim statistics from <time> to <time>/x;
 

+  # Treat ECONNRESET the same as ECONNREFUSED.  At least some systems give
+  # us the former on a new connection.
+  s/(could not connect to .*: Connection) reset by peer$/$1 refused/;

 
   # ======== TLS certificate algorithms ========
   # 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.
   # So far, have seen:
 
   # ======== TLS certificate algorithms ========
   # 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.
   # So far, have seen:

+  #   TLSv1:AES128-GCM-SHA256:128

   #   TLSv1:AES256-SHA:256
   #   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
   #   TLSv1.2:AES256-GCM-SHA384:256
   #   TLSv1.2:DHE-RSA-AES256-SHA:256
   #   TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128


@@ -496,11 +512,15 @@ RESET_AFTER_EXTRA_LINE_READ:
   # Mail headers (...), log-lines X=..., client-ssl output ...
   # (and \b doesn't match between ' ' and '(' )
 
   # 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/\bAES128-GCM-SHA256:128\b/AES256-SHA:256/g;
+  s/\bAES128-GCM-SHA256\b/AES256-SHA/g;

   s/\bAES256-GCM-SHA384\b/AES256-SHA/g;
   s/\bDHE-RSA-AES256-SHA\b/AES256-SHA/g;
 
   # GnuTLS have seen:
   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
   #
   #   TLS1.2:RSA_AES_256_CBC_SHA1:256 (canonical)
   #   TLS1.2:DHE_RSA_AES_128_CBC_SHA1:128
   #


@@ -509,12 +529,48 @@ 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:
   #   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;
   #   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 \(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 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/;
+
+  # -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 ========
 
 
   # ======== Caller's login, uid, gid, home, gecos ========


@@ -529,7 +585,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/\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
 
   # 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


@@ -720,7 +776,7 @@ RESET_AFTER_EXTRA_LINE_READ:
   # numbers, or handle specific bad conditions in different ways, leading to
   # different wording in the error messages, so we cannot compare them.
 
   # numbers, or handle specific bad conditions in different ways, leading to
   # different wording in the error messages, so we cannot compare them.
 

-  s/(TLS error on connection (?:from|to) .*? \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
+  s/(TLS error on connection (?:from .* )?\(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;

 
   # ======== Maildir things ========
   # timestamp output in maildir processing
 
   # ======== Maildir things ========
   # timestamp output in maildir processing


@@ -770,6 +826,10 @@ RESET_AFTER_EXTRA_LINE_READ:
   # other output is fragile; perhaps the debug output should be revised instead.
   s%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
 
   # other output is fragile; perhaps the debug output should be revised instead.
   s%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
 

+  # ==========================================================
+  # MIME boundaries in RFC3461 DSN messages
+  s/\d{8,10}-eximdsn-\d{8,10}/NNNNNNNNNN-eximdsn-MMMMMMMMMM/;
+

   # ==========================================================
   # Some munging is specific to the specific file types
 
   # ==========================================================
   # Some munging is specific to the specific file types
 


@@ -798,6 +858,12 @@ RESET_AFTER_EXTRA_LINE_READ:
         next;
         }
       }
         next;
         }
       }

+
+    # openssl version variances
+    next if /^SSL info: unknown state/;
+    next if /^SSL info: SSLv2\/v3 write client hello A/;
+    next if /^SSL info: SSLv3 read server key exchange A/;
+

     }
 
   # ======== stderr ========
     }
 
   # ======== stderr ========


@@ -852,7 +918,7 @@ RESET_AFTER_EXTRA_LINE_READ:
     # As of Exim 4.74, we log when a setgid fails; because we invoke Exim
     # with -be, privileges will have been dropped, so this will always
     # be the case
     # As of Exim 4.74, we log when a setgid fails; because we invoke Exim
     # with -be, privileges will have been dropped, so this will always
     # be the case

-    next if /^changing group to \d+ failed: Operation not permitted/;
+    next if /^changing group to \d+ failed: (Operation not permitted|Not owner)/;

 
     # 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
 
     # 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


@@ -959,6 +1025,11 @@ RESET_AFTER_EXTRA_LINE_READ:
         @saved = ();
         }
 
         @saved = ();
         }
 

+    # 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;
+

       # Skip some lines that Exim puts out at the start of debugging output
       # because they will be different in different binaries.
 
       # Skip some lines that Exim puts out at the start of debugging output
       # because they will be different in different binaries.
 


@@ -980,6 +1051,14 @@ RESET_AFTER_EXTRA_LINE_READ:
     next;
     }
 
     next;
     }
 

+  # ======== log ========
+
+  elsif ($is_log)
+    {
+    # Berkeley DB version differences
+    next if / Berkeley DB error: /;
+    }
+

   # ======== All files other than stderr ========
 
   print MUNGED;
   # ======== All files other than stderr ========
 
   print MUNGED;


@@ -998,16 +1077,43 @@ return $yield;
 
 # Arguments: [0] the prompt string
 #            [1] if there is a U in the prompt and $force_update is true
 
 # 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"; }
 # Returns:   nothing (it sets $_)
 
 sub interact{
 print $_[0];
 if ($_[1]) { $_ = "u"; print "... update forced\n"; }

+  elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; }

   else { $_ = <T>; }
 }
 
 
 
   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       #
 
 ##################################################
 #    Subroutine to compare one output file       #


@@ -1022,6 +1128,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
 #             [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)
 #
 # Returns:    0 comparison succeeded or differences to be ignored
 #             1 comparison failed; files may have been updated (=> re-compare)


@@ -1029,7 +1136,7 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; }
 # Does not return if the user replies "Q" to a prompt.
 
 sub check_file{
 # 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.
 
 # 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.


@@ -1045,8 +1152,9 @@ if (! -e $sf)
   for (;;)
     {
     print "Continue, Show, or Quit? [Q] ";
   for (;;)
     {
     print "Continue, Show, or Quit? [Q] ";

-    $_ = <T>;
+    $_ = $force_continue ? "c" : <T>;

     tests_exit(1) if /^q?$/i;
     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$/);
     }
     return 0 if /^c$/i;
     last if (/^s$/);
     }


@@ -1065,8 +1173,9 @@ if (! -e $sf)
   print "\n";
   for (;;)
     {
   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;
     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);
     }
     return 0 if /^c$/i;
     last if (/^u$/i);
     }


@@ -1077,11 +1186,11 @@ if (! -e $sf)
 # data that does exist.
 
 open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
 # 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";
 if (defined $rsf && -e $rsf)
   {
   print MUNGED "\n******** SERVER ********\n";

-  $truncated |= munge($rsf);
+  $truncated |= munge($rsf, $extra);

   }
 close(MUNGED);
 
   }
 close(MUNGED);
 


@@ -1182,8 +1291,9 @@ if (-e $sf)
   print "\n";
   for (;;)
     {
   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;
     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);
     return 0 if /^c$/i;
     return 1 if /^r$/i;
     last if (/^u$/i);


@@ -1202,47 +1312,89 @@ 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.
+# Triggered by a scriptfile line "munge <name>"
+##################################################
+$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/' },
+
+    'optional_events' =>
+    { 'stdout' => '/event_action =/' },
+
+    'optional_ocsp' =>
+    { 'stderr' => '/127.0.0.1 in hosts_requ(ire|est)_ocsp/' },
+
+    'no_tpt_filter_epipe' =>
+    { 'stderr' => '/^writing error 32: Broken pipe$/' },
+
+    'optional_cert_hostnames' =>
+    { 'stderr' => '/in tls_verify_cert_hostnames\? no/' },
+
+  };
+
+

 ##################################################
 #    Subroutine to check the output of a test    #
 ##################################################
 
 # This function is called when the series of subtests is complete. It makes
 ##################################################
 #    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
 #
 #  [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{
 # 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($yield) = 0;

+my($munge) = $munges->{$mungename} if defined $mungename;

 
 $yield = 1 if check_file("spool/log/paniclog",
                        "spool/log/serverpaniclog",
                        "test-paniclog-munged",
 
 $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",
 
 $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",
 
 $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",
 
 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)
   }
 
 if (!$stderr_skip)


@@ -1250,7 +1402,8 @@ if (!$stderr_skip)
   $yield = 1 if check_file("test-stderr",
                        "test-stderr-server",
                        "test-stderr-munged",
   $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.
   }
 
 # Compare any delivered messages, unless this test is skipped.


@@ -1289,7 +1442,8 @@ if (! $message_skip)
 
     print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
     $yield = 1 if check_file($mail, undef, "test-mail-munged",
 
     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"};
     }
 
     delete $expected_mails{"mail/$testno.$saved_mail"};
     }
 


@@ -1302,8 +1456,9 @@ if (! $message_skip)
 
     for (;;)
       {
 
     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;
       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
       last if /^c$/i;
 
       # For update, we not only have to unlink the file, but we must also


@@ -1359,7 +1514,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,
         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"};
       }
     }
       delete $expected_msglogs{"$testno.$munged_msglog"};
       }
     }


@@ -1384,8 +1540,9 @@ if (! $msglog_skip)
 
     for (;;)
       {
 
     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;
       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)
         {
       last if /^c$/i;
       if (/^u$/i)
         {


@@ -1453,6 +1610,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
 #            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];
 
 sub run_command{
 my($testno) = $_[0];


@@ -1461,6 +1619,8 @@ my($commandnameref) = $_[3];
 my($aux_info) = $_[4];
 my($yield) = 1;
 
 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];
 if (/^(\d+)\s*$/)                # Handle unusual return code
   {
   my($r) = $_[2];


@@ -1530,19 +1690,42 @@ if (/^dump\s+(\S+)/)
   my(@temp);
   print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
   open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");
   my(@temp);
   print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
   open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");

-  @temp = <IN>;
-  close(IN);
-  if ($which eq "callout")
+  open(OUT, ">>test-stdout");
+  print OUT "+++++++++++++++++++++++++++\n";
+
+  if ($which eq "retry")

     {
     {

+    $/ = "\n  ";
+    @temp = <IN>;
+    $/ = "\n";
+

     @temp = sort {
     @temp = sort {

-                 my($aa) = substr $a, 21;
-                 my($bb) = substr $b, 21;
-                 return $aa cmp $bb;
+                   my($aa) = split(' ', $a);
+                   my($bb) = split(' ', $b);
+                   return $aa cmp $bb;

                  } @temp;
                  } @temp;

+
+    foreach $item (@temp)
+      {
+      $item =~ s/^\s*(.*)\n(.*)\n?\s*$/$1\n$2/m;
+      print OUT "  $item\n";
+      }

     }
     }

-  open(OUT, ">>test-stdout");
-  print OUT "+++++++++++++++++++++++++++\n";
-  print OUT @temp;
+  else
+    {
+    @temp = <IN>;
+    if ($which eq "callout")
+      {
+      @temp = sort {
+                   my($aa) = substr $a, 21;
+                   my($bb) = substr $b, 21;
+                   return $aa cmp $bb;
+                   } @temp;
+      }
+    print OUT @temp;
+    }
+
+  close(IN);

   close(OUT);
   return 1;
   }
   close(OUT);
   return 1;
   }


@@ -1638,14 +1821,14 @@ if (/^killdaemon/)
     print ">> killdaemon: recovered pid $pid\n" if $debug;
     if ($pid)
       {
     print ">> killdaemon: recovered pid $pid\n" if $debug;
     if ($pid)
       {

-      run_system("sudo /bin/kill -SIGINT $pid");
+      run_system("sudo /bin/kill -INT $pid");

       wait;
       }
     } else {
     $pid = `cat $parm_cwd/spool/exim-daemon.*`;
     if ($pid)
       {
       wait;
       }
     } else {
     $pid = `cat $parm_cwd/spool/exim-daemon.*`;
     if ($pid)
       {

-      run_system("sudo /bin/kill -SIGINT $pid");
+      run_system("sudo /bin/kill -INT $pid");

       close DAEMONCMD;                                   # Waits for process
       }
     }
       close DAEMONCMD;                                   # Waits for process
       }
     }


@@ -1665,6 +1848,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.
 
 # The "sleep" command does just that. For sleeps longer than 1 second we
 # tell the user what's going on.
 


@@ -1829,12 +2024,12 @@ if (/^client/ || /^(sudo\s+)?perl\b/)
 # not drop privilege when -C and -D options are present. To run the exim
 # command as root, we use sudo.
 
 # 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($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
   $wait_time  = (defined $2)? $2      : 0;
 
   # Return 2 rather than 1 afterwards


@@ -1880,7 +2075,8 @@ elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/)
     for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; }
     if ( $args =~ /\$msg\d/ )
       {
     for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; }
     if ( $args =~ /\$msg\d/ )
       {

-      tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n");
+      tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n")
+        unless $force_continue;

       }
     }
 
       }
     }
 


@@ -2077,6 +2273,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 "-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; }
     if ($arg eq "-UPDATE") { $force_update = 1; next; }
     if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; }
     if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; }


@@ -2590,7 +2789,7 @@ $pwcomm = $pwcomm;
 
 $parm_caller_group = getgrgid($parm_caller_gid);
 
 
 $parm_caller_group = getgrgid($parm_caller_gid);
 

-print "Program caller is $parm_caller, whose group is $parm_caller_group\n";
+print "Program caller is $parm_caller ($parm_caller_uid), whose group is $parm_caller_group ($parm_caller_gid)\n";

 print "Home directory is $parm_caller_home\n";
 
 unless (defined $parm_eximgroup)
 print "Home directory is $parm_caller_home\n";
 
 unless (defined $parm_eximgroup)


@@ -2628,7 +2827,7 @@ while (($parm_ipv4 eq "" || $parm_ipv6 eq "") && ($_ = <IFCONFIG>))
       $_ =~ /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)\s/i)
     {
     $ip = $1;
       $_ =~ /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)\s/i)
     {
     $ip = $1;

-    next if ($ip eq "127.0.0.1");
+    next if ($ip =~ /^127\./);

     $parm_ipv4 = $ip;
     }
 
     $parm_ipv4 = $ip;
     }
 


@@ -3104,6 +3303,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;
     $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);
   }
   my(@components) = split /:/, $exp_v6;
   my(@nibbles) = reverse (split /\s*/, shift @components);


@@ -3159,7 +3360,7 @@ closedir(DIR);
 open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!");
 
 print "\nPress RETURN to run the tests: ";
 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 = "";
 print "\n";
 
 $lasttestdir = "";


@@ -3232,9 +3433,20 @@ foreach $test (@test_list)
   undef %expected_msglogs;
 
   # Open the test's script
   undef %expected_msglogs;
 
   # Open the test's script

-

   open(SCRIPT, "scripts/$test") ||
     tests_exit(-1, "Failed to open \"scripts/$test\": $!");
   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 (<SCRIPT>)
+    {
+    if (/^no_message_check/) { $message_skip = 1; next; }
+    if (/^no_msglog_check/)  { $msglog_skip = 1; next; }
+    if (/^no_stderr_check/)  { $stderr_skip = 1; next; }
+    if (/^no_stdout_check/)  { $stdout_skip = 1; next; }
+    if (/^rmfiltertest/)     { $rmfiltertest = 1; next; }
+    if (/^sortlog/)          { $sortlog = 1; next; }
+    }
+  # Reset to beginning of file for per test interpreting/processing
+  seek(SCRIPT, 0, 0);

 
   # The first line in the script must be a comment that is used to identify
   # the set of tests as a whole.
 
   # The first line in the script must be a comment that is used to identify
   # the set of tests as a whole.


@@ -3257,6 +3469,8 @@ foreach $test (@test_list)
     while (<SCRIPT>)
       {
       $lineno++;
     while (<SCRIPT>)
       {
       $lineno++;

+      # Could remove these variable settings because they are already
+      # set above, but doesn't hurt to leave them here.

       if (/^no_message_check/) { $message_skip = 1; next; }
       if (/^no_msglog_check/)  { $msglog_skip = 1; next; }
       if (/^no_stderr_check/)  { $stderr_skip = 1; next; }
       if (/^no_message_check/) { $message_skip = 1; next; }
       if (/^no_msglog_check/)  { $msglog_skip = 1; next; }
       if (/^no_stderr_check/)  { $stderr_skip = 1; next; }


@@ -3370,8 +3584,10 @@ foreach $test (@test_list)
       for (;;)
         {
         print "\nshow stdErr, show stdOut, Retry, Continue (without file comparison), or Quit? [Q] ";
       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;
         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)
           {
         last if /^[rc]$/i;
         if (/^e$/i)
           {


@@ -3407,8 +3623,10 @@ foreach $test (@test_list)
         for (;;)
           {
           print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";
         for (;;)
           {
           print "\nShow server stdout, Retry, Continue, or Quit? [Q] ";

-          $_ = <T>;
+          $_ = $force_continue ? "c" : <T>;

           tests_exit(1) if /^q?$/i;
           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)
           last if /^[rc]$/i;
 
           if (/^s$/i)


@@ -3439,7 +3657,7 @@ foreach $test (@test_list)
 
   if ($docheck)
     {
 
   if ($docheck)
     {

-    if (check_output() != 0)
+    if (check_output($TEST_STATE->{munge}) != 0)

       {
       print (("#" x 79) . "\n");
       redo;
       {
       print (("#" x 79) . "\n");
       redo;