Testsuite: better sorting for exim_dumpdb output
[users/heiko/exim.git] / test / runtest
index 558fcf66188dc12618e97da1c0e09b7415a7e546..e8a3e8e8504516fe1a3415208e656c559e88a88e 100755 (executable)
@@ -758,6 +758,10 @@ RESET_AFTER_EXTRA_LINE_READ:
   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.
 
@@ -1095,6 +1099,7 @@ RESET_AFTER_EXTRA_LINE_READ:
     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/)
       {
@@ -1102,6 +1107,17 @@ RESET_AFTER_EXTRA_LINE_READ:
       next;
       }
 
+    # Non-TLS bulds have a different Recieved: header expansion
+    s/^((.*)\t}}}}by \$primary_hostname \$\{if def:received_protocol \{with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
+    s/^((\s*).*considering: with \$received_protocol }})\(Exim \$version_number\)$/$1\${if def:tls_in_cipher_std { tls \$tls_in_cipher_std\n$2\t}}(Exim \$version_number)/;
+    if (/condition: def:tls_in_cipher_std$/)
+      {
+      $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
+      $_= <IN>; $_= <IN>; $_= <IN>; $_= <IN>;
+      $_= <IN>; $_= <IN>; $_= <IN>; next;
+      }
+
+
     # Skip tls_advertise_hosts and hosts_require_tls checks when the options
     # are unset, because tls ain't always there.
 
@@ -1336,7 +1352,7 @@ RESET_AFTER_EXTRA_LINE_READ:
 
     # openssl version variances
     s/(TLS error on connection [^:]*: error:)[0-9A-F]{8}(:system library):(?:fopen|func\(4095\)):(No such file or directory)$/$1xxxxxxxx$2:fopen:$3/;
-    s/(DANE attempt failed.*error:)[0-9A-F]{8}(:SSL routines:)(ssl3_get_server_certificate|tls_process_server_certificate|CONNECT_CR_CERT)(?=:certificate verify failed$)/$1xxxxxxxx$2ssl3_get_server_certificate/;
+    s/(DANE attempt failed.*error:)[0-9A-F]{8}(:SSL routines:)(?:(?i)ssl3_get_server_certificate|tls_process_server_certificate|CONNECT_CR_CERT)(?=:certificate verify failed$)/$1xxxxxxxx$2ssl3_get_server_certificate/;
     s/(DKIM: validation error: )error:[0-9A-F]{8}:rsa routines:(?:(?i)int_rsa_verify|CRYPTO_internal):(?:bad signature|algorithm mismatch)$/$1Public key signature verification has failed./;
     s/ARC: AMS signing: privkey PEM-block import: error:\K[0-9A-F]{8}:(PEM routines):get_name:(no start line)/0906D06C:$1:PEM_read_bio:$2/;
 
@@ -1606,26 +1622,25 @@ if (-e $sf_current)
         }
       }
 
-    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] !~
@@ -1637,11 +1652,9 @@ if (-e $sf_current)
         }
       }
 
-    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
@@ -1682,8 +1695,7 @@ else
     # 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);
@@ -1752,7 +1764,7 @@ $munges =
     },
 
     '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;)/'
@@ -2148,34 +2160,32 @@ if (/^dbmbuild\s+(\S+)\s+(\S+)/)
 
 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
+    my @temp = map  { $_->[1] }
+               sort { $a->[0] cmp $b->[0] }
+               map  { [ (split)[0] =~ s/\Q$parm_ipv4/ip4.ip4.ip4.ip4/gr, $_ ] }
+               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 {
@@ -2184,11 +2194,9 @@ if (/^dump\s+(\S+)/)
                    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;
   }
 
@@ -2531,9 +2539,24 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+
 
   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
@@ -3406,11 +3429,11 @@ open(IFCONFIG, '-|', (grep { -x "$_/ip" } split /:/, $ENV{PATH}) ? 'ip address'
   or die "** Cannot run 'ip address' or 'ifconfig -a'\n";
 while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>))
   {
-  if (/^(?:[0-9]+: )([^:]+): /) { $ifname = $1; }
+  if (/^(?:[0-9]+: )?([a-z0-9]+): /) { $ifname = $1; }
 
   if (not $parm_ipv4 and /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)(?:\/\d+)?\s/i)
     {
-    # It would ne nice to be able to vary the /16 used for manyhome; we could take
+    # It would be nice to be able to vary the /16 used for manyhome; we could take
     # an option to runtest used here - but we'd also have to pass it on to fakens.
     # Possibly an environment variable?
     next if $1 eq '0.0.0.0' or $1 =~ /^(?:127|10\.250)\./;
@@ -3419,7 +3442,7 @@ while (not ($parm_ipv4 and $parm_ipv6) and defined($_ = <IFCONFIG>))
 
   if (not $parm_ipv6 and /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)(?:%[^ \/]+)?(?:\/\d+)?/i)
     {
-    next if $1 eq '::' or $1 eq '::1' or $1 =~ /^ff00/i;
+    next if $1 eq '::' or $1 eq '::1' or $1 =~ /^ff00/i or $1 =~ /^fe80::1/i;
     $parm_ipv6 = $1;
     if ($1 =~ /^fe80/i) { $parm_ipv6 .= '%' . $ifname; }
     }
@@ -3926,7 +3949,7 @@ if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1")
       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]") ||