Multiple headers_add/remove options per router/transport - fixes bug 337
[exim.git] / test / runtest
index 83e1baf6f0e30376c84cb6f09882cc5a55982ccc..2756348f9c4a729fc506c1720640a5b066a00d08 100755 (executable)
@@ -75,6 +75,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';
+
 
 
 ###############################################################################
@@ -310,6 +313,7 @@ return @yield;
 
 sub munge {
 my($file) = $_[0];
+my($extra) = $_[1];
 my($yield) = 0;
 my(@saved) = ();
 
@@ -335,6 +339,13 @@ $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
 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 \*\*\*/;
 
@@ -344,6 +355,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 +405,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/ ENV_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+/;
 
@@ -485,6 +496,7 @@ RESET_AFTER_EXTRA_LINE_READ:
   # 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
@@ -494,6 +506,7 @@ RESET_AFTER_EXTRA_LINE_READ:
 
   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)
@@ -1017,6 +1030,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 +1038,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.
@@ -1072,11 +1086,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);
 
@@ -1197,47 +1211,76 @@ 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/', },
+
+  };
+
+
 ##################################################
 #    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 +1288,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 +1328,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"};
     }
 
@@ -1354,7 +1399,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"};
       }
     }
@@ -1448,6 +1494,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 +1707,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.
 
@@ -2728,9 +2787,6 @@ if ($parm_hostname =~ /[[:upper:]]/)
   print "\n*** Host name has upper case characters: this may cause problems ***\n\n";
   }
 
-# Set a user's shell, distinguishable from /bin/sh
-symlink("/bin/sh","aux-var/sh");
-$ENV{'SHELL'} = $parm_shell = $parm_cwd . "aux-var/sh";
 
 
 ##################################################
@@ -3051,6 +3107,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 +3158,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);
@@ -3433,7 +3495,7 @@ foreach $test (@test_list)
 
   if ($docheck)
     {
-    if (check_output() != 0)
+    if (check_output($TEST_STATE->{munge}) != 0)
       {
       print (("#" x 79) . "\n");
       redo;