test/runtest

   1 #! /usr/bin/perl -w
   2
   3 ###############################################################################
   4 # This is the controlling script for the "new" test suite for Exim. It should #
   5 # be possible to export this suite for running on a wide variety of hosts, in #
   6 # contrast to the old suite, which was very dependent on the environment of   #
   7 # Philip Hazel's desktop computer. This implementation inspects the version   #
   8 # of Exim that it finds, and tests only those features that are included. The #
   9 # surrounding environment is also tested to discover what is available. See   #
  10 # the README file for details of how it all works.                            #
  11 #                                                                             #
  12 # Implementation started: 03 August 2005 by Philip Hazel                      #
  13 # Placed in the Exim CVS: 06 February 2006                                    #
  14 ###############################################################################
  15
  16 require Cwd;
  17 use Errno;
  18 use FileHandle;
  19 use Socket;
  20
  21
  22 # Start by initializing some global variables
  23
  24 $testversion = "4.72 (02-Jun-10)";
  25
  26 $cf = "bin/cf -exact";
  27 $cr = "\r";
  28 $debug = 0;
  29 $force_update = 0;
  30 $more = "less -XF";
  31 $optargs = "";
  32 $save_output = 0;
  33 $server_opts = "";
  34
  35 $have_ipv4 = 1;
  36 $have_ipv6 = 1;
  37 $have_largefiles = 0;
  38
  39 $test_start = 1;
  40 $test_end = $test_top = 8999;
  41 $test_special_top = 9999;
  42 @test_list = ();
  43 @test_dirs = ();
  44
  45
  46 # Networks to use for DNS tests. We need to choose some networks that will
  47 # never be used so that there is no chance that the host on which we are
  48 # running is actually in one of the test networks. Private networks such as
  49 # the IPv4 10.0.0.0/8 network are no good because hosts may well use them.
  50 # Rather than use some unassigned numbers (that might become assigned later),
  51 # I have chosen some multicast networks, in the belief that such addresses
  52 # won't ever be assigned to hosts. This is the only place where these numbers
  53 # are defined, so it is trivially possible to change them should that ever
  54 # become necessary.
  55
  56 $parm_ipv4_test_net = "224";
  57 $parm_ipv6_test_net = "ff00";
  58
  59 # Port numbers are currently hard-wired
  60
  61 $parm_port_n = 1223;         # Nothing listening on this port
  62 $parm_port_s = 1224;         # Used for the "server" command
  63 $parm_port_d = 1225;         # Used for the Exim daemon
  64 $parm_port_d2 = 1226;        # Additional for daemon
  65 $parm_port_d3 = 1227;        # Additional for daemon
  66 $parm_port_d4 = 1228;        # Additional for daemon
  67
  68
  69
  70 ###############################################################################
  71 ###############################################################################
  72
  73 # Define a number of subroutines
  74
  75 ###############################################################################
  76 ###############################################################################
  77
  78
  79 ##################################################
  80 #              Handle signals                    #
  81 ##################################################
  82
  83 sub pipehandler { $sigpipehappened = 1; }
  84
  85 sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); }
  86
  87
  88 ##################################################
  89 #       Do global macro substitutions            #
  90 ##################################################
  91
  92 # This function is applied to configurations, command lines and data lines in
  93 # scripts, and to lines in the files of the aux-var-src and the dnszones-src
  94 # directory. It takes one argument: the current test number, or zero when
  95 # setting up files before running any tests.
  96
  97 sub do_substitute{
  98 s?\bCALLER\b?$parm_caller?g;
  99 s?\bCALLERGROUP\b?$parm_caller_group?g;
 100 s?\bCALLER_UID\b?$parm_caller_uid?g;
 101 s?\bCALLER_GID\b?$parm_caller_gid?g;
 102 s?\bCLAMSOCKET\b?$parm_clamsocket?g;
 103 s?\bDIR/?$parm_cwd/?g;
 104 s?\bEXIMGROUP\b?$parm_eximgroup?g;
 105 s?\bEXIMUSER\b?$parm_eximuser?g;
 106 s?\bHOSTIPV4\b?$parm_ipv4?g;
 107 s?\bHOSTIPV6\b?$parm_ipv6?g;
 108 s?\bHOSTNAME\b?$parm_hostname?g;
 109 s?\bPORT_D\b?$parm_port_d?g;
 110 s?\bPORT_D2\b?$parm_port_d2?g;
 111 s?\bPORT_D3\b?$parm_port_d3?g;
 112 s?\bPORT_D4\b?$parm_port_d4?g;
 113 s?\bPORT_N\b?$parm_port_n?g;
 114 s?\bPORT_S\b?$parm_port_s?g;
 115 s?\bTESTNUM\b?$_[0]?g;
 116 s?(\b|_)V4NET([\._])?$1$parm_ipv4_test_net$2?g;
 117 s?\bV6NET:?$parm_ipv6_test_net:?g;
 118 }
 119
 120
 121
 122 ##################################################
 123 #        Subroutine to tidy up and exit          #
 124 ##################################################
 125
 126 # In all cases, we check for any Exim daemons that have been left running, and
 127 # kill them. Then remove all the spool data, test output, and the modified Exim
 128 # binary if we are ending normally.
 129
 130 # Arguments:
 131 #    $_[0] = 0 for a normal exit; full cleanup done
 132 #    $_[0] > 0 for an error exit; no files cleaned up
 133 #    $_[0] < 0 for a "die" exit; $_[1] contains a message
 134
 135 sub tests_exit{
 136 my($rc) = $_[0];
 137 my($spool);
 138
 139 # Search for daemon pid files and kill the daemons. We kill with SIGINT rather
 140 # than SIGTERM to stop it outputting "Terminated" to the terminal when not in
 141 # the background.
 142
 143 if (opendir(DIR, "spool"))
 144   {
 145   my(@spools) = sort readdir(DIR);
 146   closedir(DIR);
 147   foreach $spool (@spools)
 148     {
 149     next if $spool !~ /^exim-daemon./;
 150     open(PID, "spool/$spool") || die "** Failed to open \"spool/$spool\": $!\n";
 151     chomp($pid = <PID>);
 152     close(PID);
 153     print "Tidyup: killing daemon pid=$pid\n";
 154     system("sudo rm -f spool/$spool; sudo kill -SIGINT $pid");
 155     }
 156   }
 157 else
 158   { die "** Failed to opendir(\"spool\"): $!\n" unless $!{ENOENT}; }
 159
 160 # Close the terminal input and remove the test files if all went well, unless
 161 # the option to save them is set. Always remove the patched Exim binary. Then
 162 # exit normally, or die.
 163
 164 close(T);
 165 system("sudo /bin/rm -rf ./spool test-* ./dnszones/*")
 166   if ($rc == 0 && !$save_output);
 167
 168 system("sudo /bin/rm -rf ./eximdir/*");
 169 exit $rc if ($rc >= 0);
 170 die "** runtest error: $_[1]\n";
 171 }
 172
 173
 174
 175 ##################################################
 176 #   Subroutines used by the munging subroutine   #
 177 ##################################################
 178
 179 # This function is used for things like message ids, where we want to generate
 180 # more than one value, but keep a consistent mapping throughout.
 181 #
 182 # Arguments:
 183 #   $oldid        the value from the file
 184 #   $base         a base string into which we insert a sequence
 185 #   $sequence     the address of the current sequence counter
 186
 187 sub new_value {
 188 my($oldid, $base, $sequence) = @_;
 189 my($newid) = $cache{$oldid};
 190 if (! defined $newid)
 191   {
 192   $newid = sprintf($base, $$sequence++);
 193   $cache{$oldid} = $newid;
 194   }
 195 return $newid;
 196 }
 197
 198
 199 # This is used while munging the output from exim_dumpdb. We cheat by assuming
 200 # that the  date always the same, and just return the number of seconds since
 201 # midnight.
 202
 203 sub date_seconds {
 204 my($day,$month,$year,$hour,$min,$sec) =
 205   $_[0] =~ /^(\d\d)-(\w\w\w)-(\d{4})\s(\d\d):(\d\d):(\d\d)/;
 206 return $hour * 60 * 60 + $min * 60 + $sec;
 207 }
 208
 209
 210 # This is a subroutine to sort maildir files into time-order. The second field
 211 # is the microsecond field, and may vary in length, so must be compared
 212 # numerically.
 213
 214 sub maildirsort {
 215 return $a cmp $b if ($a !~ /^\d+\.H\d/ || $b !~ /^\d+\.H\d/);
 216 my($x1,$y1) = $a =~ /^(\d+)\.H(\d+)/;
 217 my($x2,$y2) = $b =~ /^(\d+)\.H(\d+)/;
 218 return ($x1 != $x2)? ($x1 <=> $x2) : ($y1 <=> $y2);
 219 }
 220
 221
 222
 223 ##################################################
 224 #   Subroutine list files below a directory      #
 225 ##################################################
 226
 227 # This is used to build up a list of expected mail files below a certain path
 228 # in the directory tree. It has to be recursive in order to deal with multiple
 229 # maildir mailboxes.
 230
 231 sub list_files_below {
 232 my($dir) = $_[0];
 233 my(@yield) = ();
 234 my(@sublist, $file);
 235
 236 opendir(DIR, $dir) || tests_exit(-1, "Failed to open $dir: $!");
 237 @sublist = sort maildirsort readdir(DIR);
 238 closedir(DIR);
 239
 240 foreach $file (@sublist)
 241   {
 242   next if $file eq "." || $file eq ".." || $file eq "CVS";
 243   if (-d "$dir/$file")
 244     { @yield = (@yield, list_files_below("$dir/$file")); }
 245   else
 246     { push @yield, "$dir/$file"; }
 247   }
 248
 249 return @yield;
 250 }
 251
 252
 253
 254 ##################################################
 255 #         Munge a file before comparing          #
 256 ##################################################
 257
 258 # The pre-processing turns all dates, times, Exim versions, message ids, and so
 259 # on into standard values, so that the compare works. Perl's substitution with
 260 # an expression provides a neat way to do some of these changes.
 261
 262 # We keep a global associative array for repeatedly turning the same values
 263 # into the same standard values throughout the data from a single test.
 264 # Message ids get this treatment (can't be made reliable for times), and
 265 # times in dumped retry databases are also handled in a special way, as are
 266 # incoming port numbers.
 267
 268 # On entry to the subroutine, the file to write to is already opened with the
 269 # name MUNGED. The input file name is the only argument to the subroutine.
 270 # Certain actions are taken only when the name contains "stderr", "stdout",
 271 # or "log". The yield of the function is 1 if a line matching "*** truncated
 272 # ***" is encountered; otherwise it is 0.
 273
 274 sub munge {
 275 my($file) = $_[0];
 276 my($yield) = 0;
 277 my(@saved) = ();
 278
 279 open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!");
 280
 281 my($is_log) = $file =~ /log/;
 282 my($is_stdout) = $file =~ /stdout/;
 283 my($is_stderr) = $file =~ /stderr/;
 284
 285 # Date pattern
 286
 287 $date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}";
 288
 289 # Pattern for matching pids at start of stderr lines; initially something
 290 # that won't match.
 291
 292 $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx";
 293
 294 # Scan the file and make the changes. Near the bottom there are some changes
 295 # that are specific to certain file types, though there are also some of those
 296 # inline too.
 297
 298 while(<IN>)
 299   {
 300 RESET_AFTER_EXTRA_LINE_READ:
 301   # Check for "*** truncated ***"
 302   $yield = 1 if /\*\*\* truncated \*\*\*/;
 303
 304   # Replace the name of this host
 305   s/\Q$parm_hostname\E/the.local.host.name/g;
 306
 307   # But convert "name=the.local.host address=127.0.0.1" to use "localhost"
 308   s/name=the\.local\.host address=127\.0\.0\.1/name=localhost address=127.0.0.1/g;
 309
 310   # Replace the path to the testsuite directory
 311   s?\Q$parm_cwd\E?TESTSUITE?g;
 312
 313   # Replace the Exim version number (may appear in various places)
 314   # patchexim should have fixed this for us
 315   #s/(Exim) \d+\.\d+[\w_-]*/$1 x.yz/i;
 316
 317   # Replace Exim message ids by a unique series
 318   s/((?:[^\W_]{6}-){2}[^\W_]{2})
 319     /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
 320
 321   # The names of lock files appear in some error and debug messages
 322   s/\.lock(\.[-\w]+)+(\.[\da-f]+){2}/.lock.test.ex.dddddddd.pppppppp/;
 323
 324   # Unless we are in an IPv6 test, replace IPv4 and/or IPv6 in "listening on
 325   # port" message, because it is not always the same.
 326   s/port (\d+) \([^)]+\)/port $1/g
 327     if !$is_ipv6test && m/listening for SMTP(S?) on port/;
 328
 329   # Challenges in SPA authentication
 330   s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/;
 331
 332   # PRVS values
 333   s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g;    # Old form
 334   s?prvs=[\da-f]{10}=([^@]+)@?prvs=xxxxxxxxxx=$1@?g;    # New form
 335
 336   # Error lines on stdout from SSL contain process id values and file names.
 337   # They also contain a source file name and line number, which may vary from
 338   # release to release.
 339   s/^\d+:error:/pppp:error:/;
 340   s/:(?:\/[^\s:]+\/)?([^\/\s]+\.c):\d+:/:$1:dddd:/;
 341
 342   # There are differences in error messages between OpenSSL versions
 343   s/SSL_CTX_set_cipher_list/SSL_connect/;
 344
 345   # One error test in expansions mentions base 62 or 36
 346   s/is not a base (36|62) number/is not a base 36\/62 number/;
 347
 348   # This message sometimes has a different number of seconds
 349   s/forced fail after \d seconds/forced fail after d seconds/;
 350
 351   # This message may contain a different DBM library name
 352   s/Failed to open \S+( \([^\)]+\))? file/Failed to open DBM file/;
 353
 354   # The message for a non-listening FIFO varies
 355   s/:[^:]+: while opening named pipe/: Error: while opening named pipe/;
 356
 357   # The name of the shell may vary
 358   s/\s\Q$parm_shell\E\b/ SHELL/;
 359
 360   # Debugging output of lists of hosts may have different sort keys
 361   s/sort=\S+/sort=xx/ if /^\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\S+/;
 362
 363   # Random local part in callout cache testing
 364   s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/;
 365
 366   # File descriptor numbers may vary
 367   s/^writing data block fd=\d+/writing data block fd=dddd/;
 368   s/running as transport filter: write=\d+ read=\d+/running as transport filter: write=dddd read=dddd/;
 369
 370
 371   # ======== Dumpdb output ========
 372   # This must be before the general date/date munging.
 373   # Time data lines, which look like this:
 374   # 25-Aug-2000 12:11:37  25-Aug-2000 12:11:37  26-Aug-2000 12:11:37
 375   if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/)
 376     {
 377     my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4);
 378     $expired = "" if !defined $expired;
 379     my($increment) = date_seconds($date3) - date_seconds($date2);
 380
 381     # We used to use globally unique replacement values, but timing
 382     # differences make this impossible. Just show the increment on the
 383     # last one.
 384
 385     printf MUNGED ("first failed = time last try = time2 next try = time2 + %s%s\n",
 386       $increment, $expired);
 387     next;
 388     }
 389
 390   # more_errno values in exim_dumpdb output which are times
 391   s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /;
 392
 393
 394   # ======== Dates and times ========
 395
 396   # Dates and times are all turned into the same value - trying to turn
 397   # them into different ones cannot be done repeatedly because they are
 398   # real time stamps generated while running the test. The actual date and
 399   # time used was fixed when I first started running automatic Exim tests.
 400
 401   # Date/time in header lines and SMTP responses
 402   s/[A-Z][a-z]{2},\s\d\d?\s[A-Z][a-z]{2}\s\d\d\d\d\s\d\d\:\d\d:\d\d\s[-+]\d{4}
 403     /Tue, 2 Mar 1999 09:44:33 +0000/gx;
 404
 405   # Date/time in logs and in one instance of a filter test
 406   s/^\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d(\s[+-]\d\d\d\d)?/1999-03-02 09:44:33/gx;
 407   s/^Logwrite\s"\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Logwrite "1999-03-02 09:44:33/gx;
 408
 409   # Date/time in message separators
 410   s/(?:[A-Z][a-z]{2}\s){2}\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d
 411     /Tue Mar 02 09:44:33 1999/gx;
 412
 413   # Date of message arrival in spool file as shown by -Mvh
 414   s/^\d{9,10}\s0$/ddddddddd 0/;
 415
 416   # Date/time in mbx mailbox files
 417   s/\d\d-\w\w\w-\d\d\d\d\s\d\d:\d\d:\d\d\s[-+]\d\d\d\d,/06-Sep-1999 15:52:48 +0100,/gx;
 418
 419   # Dates/times in debugging output for writing retry records
 420   if (/^  first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/)
 421     {
 422     my($next) = $3 - $2;
 423     $_ = "  first failed=dddd last try=dddd next try=+$next $4\n";
 424     }
 425   s/^(\s*)now=\d+ first_failed=\d+ next_try=\d+ expired=(\d)/$1now=tttt first_failed=tttt next_try=tttt expired=$2/;
 426   s/^(\s*)received_time=\d+ diff=\d+ timeout=(\d+)/$1received_time=tttt diff=tttt timeout=$2/;
 427
 428   # Time to retry may vary
 429   s/time to retry = \S+/time to retry = tttt/;
 430   s/retry record exists: age=\S+/retry record exists: age=ttt/;
 431   s/failing_interval=\S+ message_age=\S+/failing_interval=ttt message_age=ttt/;
 432
 433   # Date/time in exim -bV output
 434   s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g;
 435
 436   # Time on queue tolerance
 437   s/QT=1s/QT=0s/;
 438
 439   # Eximstats heading
 440   s/Exim\sstatistics\sfrom\s\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d\sto\s
 441     \d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Exim statistics from <time> to <time>/x;
 442
 443
 444   # ======== Caller's login, uid, gid, home, gecos ========
 445
 446   s/\Q$parm_caller_home\E/CALLER_HOME/g;   # NOTE: these must be done
 447   s/\b\Q$parm_caller\E\b/CALLER/g;         #       in this order!
 448   s/\b\Q$parm_caller_group\E\b/CALLER/g;   # In case group name different
 449
 450   s/\beuid=$parm_caller_uid\b/euid=CALLER_UID/g;
 451   s/\begid=$parm_caller_gid\b/egid=CALLER_GID/g;
 452
 453   s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g;
 454   s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g;
 455
 456   s/\bname=$parm_caller_gecos\b/name=CALLER_GECOS/g;
 457
 458   # When looking at spool files with -Mvh, we will find not only the caller
 459   # login, but also the uid and gid. It seems that $) in some Perls gives all
 460   # the auxiliary gids as well, so don't bother checking for that.
 461
 462   s/^CALLER $> \d+$/CALLER UID GID/;
 463
 464   # There is one case where the caller's login is forced to something else,
 465   # in order to test the processing of logins that contain spaces. Weird what
 466   # some people do, isn't it?
 467
 468   s/^spaced user $> \d+$/CALLER UID GID/;
 469
 470
 471   # ======== Exim's login ========
 472   # For messages received by the daemon, this is in the -H file, which some
 473   # tests inspect. For bounce messages, this will appear on the U= lines in
 474   # logs and also after Received: and in addresses. In one pipe test it appears
 475   # after "Running as:". It also appears in addresses, and in the names of lock
 476   # files.
 477
 478   s/U=$parm_eximuser/U=EXIMUSER/;
 479   s/user=$parm_eximuser/user=EXIMUSER/;
 480   s/login=$parm_eximuser/login=EXIMUSER/;
 481   s/Received: from $parm_eximuser /Received: from EXIMUSER /;
 482   s/Running as: $parm_eximuser/Running as: EXIMUSER/;
 483   s/\b$parm_eximuser@/EXIMUSER@/;
 484   s/\b$parm_eximuser\.lock\./EXIMUSER.lock./;
 485
 486   s/\beuid=$parm_exim_uid\b/euid=EXIM_UID/g;
 487   s/\begid=$parm_exim_gid\b/egid=EXIM_GID/g;
 488
 489   s/\buid=$parm_exim_uid\b/uid=EXIM_UID/g;
 490   s/\bgid=$parm_exim_gid\b/gid=EXIM_GID/g;
 491
 492   s/^$parm_eximuser $parm_exim_uid $parm_exim_gid/EXIMUSER EXIM_UID EXIM_GID/;
 493
 494
 495   # ======== General uids, gids, and pids ========
 496   # Note: this must come after munges for caller's and exim's uid/gid
 497
 498   # These are for systems where long int is 64
 499   s/\buid=4294967295/uid=-1/;
 500   s/\beuid=4294967295/euid=-1/;
 501   s/\bgid=4294967295/gid=-1/;
 502   s/\begid=4294967295/egid=-1/;
 503
 504   s/\bgid=\d+/gid=gggg/;
 505   s/\begid=\d+/egid=gggg/;
 506   s/\bpid=\d+/pid=pppp/;
 507   s/\buid=\d+/uid=uuuu/;
 508   s/\beuid=\d+/euid=uuuu/;
 509   s/set_process_info:\s+\d+/set_process_info: pppp/;
 510   s/queue run pid \d+/queue run pid ppppp/;
 511   s/process \d+ running as transport filter/process pppp running as transport filter/;
 512   s/process \d+ writing to transport filter/process pppp writing to transport filter/;
 513   s/reading pipe for subprocess \d+/reading pipe for subprocess pppp/;
 514   s/remote delivery process \d+ ended/remote delivery process pppp ended/;
 515
 516   # Pid in temp file in appendfile transport
 517   s"test-mail/temp\.\d+\."test-mail/temp.pppp.";
 518
 519   # Optional pid in log lines
 520   s/^(\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d)(\s[+-]\d\d\d\d|)(\s\[\d+\])/
 521     "$1$2 [" . new_value($3, "%s", \$next_pid) . "]"/gxe;
 522
 523   # Detect a daemon stderr line with a pid and save the pid for subsequent
 524   # removal from following lines.
 525   $spid = $1 if /^(\s*\d+) (?:listening|LOG: MAIN|(?:daemon_smtp_port|local_interfaces) overridden by)/;
 526   s/^$spid //;
 527
 528   # Queue runner waiting messages
 529   s/waiting for children of \d+/waiting for children of pppp/;
 530   s/waiting for (\S+) \(\d+\)/waiting for $1 (pppp)/;
 531
 532   # ======== Port numbers ========
 533   # Incoming port numbers may vary, but not in daemon startup line.
 534
 535   s/^Port: (\d+)/"Port: " . new_value($1, "%s", \$next_port)/e;
 536   s/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e;
 537
 538   # This handles "connection from" and the like, when the port is given
 539   if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/->/
 540       && !/\*>/ && !/Connection refused/)
 541     {
 542     s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie;
 543     }
 544
 545   # Port in host address in spool file output from -Mvh
 546   s/^-host_address (.*)\.\d+/-host_address $1.9999/;
 547
 548
 549   # ======== Local IP addresses ========
 550   # The amount of space between "host" and the address in verification output
 551   # depends on the length of the host name. We therefore reduce it to one space
 552   # for all of them.
 553   # Also, the length of space at the end of the host line is dependent
 554   # on the length of the longest line, so strip it also on otherwise
 555   # un-rewritten lines like localhost
 556
 557   s/^\s+host\s(\S+)\s+(\S+)/  host $1 $2/;
 558   s/^\s+(host\s\S+\s\S+)\s+(port=.*)/  host $1 $2/;
 559   s/^\s+(host\s\S+\s\S+)\s+(?=MX=)/  $1 /;
 560   s/host\s\Q$parm_ipv4\E\s\[\Q$parm_ipv4\E\]/host ipv4.ipv4.ipv4.ipv4 [ipv4.ipv4.ipv4.ipv4]/;
 561   s/host\s\Q$parm_ipv6\E\s\[\Q$parm_ipv6\E\]/host ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6 [ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6]/;
 562   s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g;
 563   s/(^|\W)\K\Q$parm_ipv6\E/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g;
 564   s/\b\Q$parm_ipv4r\E\b/ip4-reverse/g;
 565   s/(^|\W)\K\Q$parm_ipv6r\E/ip6-reverse/g;
 566   s/^(\s+host\s\S+\s+\[\S+\]) +$/$1 /;
 567
 568
 569   # ======== Test network IP addresses ========
 570   s/(\b|_)\Q$parm_ipv4_test_net\E(?=\.\d+\.\d+\.\d+\b|_|\.rbl|\.in-addr|\.test\.again\.dns)/$1V4NET/g;
 571   s/\b\Q$parm_ipv6_test_net\E(?=:[\da-f]+:[\da-f]+:[\da-f]+)/V6NET/gi;
 572
 573
 574   # ======== IP error numbers and messages ========
 575   # These vary between operating systems
 576   s/Can't assign requested address/Network Error/;
 577   s/Cannot assign requested address/Network Error/;
 578   s/Operation timed out/Connection timed out/;
 579   s/Address family not supported by protocol family/Network Error/;
 580   s/Network is unreachable/Network Error/;
 581   s/Invalid argument/Network Error/;
 582
 583   s/\(\d+\): Network/(dd): Network/;
 584   s/\(\d+\): Connection refused/(dd): Connection refused/;
 585   s/\(\d+\): Connection timed out/(dd): Connection timed out/;
 586   s/\d+ 65 Connection refused/dd 65 Connection refused/;
 587   s/\d+ 321 Connection timed out/dd 321 Connection timed out/;
 588
 589
 590   # ======== Other error numbers ========
 591   s/errno=\d+/errno=dd/g;
 592
 593
 594   # ======== Output from ls ========
 595   # Different operating systems use different spacing on long output
 596   #s/ +/ /g if /^[-rwd]{10} /;
 597   # (Bug 1226) SUSv3 allows a trailing printable char for modified access method control.
 598   # Handle only the Gnu and MacOS space, dot, plus and at-sign.  A full [[:graph:]]
 599   # unfortunately matches a non-ls linefull of dashes.
 600   # Allow the case where we've already picked out the file protection bits.
 601   if (s/^([-d](?:[-r][-w][-SsTtx]){3})[.+@]?( +|$)/\1\2/) {
 602     s/ +/ /g;
 603   }
 604
 605
 606   # ======== Message sizes =========
 607   # Message sizes vary, owing to different logins and host names that get
 608   # automatically inserted. I can't think of any way of even approximately
 609   # comparing these.
 610
 611   s/([\s,])S=\d+\b/$1S=sss/;
 612   s/:S\d+\b/:Ssss/;
 613   s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout;
 614   s/\sSIZE=\d+\b/ SIZE=ssss/;
 615   s/\ssize=\d+\b/ size=sss/ if $is_stderr;
 616   s/old size = \d+\b/old size = sssss/;
 617   s/message size = \d+\b/message size = sss/;
 618   s/this message = \d+\b/this message = sss/;
 619   s/Size of headers = \d+/Size of headers = sss/;
 620   s/sum=(?!0)\d+/sum=dddd/;
 621   s/(?<=sum=dddd )count=(?!0)\d+\b/count=dd/;
 622   s/(?<=sum=0 )count=(?!0)\d+\b/count=dd/;
 623   s/,S is \d+\b/,S is ddddd/;
 624   s/\+0100,\d+;/+0100,ddd;/;
 625   s/\(\d+ bytes written\)/(ddd bytes written)/;
 626   s/added '\d+ 1'/added 'ddd 1'/;
 627   s/Received\s+\d+/Received               nnn/;
 628   s/Delivered\s+\d+/Delivered              nnn/;
 629
 630
 631   # ======== Values in spool space failure message ========
 632   s/space=\d+ inodes=[+-]?\d+/space=xxxxx inodes=xxxxx/;
 633
 634
 635   # ======== Filter sizes ========
 636   # The sizes of filter files may vary because of the substitution of local
 637   # filenames, logins, etc.
 638
 639   s/^\d+(?= bytes read from )/ssss/;
 640
 641
 642   # ======== OpenSSL error messages ========
 643   # Different releases of the OpenSSL libraries seem to give different error
 644   # numbers, or handle specific bad conditions in different ways, leading to
 645   # different wording in the error messages, so we cannot compare them.
 646
 647   s/(TLS error on connection (?:from|to) .*? \(SSL_\w+\): error:)(.*)/$1 <<detail omitted>>/;
 648
 649
 650   # ======== Maildir things ========
 651   # timestamp output in maildir processing
 652   s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g;
 653
 654   # maildir delivery files appearing in log lines (in cases of error)
 655   s/writing to(?: file)? tmp\/\d+\.[^.]+\.(\S+)/writing to tmp\/MAILDIR.$1/;
 656
 657   s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/;
 658
 659   # Maildir file names in general
 660   s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/;
 661
 662   # Maildirsize data
 663   while (/^\d+S,\d+C\s*$/)
 664     {
 665     print MUNGED;
 666     while (<IN>)
 667       {
 668       last if !/^\d+ \d+\s*$/;
 669       print MUNGED "ddd d\n";
 670       }
 671     last if !defined $_;
 672     }
 673   last if !defined $_;
 674
 675
 676   # ======== Output from the "fd" program about open descriptors ========
 677   # The statuses seem to be different on different operating systems, but
 678   # at least we'll still be checking the number of open fd's.
 679
 680   s/max fd = \d+/max fd = dddd/;
 681   s/status=0 RDONLY/STATUS/g;
 682   s/status=1 WRONLY/STATUS/g;
 683   s/status=2 RDWR/STATUS/g;
 684
 685
 686   # ======== Contents of spool files ========
 687   # A couple of tests dump the contents of the -H file. The length fields
 688   # will be wrong because of different user names, etc.
 689   s/^\d\d\d(?=[PFS*])/ddd/;
 690
 691
 692   # ========= Exim lookups ==================
 693   # Lookups have a char which depends on the number of lookup types compiled in,
 694   # in stderr output.  Replace with a "0".  Recognising this while avoiding
 695   # other output is fragile; perhaps the debug output should be revised instead.
 696   s%(?<!sqlite)(?<!lsearch\*@)(?<!lsearch\*)(?<!lsearch)[0-?]TESTSUITE/aux-fixed/%0TESTSUITE/aux-fixed/%g;
 697
 698   # ==========================================================
 699   # Some munging is specific to the specific file types
 700
 701   # ======== stdout ========
 702
 703   if ($is_stdout)
 704     {
 705     # Skip translate_ip_address and use_classresources in -bP output because
 706     # they aren't always there.
 707
 708     next if /translate_ip_address =/;
 709     next if /use_classresources/;
 710
 711     # In certain filter tests, remove initial filter lines because they just
 712     # clog up by repetition.
 713
 714     if ($rmfiltertest)
 715       {
 716       next if /^(Sender\staken\sfrom|
 717                  Return-path\scopied\sfrom|
 718                  Sender\s+=|
 719                  Recipient\s+=)/x;
 720       if (/^Testing \S+ filter/)
 721         {
 722         $_ = <IN>;    # remove blank line
 723         next;
 724         }
 725       }
 726     }
 727
 728   # ======== stderr ========
 729
 730   elsif ($is_stderr)
 731     {
 732     # The very first line of debugging output will vary
 733
 734     s/^Exim version .*/Exim version x.yz ..../;
 735
 736     # Debugging lines for Exim terminations
 737
 738     s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/;
 739
 740     # IP address lookups use gethostbyname() when IPv6 is not supported,
 741     # and gethostbyname2() or getipnodebyname() when it is.
 742
 743     s/\bgethostbyname2?|\bgetipnodebyname/get[host|ipnode]byname[2]/;
 744
 745     # drop gnutls version strings
 746     next if /GnuTLS compile-time version: \d+[\.\d]+$/;
 747     next if /GnuTLS runtime version: \d+[\.\d]+$/;
 748
 749     # drop openssl version strings
 750     next if /OpenSSL compile-time version: OpenSSL \d+[\.\da-z]+/;
 751     next if /OpenSSL runtime version: OpenSSL \d+[\.\da-z]+/;
 752
 753     # drop lookups
 754     next if /^Lookups \(built-in\):/;
 755     next if /^Loading lookup modules from/;
 756     next if /^Loaded \d+ lookup modules/;
 757     next if /^Total \d+ lookups/;
 758
 759     # drop compiler information
 760     next if /^Compiler:/;
 761
 762     # and the ugly bit
 763     # different libraries will have different numbers (possibly 0) of follow-up
 764     # lines, indenting with more data
 765     if (/^Library version:/) {
 766       while (1) {
 767         $_ = <IN>;
 768         next if /^\s/;
 769         goto RESET_AFTER_EXTRA_LINE_READ;
 770       }
 771     }
 772
 773     # drop other build-time controls emitted for debugging
 774     next if /^WHITELIST_D_MACROS:/;
 775     next if /^TRUSTED_CONFIG_LIST:/;
 776
 777     # As of Exim 4.74, we log when a setgid fails; because we invoke Exim
 778     # with -be, privileges will have been dropped, so this will always
 779     # be the case
 780     next if /^changing group to \d+ failed: Operation not permitted/;
 781
 782     # We invoke Exim with -D, so we hit this new messag as of Exim 4.73:
 783     next if /^macros_trusted overridden to true by whitelisting/;
 784
 785     # We have to omit the localhost ::1 address so that all is well in
 786     # the IPv4-only case.
 787
 788     print MUNGED "MUNGED: ::1 will be omitted in what follows\n"
 789       if (/looked up these IP addresses/);
 790     next if /name=localhost address=::1/;
 791
 792     # drop pdkim debugging header
 793     next if /^PDKIM <<<<<<<<<<<<<<<<<<<<<<<<<<<<<+$/;
 794
 795     # Various other IPv6 lines must be omitted too
 796
 797     next if /using host_fake_gethostbyname for \S+ \(IPv6\)/;
 798     next if /get\[host\|ipnode\]byname\[2\]\(af=inet6\)/;
 799     next if /DNS lookup of \S+ \(AAAA\) using fakens/;
 800     next if / in dns_ipv4_lookup?/;
 801
 802     if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/)
 803       {
 804       $_= <IN>;     # Gets "returning DNS_NODATA"
 805       next;
 806       }
 807
 808     # Skip tls_advertise_hosts and hosts_require_tls checks when the options
 809     # are unset, because tls ain't always there.
 810
 811     next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?)
 812                 \sno\s\(option\sunset\)/x;
 813
 814     # Skip auxiliary group lists because they will vary.
 815
 816     next if /auxiliary group list:/;
 817
 818     # Skip "extracted from gecos field" because the gecos field varies
 819
 820     next if /extracted from gecos field/;
 821
 822     # Skip "waiting for data on socket" and "read response data: size=" lines
 823     # because some systems pack more stuff into packets than others.
 824
 825     next if /waiting for data on socket/;
 826     next if /read response data: size=/;
 827
 828     # If Exim is compiled with readline support but it can't find the library
 829     # to load, there will be an extra debug line. Omit it.
 830
 831     next if /failed to load readline:/;
 832
 833     # Some DBM libraries seem to make DBM files on opening with O_RDWR without
 834     # O_CREAT; other's don't. In the latter case there is some debugging output
 835     # which is not present in the former. Skip the relevant lines (there are
 836     # two of them).
 837
 838     if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/)
 839       {
 840       $_ = <IN>;
 841       next;
 842       }
 843
 844     # Some tests turn on +expand debugging to check on expansions.
 845     # Unfortunately, the Received: expansion varies, depending on whether TLS
 846     # is compiled or not. So we must remove the relevant debugging if it is.
 847
 848     if (/^condition: def:tls_cipher/)
 849       {
 850       while (<IN>) { last if /^condition: def:sender_address/; }
 851       }
 852     elsif (/^expanding: Received: /)
 853       {
 854       while (<IN>) { last if !/^\s/; }
 855       }
 856
 857     # When Exim is checking the size of directories for maildir, it uses
 858     # the check_dir_size() function to scan directories. Of course, the order
 859     # of the files that are obtained using readdir() varies from system to
 860     # system. We therefore buffer up debugging lines from check_dir_size()
 861     # and sort them before outputting them.
 862
 863     if (/^check_dir_size:/ || /^skipping TESTSUITE\/test-mail\//)
 864       {
 865       push @saved, $_;
 866       }
 867     else
 868       {
 869       if (@saved > 0)
 870         {
 871         print MUNGED "MUNGED: the check_dir_size lines have been sorted " .
 872           "to ensure consistency\n";
 873         @saved = sort(@saved);
 874         print MUNGED @saved;
 875         @saved = ();
 876         }
 877
 878       # Skip some lines that Exim puts out at the start of debugging output
 879       # because they will be different in different binaries.
 880
 881       print MUNGED
 882         unless (/^Berkeley DB: / ||
 883                 /^Probably (?:Berkeley DB|ndbm|GDBM)/ ||
 884                 /^Authenticators:/ ||
 885                 /^Lookups:/ ||
 886                 /^Support for:/ ||
 887                 /^Routers:/ ||
 888                 /^Transports:/ ||
 889                 /^log selectors =/ ||
 890                 /^cwd=/ ||
 891                 /^Fixed never_users:/ ||
 892                 /^Size of off_t:/
 893                 );
 894       }
 895
 896     next;
 897     }
 898
 899   # ======== All files other than stderr ========
 900
 901   print MUNGED;
 902   }
 903
 904 close(IN);
 905 return $yield;
 906 }
 907
 908
 909
 910
 911 ##################################################
 912 #        Subroutine to interact with caller      #
 913 ##################################################
 914
 915 # Arguments: [0] the prompt string
 916 #            [1] if there is a U in the prompt and $force_update is true
 917 # Returns:   nothing (it sets $_)
 918
 919 sub interact{
 920 print $_[0];
 921 if ($_[1]) { $_ = "u"; print "... update forced\n"; }
 922   else { $_ = <T>; }
 923 }
 924
 925
 926
 927
 928 ##################################################
 929 #    Subroutine to compare one output file       #
 930 ##################################################
 931
 932 # When an Exim server is part of the test, its output is in separate files from
 933 # an Exim client. The server data is concatenated with the client data as part
 934 # of the munging operation.
 935 #
 936 # Arguments:  [0] the name of the main raw output file
 937 #             [1] the name of the server raw output file or undef
 938 #             [2] where to put the munged copy
 939 #             [3] the name of the saved file
 940 #             [4] TRUE if this is a log file whose deliveries must be sorted
 941 #
 942 # Returns:    0 comparison succeeded or differences to be ignored
 943 #             1 comparison failed; files may have been updated (=> re-compare)
 944 #
 945 # Does not return if the user replies "Q" to a prompt.
 946
 947 sub check_file{
 948 my($rf,$rsf,$mf,$sf,$sortfile) = @_;
 949
 950 # If there is no saved file, the raw files must either not exist, or be
 951 # empty. The test ! -s is TRUE if the file does not exist or is empty.
 952
 953 if (! -e $sf)
 954   {
 955   return 0 if (! -s $rf && (! defined $rsf || ! -s $rsf));
 956
 957   print "\n";
 958   print "** $rf is not empty\n" if (-s $rf);
 959   print "** $rsf is not empty\n" if (defined $rsf && -s $rsf);
 960
 961   for (;;)
 962     {
 963     print "Continue, Show, or Quit? [Q] ";
 964     $_ = <T>;
 965     tests_exit(1) if /^q?$/i;
 966     return 0 if /^c$/i;
 967     last if (/^s$/);
 968     }
 969
 970   foreach $f ($rf, $rsf)
 971     {
 972     if (defined $f && -s $f)
 973       {
 974       print "\n";
 975       print "------------ $f -----------\n"
 976         if (defined $rf && -s $rf && defined $rsf && -s $rsf);
 977       system("$more '$f'");
 978       }
 979     }
 980
 981   print "\n";
 982   for (;;)
 983     {
 984     interact("Continue, Update & retry, Quit? [Q] ", $force_update);
 985     tests_exit(1) if /^q?$/i;
 986     return 0 if /^c$/i;
 987     last if (/^u$/i);
 988     }
 989   }
 990
 991 # Control reaches here if either (a) there is a saved file ($sf), or (b) there
 992 # was a request to create a saved file. First, create the munged file from any
 993 # data that does exist.
 994
 995 open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
 996 my($truncated) = munge($rf) if -e $rf;
 997 if (defined $rsf && -e $rsf)
 998   {
 999   print MUNGED "\n******** SERVER ********\n";
1000   $truncated |= munge($rsf);
1001   }
1002 close(MUNGED);
1003
1004 # If a saved file exists, do the comparison. There are two awkward cases:
1005 #
1006 # If "*** truncated ***" was found in the new file, it means that a log line
1007 # was overlong, and truncated. The problem is that it may be truncated at
1008 # different points on different systems, because of different user name
1009 # lengths. We reload the file and the saved file, and remove lines from the new
1010 # file that precede "*** truncated ***" until we reach one that matches the
1011 # line that precedes it in the saved file.
1012 #
1013 # If $sortfile is set, we are dealing with a mainlog file where the deliveries
1014 # for an individual message might vary in their order from system to system, as
1015 # a result of parallel deliveries. We load the munged file and sort sequences
1016 # of delivery lines.
1017
1018 if (-e $sf)
1019   {
1020   # Deal with truncated text items
1021
1022   if ($truncated)
1023     {
1024     my(@munged, @saved, $i, $j, $k);
1025
1026     open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!");
1027     @munged = <MUNGED>;
1028     close(MUNGED);
1029     open(SAVED, "$sf") || tests_exit(-1, "Failed to open $sf: $!");
1030     @saved = <SAVED>;
1031     close(SAVED);
1032
1033     $j = 0;
1034     for ($i = 0; $i < @munged; $i++)
1035       {
1036       if ($munged[$i] =~ /\*\*\* truncated \*\*\*/)
1037         {
1038         for (; $j < @saved; $j++)
1039           { last if $saved[$j] =~ /\*\*\* truncated \*\*\*/; }
1040         last if $j >= @saved;     # not found in saved
1041
1042         for ($k = $i - 1; $k >= 0; $k--)
1043           { last if $munged[$k] eq $saved[$j - 1]; }
1044
1045         last if $k <= 0;          # failed to find previous match
1046         splice @munged, $k + 1, $i - $k - 1;
1047         $i = $k + 1;
1048         }
1049       }
1050
1051     open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
1052     for ($i = 0; $i < @munged; $i++)
1053       { print MUNGED $munged[$i]; }
1054     close(MUNGED);
1055     }
1056
1057   # Deal with log sorting
1058
1059   if ($sortfile)
1060     {
1061     my(@munged, $i, $j);
1062
1063     open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!");
1064     @munged = <MUNGED>;
1065     close(MUNGED);
1066
1067     for ($i = 0; $i < @munged; $i++)
1068       {
1069       if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/)
1070         {
1071         for ($j = $i + 1; $j < @munged; $j++)
1072           {
1073           last if $munged[$j] !~
1074             /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/;
1075           }
1076         @temp = splice(@munged, $i, $j - $i);
1077         @temp = sort(@temp);
1078         splice(@munged, $i, 0, @temp);
1079         }
1080       }
1081
1082     open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!");
1083     print MUNGED "**NOTE: The delivery lines in this file have been sorted.\n";
1084     for ($i = 0; $i < @munged; $i++)
1085       { print MUNGED $munged[$i]; }
1086     close(MUNGED);
1087     }
1088
1089   # Do the comparison
1090
1091   return 0 if (system("$cf '$mf' '$sf' >test-cf") == 0);
1092
1093   # Handle comparison failure
1094
1095   print "** Comparison of $mf with $sf failed";
1096   system("$more test-cf");
1097
1098   print "\n";
1099   for (;;)
1100     {
1101     interact("Continue, Retry, Update & retry, Quit? [Q] ", $force_update);
1102     tests_exit(1) if /^q?$/i;
1103     return 0 if /^c$/i;
1104     return 1 if /^r$/i;
1105     last if (/^u$/i);
1106     }
1107   }
1108
1109 # Update or delete the saved file, and give the appropriate return code.
1110
1111 if (-s $mf)
1112   { tests_exit(-1, "Failed to cp $mf $sf") if system("cp '$mf' '$sf'") != 0; }
1113 else
1114   { tests_exit(-1, "Failed to unlink $sf") if !unlink($sf); }
1115
1116 return 1;
1117 }
1118
1119
1120
1121 ##################################################
1122 #    Subroutine to check the output of a test    #
1123 ##################################################
1124
1125 # This function is called when the series of subtests is complete. It makes
1126 # use of check() file, whose arguments are:
1127 #
1128 #  [0] the name of the main raw output file
1129 #  [1] the name of the server raw output file or undef
1130 #  [2] where to put the munged copy
1131 #  [3] the name of the saved file
1132 #  [4] TRUE if this is a log file whose deliveries must be sorted
1133 #
1134 # Arguments: none
1135 # Returns:   0 if the output compared equal
1136 #            1 if re-run needed (files may have been updated)
1137
1138 sub check_output{
1139 my($yield) = 0;
1140
1141 $yield = 1 if check_file("spool/log/paniclog",
1142                        "spool/log/serverpaniclog",
1143                        "test-paniclog-munged",
1144                        "paniclog/$testno", 0);
1145
1146 $yield = 1 if check_file("spool/log/rejectlog",
1147                        "spool/log/serverrejectlog",
1148                        "test-rejectlog-munged",
1149                        "rejectlog/$testno", 0);
1150
1151 $yield = 1 if check_file("spool/log/mainlog",
1152                        "spool/log/servermainlog",
1153                        "test-mainlog-munged",
1154                        "log/$testno", $sortlog);
1155
1156 if (!$stdout_skip)
1157   {
1158   $yield = 1 if check_file("test-stdout",
1159                        "test-stdout-server",
1160                        "test-stdout-munged",
1161                        "stdout/$testno", 0);
1162   }
1163
1164 if (!$stderr_skip)
1165   {
1166   $yield = 1 if check_file("test-stderr",
1167                        "test-stderr-server",
1168                        "test-stderr-munged",
1169                        "stderr/$testno", 0);
1170   }
1171
1172 # Compare any delivered messages, unless this test is skipped.
1173
1174 if (! $message_skip)
1175   {
1176   my($msgno) = 0;
1177
1178   # Get a list of expected mailbox files for this script. We don't bother with
1179   # directories, just the files within them.
1180
1181   foreach $oldmail (@oldmails)
1182     {
1183     next unless $oldmail =~ /^mail\/$testno\./;
1184     print ">> EXPECT $oldmail\n" if $debug;
1185     $expected_mails{$oldmail} = 1;
1186     }
1187
1188   # If there are any files in test-mail, compare them. Note that "." and
1189   # ".." are automatically omitted by list_files_below().
1190
1191   @mails = list_files_below("test-mail");
1192
1193   foreach $mail (@mails)
1194     {
1195     next if $mail eq "test-mail/oncelog";
1196
1197     $saved_mail = substr($mail, 10);               # Remove "test-mail/"
1198     $saved_mail =~ s/^$parm_caller(\/|$)/CALLER/;  # Convert caller name
1199
1200     if ($saved_mail =~ /(\d+\.[^.]+\.)/)
1201       {
1202       $msgno++;
1203       $saved_mail =~ s/(\d+\.[^.]+\.)/$msgno./gx;
1204       }
1205
1206     print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug;
1207     $yield = 1 if check_file($mail, undef, "test-mail-munged",
1208       "mail/$testno.$saved_mail", 0);
1209     delete $expected_mails{"mail/$testno.$saved_mail"};
1210     }
1211
1212   # Complain if not all expected mails have been found
1213
1214   if (scalar(keys %expected_mails) != 0)
1215     {
1216     foreach $key (keys %expected_mails)
1217       { print "** no test file found for $key\n"; }
1218
1219     for (;;)
1220       {
1221       interact("Continue, Update & retry, or Quit? [Q] ", $force_update);
1222       tests_exit(1) if /^q?$/i;
1223       last if /^c$/i;
1224
1225       # For update, we not only have to unlink the file, but we must also
1226       # remove it from the @oldmails vector, as otherwise it will still be
1227       # checked for when we re-run the test.
1228
1229       if (/^u$/i)
1230         {
1231         foreach $key (keys %expected_mails)
1232           {
1233           my($i);
1234           tests_exit(-1, "Failed to unlink $key") if !unlink("$key");
1235           for ($i = 0; $i < @oldmails; $i++)
1236             {
1237             if ($oldmails[$i] eq $key)
1238               {
1239               splice @oldmails, $i, 1;
1240               last;
1241               }
1242             }
1243           }
1244         last;
1245         }
1246       }
1247     }
1248   }
1249
1250 # Compare any remaining message logs, unless this test is skipped.
1251
1252 if (! $msglog_skip)
1253   {
1254   # Get a list of expected msglog files for this test
1255
1256   foreach $oldmsglog (@oldmsglogs)
1257     {
1258     next unless $oldmsglog =~ /^$testno\./;
1259     $expected_msglogs{$oldmsglog} = 1;
1260     }
1261
1262   # If there are any files in spool/msglog, compare them. However, we have
1263   # to munge the file names because they are message ids, which are
1264   # time dependent.
1265
1266   if (opendir(DIR, "spool/msglog"))
1267     {
1268     @msglogs = sort readdir(DIR);
1269     closedir(DIR);
1270
1271     foreach $msglog (@msglogs)
1272       {
1273       next if ($msglog eq "." || $msglog eq ".." || $msglog eq "CVS");
1274       ($munged_msglog = $msglog) =~
1275         s/((?:[^\W_]{6}-){2}[^\W_]{2})
1276           /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx;
1277       $yield = 1 if check_file("spool/msglog/$msglog", undef,
1278         "test-msglog-munged", "msglog/$testno.$munged_msglog", 0);
1279       delete $expected_msglogs{"$testno.$munged_msglog"};
1280       }
1281     }
1282
1283   # Complain if not all expected msglogs have been found
1284
1285   if (scalar(keys %expected_msglogs) != 0)
1286     {
1287     foreach $key (keys %expected_msglogs)
1288       {
1289       print "** no test msglog found for msglog/$key\n";
1290       ($msgid) = $key =~ /^\d+\.(.*)$/;
1291       foreach $cachekey (keys %cache)
1292         {
1293         if ($cache{$cachekey} eq $msgid)
1294           {
1295           print "** original msgid $cachekey\n";
1296           last;
1297           }
1298         }
1299       }
1300
1301     for (;;)
1302       {
1303       interact("Continue, Update, or Quit? [Q] ", $force_update);
1304       tests_exit(1) if /^q?$/i;
1305       last if /^c$/i;
1306       if (/^u$/i)
1307         {
1308         foreach $key (keys %expected_msglogs)
1309           {
1310           tests_exit(-1, "Failed to unlink msglog/$key")
1311             if !unlink("msglog/$key");
1312           }
1313         last;
1314         }
1315       }
1316     }
1317   }
1318
1319 return $yield;
1320 }
1321
1322
1323
1324 ##################################################
1325 #     Subroutine to run one "system" command     #
1326 ##################################################
1327
1328 # We put this in a subroutine so that the command can be reflected when
1329 # debugging.
1330 #
1331 # Argument: the command to be run
1332 # Returns:  nothing
1333
1334 sub run_system {
1335 my($cmd) = $_[0];
1336 if ($debug)
1337   {
1338   my($prcmd) = $cmd;
1339   $prcmd =~ s/; /;\n>> /;
1340   print ">> $prcmd\n";
1341   }
1342 system("$cmd");
1343 }
1344
1345
1346
1347 ##################################################
1348 #      Subroutine to run one script command      #
1349 ##################################################
1350
1351 # The <SCRIPT> file is open for us to read an optional return code line,
1352 # followed by the command line and any following data lines for stdin. The
1353 # command line can be continued by the use of \. Data lines are not continued
1354 # in this way. In all lines, the following substutions are made:
1355 #
1356 # DIR    => the current directory
1357 # CALLER => the caller of this script
1358 #
1359 # Arguments: the current test number
1360 #            reference to the subtest number, holding previous value
1361 #            reference to the expected return code value
1362 #            reference to where to put the command name (for messages)
1363 #
1364 # Returns:   0 the commmand was executed inline, no subprocess was run
1365 #            1 a non-exim command was run and waited for
1366 #            2 an exim command was run and waited for
1367 #            3 a command was run and not waited for (daemon, server, exim_lock)
1368 #            4 EOF was encountered after an initial return code line
1369
1370 sub run_command{
1371 my($testno) = $_[0];
1372 my($subtestref) = $_[1];
1373 my($commandnameref) = $_[3];
1374 my($yield) = 1;
1375
1376 if (/^(\d+)\s*$/)                # Handle unusual return code
1377   {
1378   my($r) = $_[2];
1379   $$r = $1 << 8;
1380   $_ = <SCRIPT>;
1381   return 4 if !defined $_;       # Missing command
1382   $lineno++;
1383   }
1384
1385 chomp;
1386 $wait_time = 0;
1387
1388 # Handle concatenated command lines
1389
1390 s/\s+$//;
1391 while (substr($_, -1) eq"\\")
1392   {
1393   my($temp);
1394   $_ = substr($_, 0, -1);
1395   chomp($temp = <SCRIPT>);
1396   if (defined $temp)
1397     {
1398     $lineno++;
1399     $temp =~ s/\s+$//;
1400     $temp =~ s/^\s+//;
1401     $_ .= $temp;
1402     }
1403   }
1404
1405 # Do substitutions
1406
1407 do_substitute($testno);
1408 if ($debug) { printf ">> $_\n"; }
1409
1410 # Pass back the command name (for messages)
1411
1412 ($$commandnameref) = /^(\S+)/;
1413
1414 # Here follows code for handling the various different commands that are
1415 # supported by this script. The first group of commands are all freestanding
1416 # in that they share no common code and are not followed by any data lines.
1417
1418
1419 ###################
1420 ###################
1421
1422 # The "dbmbuild" command runs exim_dbmbuild. This is used both to test the
1423 # utility and to make DBM files for testing DBM lookups.
1424
1425 if (/^dbmbuild\s+(\S+)\s+(\S+)/)
1426   {
1427   run_system("(./eximdir/exim_dbmbuild $parm_cwd/$1 $parm_cwd/$2;" .
1428          "echo exim_dbmbuild exit code = \$?)" .
1429          ">>test-stdout");
1430   return 1;
1431   }
1432
1433
1434 # The "dump" command runs exim_dumpdb. On different systems, the output for
1435 # some types of dump may appear in a different order because it's just hauled
1436 # out of the DBM file. We can solve this by sorting. Ignore the leading
1437 # date/time, as it will be flattened later during munging.
1438
1439 if (/^dump\s+(\S+)/)
1440   {
1441   my($which) = $1;
1442   my(@temp);
1443   print ">> ./eximdir/exim_dumpdb $parm_cwd/spool $which\n" if $debug;
1444   open(IN, "./eximdir/exim_dumpdb $parm_cwd/spool $which |");
1445   @temp = <IN>;
1446   close(IN);
1447   if ($which eq "callout")
1448     {
1449     @temp = sort {
1450                  my($aa) = substr $a, 21;
1451                  my($bb) = substr $b, 21;
1452                  return $aa cmp $bb;
1453                  } @temp;
1454     }
1455   open(OUT, ">>test-stdout");
1456   print OUT "+++++++++++++++++++++++++++\n";
1457   print OUT @temp;
1458   close(OUT);
1459   return 1;
1460   }
1461
1462
1463 # The "echo" command is a way of writing comments to the screen.
1464
1465 if (/^echo\s+(.*)$/)
1466   {
1467   print "$1\n";
1468   return 0;
1469   }
1470
1471
1472 # The "exim_lock" command runs exim_lock in the same manner as "server",
1473 # but it doesn't use any input.
1474
1475 if (/^exim_lock\s+(.*)$/)
1476   {
1477   $cmd = "./eximdir/exim_lock $1 >>test-stdout";
1478   $server_pid = open SERVERCMD, "|$cmd" ||
1479     tests_exit(-1, "Failed to run $cmd\n");
1480
1481   # This gives the process time to get started; otherwise the next
1482   # process may not find it there when it expects it.
1483
1484   select(undef, undef, undef, 0.1);
1485   return 3;
1486   }
1487
1488
1489 # The "exinext" command runs exinext
1490
1491 if (/^exinext\s+(.*)/)
1492   {
1493   run_system("(./eximdir/exinext " .
1494     "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
1495     "-C $parm_cwd/test-config $1;" .
1496     "echo exinext exit code = \$?)" .
1497     ">>test-stdout");
1498   return 1;
1499   }
1500
1501
1502 # The "exigrep" command runs exigrep on the current mainlog
1503
1504 if (/^exigrep\s+(.*)/)
1505   {
1506   run_system("(./eximdir/exigrep " .
1507     "$1 $parm_cwd/spool/log/mainlog;" .
1508     "echo exigrep exit code = \$?)" .
1509     ">>test-stdout");
1510   return 1;
1511   }
1512
1513
1514 # The "eximstats" command runs eximstats on the current mainlog
1515
1516 if (/^eximstats\s+(.*)/)
1517   {
1518   run_system("(./eximdir/eximstats " .
1519     "$1 $parm_cwd/spool/log/mainlog;" .
1520     "echo eximstats exit code = \$?)" .
1521     ">>test-stdout");
1522   return 1;
1523   }
1524
1525
1526 # The "gnutls" command makes a copy of saved GnuTLS parameter data in the
1527 # spool directory, to save Exim from re-creating it each time.
1528
1529 if (/^gnutls/)
1530   {
1531   run_system "sudo cp -p aux-fixed/gnutls-params spool/gnutls-params;" .
1532          "sudo chown $parm_eximuser:$parm_eximgroup spool/gnutls-params;" .
1533          "sudo chmod 0400 spool/gnutls-params";
1534   return 1;
1535   }
1536
1537
1538 # The "killdaemon" command should ultimately follow the starting of any Exim
1539 # daemon with the -bd option. We kill with SIGINT rather than SIGTERM to stop
1540 # it outputting "Terminated" to the terminal when not in the background.
1541
1542 if (/^killdaemon/)
1543   {
1544   $pid = `cat $parm_cwd/spool/exim-daemon.*`;
1545   run_system("sudo /bin/kill -SIGINT $pid");
1546   close DAEMONCMD;                                   # Waits for process
1547   run_system("sudo /bin/rm -f spool/exim-daemon.*");
1548   return 1;
1549   }
1550
1551
1552 # The "millisleep" command is like "sleep" except that its argument is in
1553 # milliseconds, thus allowing for a subsecond sleep, which is, in fact, all it
1554 # is used for.
1555
1556 elsif (/^millisleep\s+(.*)$/)
1557   {
1558   select(undef, undef, undef, $1/1000);
1559   return 0;
1560   }
1561
1562
1563 # The "sleep" command does just that. For sleeps longer than 1 second we
1564 # tell the user what's going on.
1565
1566 if (/^sleep\s+(.*)$/)
1567   {
1568   if ($1 == 1)
1569     {
1570     sleep(1);
1571     }
1572   else
1573     {
1574     printf("  Test %d sleep $1 ", $$subtestref);
1575     for (1..$1)
1576       {
1577       print ".";
1578       sleep(1);
1579       }
1580     printf("\r  Test %d                            $cr", $$subtestref);
1581     }
1582   return 0;
1583   }
1584
1585
1586 # Various Unix management commands are recognized
1587
1588 if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ ||
1589     /^sudo (rmdir|rm|chown|chmod)\s/)
1590   {
1591   run_system("$_ >>test-stdout 2>>test-stderr");
1592   return 1;
1593   }
1594
1595
1596
1597 ###################
1598 ###################
1599
1600 # The next group of commands are also freestanding, but they are all followed
1601 # by data lines.
1602
1603
1604 # The "server" command starts up a script-driven server that runs in parallel
1605 # with the following exim command. Therefore, we want to run a subprocess and
1606 # not yet wait for it to complete. The waiting happens after the next exim
1607 # command, triggered by $server_pid being non-zero. The server sends its output
1608 # to a different file. The variable $server_opts, if not empty, contains
1609 # options to disable IPv4 or IPv6 if necessary.
1610
1611 if (/^server\s+(.*)$/)
1612   {
1613   $cmd = "./bin/server $server_opts $1 >>test-stdout-server";
1614   print ">> $cmd\n" if ($debug);
1615   $server_pid = open SERVERCMD, "|$cmd" || tests_exit(-1, "Failed to run $cmd");
1616   SERVERCMD->autoflush(1);
1617   print ">> Server pid is $server_pid\n" if $debug;
1618   while (<SCRIPT>)
1619     {
1620     $lineno++;
1621     last if /^\*{4}\s*$/;
1622     print SERVERCMD;
1623     }
1624   print SERVERCMD "++++\n"; # Send end to server; can't send EOF yet
1625                             # because close() waits for the process.
1626
1627   # This gives the server time to get started; otherwise the next
1628   # process may not find it there when it expects it.
1629
1630   select(undef, undef, undef, 0.5);
1631   return 3;
1632   }
1633
1634
1635 # The "write" command is a way of creating files of specific sizes for
1636 # buffering tests, or containing specific data lines from within the script
1637 # (rather than hold lots of little files). The "catwrite" command does the
1638 # same, but it also copies the lines to test-stdout.
1639
1640 if (/^(cat)?write\s+(\S+)(?:\s+(.*))?\s*$/)
1641   {
1642   my($cat) = defined $1;
1643   @sizes = ();
1644   @sizes = split /\s+/, $3 if defined $3;
1645   open FILE, ">$2" || tests_exit(-1, "Failed to open \"$2\": $!");
1646
1647   if ($cat)
1648     {
1649     open CAT, ">>test-stdout" ||
1650       tests_exit(-1, "Failed to open test-stdout: $!");
1651     print CAT "==========\n";
1652     }
1653
1654   if (scalar @sizes > 0)
1655     {
1656     # Pre-data
1657
1658     while (<SCRIPT>)
1659       {
1660       $lineno++;
1661       last if /^\+{4}\s*$/;
1662       print FILE;
1663       print CAT if $cat;
1664       }
1665
1666     # Sized data
1667
1668     while (scalar @sizes > 0)
1669       {
1670       ($count,$len,$leadin) = (shift @sizes) =~ /(\d+)x(\d+)(?:=(.*))?/;
1671       $leadin = "" if !defined $leadin;
1672       $leadin =~ s/_/ /g;
1673       $len -= length($leadin) + 1;
1674       while ($count-- > 0)
1675         {
1676         print FILE $leadin, "a" x $len, "\n";
1677         print CAT $leadin, "a" x $len, "\n" if $cat;
1678         }
1679       }
1680     }
1681
1682   # Post data, or only data if no sized data
1683
1684   while (<SCRIPT>)
1685     {
1686     $lineno++;
1687     last if /^\*{4}\s*$/;
1688     print FILE;
1689     print CAT if $cat;
1690     }
1691   close FILE;
1692
1693   if ($cat)
1694     {
1695     print CAT "==========\n";
1696     close CAT;
1697     }
1698
1699   return 0;
1700   }
1701
1702
1703 ###################
1704 ###################
1705
1706 # From this point on, script commands are implemented by setting up a shell
1707 # command in the variable $cmd. Shared code to run this command and handle its
1708 # input and output follows.
1709
1710 # The "client", "client-gnutls", and "client-ssl" commands run a script-driven
1711 # program that plays the part of an email client. We also have the availability
1712 # of running Perl for doing one-off special things. Note that all these
1713 # commands expect stdin data to be supplied.
1714
1715 if (/^client/ || /^(sudo\s+)?perl\b/)
1716   {
1717   s"client"./bin/client";
1718   $cmd = "$_ >>test-stdout 2>>test-stderr";
1719   }
1720
1721 # For the "exim" command, replace the text "exim" with the path for the test
1722 # binary, plus -D options to pass over various parameters, and a -C option for
1723 # the testing configuration file. When running in the test harness, Exim does
1724 # not drop privilege when -C and -D options are present. To run the exim
1725 # command as root, we use sudo.
1726
1727 elsif (/^([A-Z_]+=\S+\s+)?(\d+)?\s*(sudo\s+)?exim(_\S+)?\s+(.*)$/)
1728   {
1729   $args = $5;
1730   my($envset) = (defined $1)? $1      : "";
1731   my($sudo)   = (defined $3)? "sudo " : "";
1732   my($special)= (defined $4)? $4      : "";
1733   $wait_time  = (defined $2)? $2      : 0;
1734
1735   # Return 2 rather than 1 afterwards
1736
1737   $yield = 2;
1738
1739   # Update the test number
1740
1741   $$subtestref = $$subtestref + 1;
1742   printf("  Test %d       $cr", $$subtestref);
1743
1744   # Copy the configuration file, making the usual substitutions.
1745
1746   open (IN, "$parm_cwd/confs/$testno") ||
1747     tests_exit(-1, "Couldn't open $parm_cwd/confs/$testno: $!\n");
1748   open (OUT, ">test-config") ||
1749     tests_exit(-1, "Couldn't open test-config: $!\n");
1750   while (<IN>)
1751     {
1752     do_substitute($testno);
1753     print OUT;
1754     }
1755   close(IN);
1756   close(OUT);
1757
1758   # The string $msg1 in args substitutes the message id of the first
1759   # message on the queue, and so on. */
1760
1761   if ($args =~ /\$msg/)
1762     {
1763     my($listcmd) = "$parm_cwd/eximdir/exim -bp " .
1764                    "-DEXIM_PATH=$parm_cwd/eximdir/exim " .
1765                    "-C $parm_cwd/test-config |";
1766     print ">> Getting queue list from:\n>>    $listcmd\n" if ($debug);
1767     open (QLIST, $listcmd) || tests_exit(-1, "Couldn't run \"exim -bp\": $!\n");
1768     my(@msglist) = ();
1769     while (<QLIST>) { push (@msglist, $1) if /^\s*\d+[smhdw]\s+\S+\s+(\S+)/; }
1770     close(QLIST);
1771
1772     # Done backwards just in case there are more than 9
1773
1774     my($i);
1775     for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; }
1776     }
1777
1778   # If -d is specified in $optargs, remove it from $args; i.e. let
1779   # the command line for runtest override. Then run Exim.
1780
1781   $args =~ s/(?:^|\s)-d\S*// if $optargs =~ /(?:^|\s)-d/;
1782
1783   $cmd = "$envset$sudo$parm_cwd/eximdir/exim$special$optargs " .
1784          "-DEXIM_PATH=$parm_cwd/eximdir/exim$special " .
1785          "-C $parm_cwd/test-config $args " .
1786          ">>test-stdout 2>>test-stderr";
1787
1788   # If the command is starting an Exim daemon, we run it in the same
1789   # way as the "server" command above, that is, we don't want to wait
1790   # for the process to finish. That happens when "killdaemon" is obeyed later
1791   # in the script. We also send the stderr output to test-stderr-server. The
1792   # daemon has its log files put in a different place too (by configuring with
1793   # log_file_path). This requires the  directory to be set up in advance.
1794   #
1795   # There are also times when we want to run a non-daemon version of Exim
1796   # (e.g. a queue runner) with the server configuration. In this case,
1797   # we also define -DNOTDAEMON.
1798
1799   if ($cmd =~ /\s-DSERVER=server\s/ && $cmd !~ /\s-DNOTDAEMON\s/)
1800     {
1801     if ($debug) { printf ">> daemon: $cmd\n"; }
1802     run_system("sudo mkdir spool/log 2>/dev/null");
1803     run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log");
1804
1805     # Before running the command, convert the -bd option into -bdf so that an
1806     # Exim daemon doesn't double fork. This means that when we wait close
1807     # DAEMONCMD, it waits for the correct process. Also, ensure that the pid
1808     # file is written to the spool directory, in case the Exim binary was
1809     # built with PID_FILE_PATH pointing somewhere else.
1810
1811     $cmd =~ s!\s-bd\s! -bdf -oP $parm_cwd/spool/exim-daemon.pid !;
1812     print ">> |${cmd}-server\n" if ($debug);
1813     open DAEMONCMD, "|${cmd}-server" || tests_exit(-1, "Failed to run $cmd");
1814     DAEMONCMD->autoflush(1);
1815     while (<SCRIPT>) { $lineno++; last if /^\*{4}\s*$/; }   # Ignore any input
1816     select(undef, undef, undef, 0.3);             # Let the daemon get going
1817     return 3;                                     # Don't wait
1818     }
1819   }
1820
1821
1822 # Unknown command
1823
1824 else { tests_exit(-1, "Command unrecognized in line $lineno: $_"); }
1825
1826
1827 # Run the command, with stdin connected to a pipe, and write the stdin data
1828 # to it, with appropriate substitutions. If a line ends with \NONL\, chop off
1829 # the terminating newline (and the \NONL\). If the command contains
1830 # -DSERVER=server add "-server" to the command, where it will adjoin the name
1831 # for the stderr file. See comment above about the use of -DSERVER.
1832
1833 $stderrsuffix = ($cmd =~ /\s-DSERVER=server\s/)? "-server" : "";
1834 print ">> |${cmd}${stderrsuffix}\n" if ($debug);
1835 open CMD, "|${cmd}${stderrsuffix}" || tests_exit(1, "Failed to run $cmd");
1836
1837 CMD->autoflush(1);
1838 while (<SCRIPT>)
1839   {
1840   $lineno++;
1841   last if /^\*{4}\s*$/;
1842   do_substitute($testno);
1843   if (/^(.*)\\NONL\\\s*$/) { print CMD $1; } else { print CMD; }
1844   }
1845
1846 # For timeout tests, wait before closing the pipe; we expect a
1847 # SIGPIPE error in this case.
1848
1849 if ($wait_time > 0)
1850   {
1851   printf("  Test %d sleep $wait_time ", $$subtestref);
1852   while ($wait_time-- > 0)
1853     {
1854     print ".";
1855     sleep(1);
1856     }
1857   printf("\r  Test %d                                       $cr", $$subtestref);
1858   }
1859
1860 $sigpipehappened = 0;
1861 close CMD;                # Waits for command to finish
1862 return $yield;            # Ran command and waited
1863 }
1864
1865
1866
1867
1868 ###############################################################################
1869 ###############################################################################
1870
1871 # Here beginneth the Main Program ...
1872
1873 ###############################################################################
1874 ###############################################################################
1875
1876
1877 autoflush STDOUT 1;
1878 print "Exim tester $testversion\n";
1879
1880
1881 ##################################################
1882 #      Some tests check created file modes       #
1883 ##################################################
1884
1885 umask 022;
1886
1887
1888 ##################################################
1889 #       Check for the "less" command             #
1890 ##################################################
1891
1892 $more = "more" if system("which less >/dev/null 2>&1") != 0;
1893
1894
1895
1896 ##################################################
1897 #        Check for sudo access to root           #
1898 ##################################################
1899
1900 print "You need to have sudo access to root to run these tests. Checking ...\n";
1901 if (system("sudo date >/dev/null") != 0)
1902   {
1903   die "** Test for sudo failed: testing abandoned.\n";
1904   }
1905 else
1906   {
1907   print "Test for sudo OK\n";
1908   }
1909
1910
1911
1912 ##################################################
1913 #      See if an Exim binary has been given      #
1914 ##################################################
1915
1916 # If the first character of the first argument is '/', the argument is taken
1917 # as the path to the binary.
1918
1919 $parm_exim = (@ARGV > 0 && $ARGV[0] =~ ?^/?)? shift @ARGV : "";
1920 print "Exim binary is $parm_exim\n" if $parm_exim ne "";
1921
1922
1923
1924 ##################################################
1925 # Sort out options and which tests are to be run #
1926 ##################################################
1927
1928 # There are a few possible options for the test script itself; after these, any
1929 # options are passed on to Exim calls within the tests. Typically, this is used
1930 # to turn on Exim debugging while setting up a test.
1931
1932 while (@ARGV > 0 && $ARGV[0] =~ /^-/)
1933   {
1934   my($arg) = shift @ARGV;
1935   if ($optargs eq "")
1936     {
1937     if ($arg eq "-DEBUG")  { $debug = 1; $cr = "\n"; next; }
1938     if ($arg eq "-DIFF")   { $cf = "diff -u"; next; }
1939     if ($arg eq "-UPDATE") { $force_update = 1; next; }
1940     if ($arg eq "-NOIPV4") { $have_ipv4 = 0; next; }
1941     if ($arg eq "-NOIPV6") { $have_ipv6 = 0; next; }
1942     if ($arg eq "-KEEP")   { $save_output = 1; next; }
1943     }
1944   $optargs .= " $arg";
1945   }
1946
1947 # Any subsequent arguments are a range of test numbers.
1948
1949 if (@ARGV > 0)
1950   {
1951   $test_end = $test_start = $ARGV[0];
1952   $test_end = $ARGV[1] if (@ARGV > 1);
1953   $test_end = ($test_start >= 9000)? $test_special_top : $test_top
1954     if $test_end eq "+";
1955   die "** Test numbers out of order\n" if ($test_end < $test_start);
1956   }
1957
1958
1959 ##################################################
1960 #      Make the command's directory current      #
1961 ##################################################
1962
1963 # After doing so, we find its absolute path name.
1964
1965 $cwd = $0;
1966 $cwd = '.' if ($cwd !~ s|/[^/]+$||);
1967 chdir($cwd) || die "** Failed to chdir to \"$cwd\": $!\n";
1968 $parm_cwd = Cwd::getcwd();
1969
1970
1971 ##################################################
1972 #     Search for an Exim binary to test          #
1973 ##################################################
1974
1975 # If an Exim binary hasn't been provided, try to find one. We can handle the
1976 # case where exim-testsuite is installed alongside Exim source directories. For
1977 # PH's private convenience, if there's a directory just called "exim4", that
1978 # takes precedence; otherwise exim-snapshot takes precedence over any numbered
1979 # releases.
1980
1981 if ($parm_exim eq "")
1982   {
1983   my($use_srcdir) = "";
1984
1985   opendir DIR, ".." || die "** Failed to opendir \"..\": $!\n";
1986   while ($f = readdir(DIR))
1987     {
1988     my($srcdir);
1989
1990     # Try this directory if it is "exim4" or if it is exim-snapshot or exim-n.m
1991     # possibly followed by -RCx where n.m is greater than any previously tried
1992     # directory. Thus, we should choose the highest version of Exim that has
1993     # been compiled.
1994
1995     if ($f eq "exim4" || $f eq "exim-snapshot")
1996       { $srcdir = $f; }
1997     else
1998       { $srcdir = $f
1999         if ($f =~ /^exim-\d+\.\d+(-RC\d+)?$/ && $f gt $use_srcdir); }
2000
2001     # Look for a build directory with a binary in it. If we find a binary,
2002     # accept this source directory.
2003
2004     if ($srcdir)
2005       {
2006       opendir SRCDIR, "../$srcdir" ||
2007         die "** Failed to opendir \"$cwd/../$srcdir\": $!\n";
2008       while ($f = readdir(SRCDIR))
2009         {
2010         if ($f =~ /^build-/ && -e "../$srcdir/$f/exim")
2011           {
2012           $use_srcdir = $srcdir;
2013           $parm_exim = "$cwd/../$srcdir/$f/exim";
2014           $parm_exim =~ s'/[^/]+/\.\./'/';
2015           last;
2016           }
2017         }
2018       closedir(SRCDIR);
2019       }
2020
2021     # If we have found "exim4" or "exim-snapshot", that takes precedence.
2022     # Otherwise, continue to see if there's a later version.
2023
2024     last if $use_srcdir eq "exim4" || $use_srcdir eq "exim-snapshot";
2025     }
2026   closedir(DIR);
2027   print "Exim binary found in $parm_exim\n" if $parm_exim ne "";
2028   }
2029
2030 # If $parm_exim is still empty, ask the caller
2031
2032 if ($parm_exim eq "")
2033   {
2034   print "** Did not find an Exim binary to test\n";
2035   for ($i = 0; $i < 5; $i++)
2036     {
2037     my($trybin);
2038     print "** Enter pathname for Exim binary: ";
2039     chomp($trybin = <STDIN>);
2040     if (-e $trybin)
2041       {
2042       $parm_exim = $trybin;
2043       last;
2044       }
2045     else
2046       {
2047       print "** $trybin does not exist\n";
2048       }
2049     }
2050   die "** Too many tries\n" if $parm_exim eq "";
2051   }
2052
2053
2054
2055 ##################################################
2056 #          Find what is in the binary            #
2057 ##################################################
2058
2059 # deal with TRUSTED_CONFIG_LIST restrictions
2060 unlink("$parm_cwd/test-config") if -e "$parm_cwd/test-config";
2061 symlink("$parm_cwd/confs/0000", "$parm_cwd/test-config")
2062   or die "Unable to link initial config into place: $!\n";
2063
2064 print("Probing with config file: $parm_cwd/test-config\n");
2065 open(EXIMINFO, "$parm_exim -d -C $parm_cwd/test-config -DDIR=$parm_cwd " .
2066                "-bP exim_user exim_group|") ||
2067   die "** Cannot run $parm_exim: $!\n";
2068 while(<EXIMINFO>)
2069   {
2070   $parm_eximuser = $1 if /^exim_user = (.*)$/;
2071   $parm_eximgroup = $1 if /^exim_group = (.*)$/;
2072   }
2073 close(EXIMINFO);
2074
2075 if (defined $parm_eximuser)
2076   {
2077   if ($parm_eximuser =~ /^\d+$/) { $parm_exim_uid = $parm_eximuser; }
2078     else { $parm_exim_uid = getpwnam($parm_eximuser); }
2079   }
2080 else
2081   {
2082   print "Unable to extract exim_user from binary.\n";
2083   print "Check if Exim refused to run; if so, consider:\n";
2084   print "  TRUSTED_CONFIG_LIST ALT_CONFIG_PREFIX WHITELIST_D_MACROS\n";
2085   die "Failing to get information from binary.\n";
2086   }
2087
2088 if (defined $parm_eximgroup)
2089   {
2090   if ($parm_eximgroup =~ /^\d+$/) { $parm_exim_gid = $parm_eximgroup; }
2091     else { $parm_exim_gid = getgrnam($parm_eximgroup); }
2092   }
2093
2094 open(EXIMINFO, "$parm_exim -bV -C $parm_cwd/test-config -DDIR=$parm_cwd |") ||
2095   die "** Cannot run $parm_exim: $!\n";
2096
2097 print "-" x 78, "\n";
2098
2099 while (<EXIMINFO>)
2100   {
2101   my(@temp);
2102
2103   if (/^Exim version/) { print; }
2104
2105   elsif (/^Size of off_t: (\d+)/)
2106     {
2107     print;
2108     $have_largefiles = 1 if $1 > 4;
2109     die "** Size of off_t > 32 which seems improbable, not running tests\n"
2110         if ($1 > 32);
2111     }
2112
2113   elsif (/^Support for: (.*)/)
2114     {
2115     print;
2116     @temp = split /(\s+)/, $1;
2117     push(@temp, ' ');
2118     %parm_support = @temp;
2119     }
2120
2121   elsif (/^Lookups \(built-in\): (.*)/)
2122     {
2123     print;
2124     @temp = split /(\s+)/, $1;
2125     push(@temp, ' ');
2126     %parm_lookups = @temp;
2127     }
2128
2129   elsif (/^Authenticators: (.*)/)
2130     {
2131     print;
2132     @temp = split /(\s+)/, $1;
2133     push(@temp, ' ');
2134     %parm_authenticators = @temp;
2135     }
2136
2137   elsif (/^Routers: (.*)/)
2138     {
2139     print;
2140     @temp = split /(\s+)/, $1;
2141     push(@temp, ' ');
2142     %parm_routers = @temp;
2143     }
2144
2145   # Some transports have options, e.g. appendfile/maildir. For those, ensure
2146   # that the basic transport name is set, and then the name with each of the
2147   # options.
2148
2149   elsif (/^Transports: (.*)/)
2150     {
2151     print;
2152     @temp = split /(\s+)/, $1;
2153     my($i,$k);
2154     push(@temp, ' ');
2155     %parm_transports = @temp;
2156     foreach $k (keys %parm_transports)
2157       {
2158       if ($k =~ "/")
2159         {
2160         @temp = split /\//, $k;
2161         $parm_transports{"$temp[0]"} = " ";
2162         for ($i = 1; $i < @temp; $i++)
2163           { $parm_transports{"$temp[0]/$temp[$i]"} = " "; }
2164         }
2165       }
2166     }
2167   }
2168 close(EXIMINFO);
2169 print "-" x 78, "\n";
2170
2171 unlink("$parm_cwd/test-config");
2172
2173 ##################################################
2174 #    Check for SpamAssassin and ClamAV           #
2175 ##################################################
2176
2177 # These are crude tests. If they aren't good enough, we'll have to improve
2178 # them, for example by actually passing a message through spamc or clamscan.
2179
2180 if (defined $parm_support{'Content_Scanning'})
2181   {
2182   if (system("spamc -h 2>/dev/null >/dev/null") == 0)
2183     {
2184     print "The spamc command works:\n";
2185
2186     # This test for an active SpamAssassin is courtesy of John Jetmore.
2187     # The tests are hard coded to localhost:783, so no point in making
2188     # this test flexible like the clamav test until the test scripts are
2189     # changed.  spamd doesn't have the nice PING/PONG protoccol that
2190     # clamd does, but it does respond to errors in an informative manner,
2191     # so use that.
2192
2193     my($sint,$sport) = ('127.0.0.1',783);
2194     eval
2195       {
2196       my $sin = sockaddr_in($sport, inet_aton($sint))
2197           or die "** Failed packing $sint:$sport\n";
2198       socket(SOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
2199           or die "** Unable to open socket $sint:$sport\n";
2200
2201       local $SIG{ALRM} =
2202           sub { die "** Timeout while connecting to socket $sint:$sport\n"; };
2203       alarm(5);
2204       connect(SOCK, $sin)
2205           or die "** Unable to connect to socket $sint:$sport\n";
2206       alarm(0);
2207
2208       select((select(SOCK), $| = 1)[0]);
2209       print SOCK "bad command\r\n";
2210
2211       $SIG{ALRM} =
2212           sub { die "** Timeout while reading from socket $sint:$sport\n"; };
2213       alarm(10);
2214       my $res = <SOCK>;
2215       alarm(0);
2216
2217       $res =~ m|^SPAMD/|
2218           or die "** Did not get SPAMD from socket $sint:$sport. "
2219                 ."It said: $res\n";
2220       };
2221     alarm(0);
2222     if($@)
2223       {
2224       print "  $@";
2225       print "  Assume SpamAssassin (spamd) is not running\n";
2226       }
2227     else
2228       {
2229       $parm_running{'SpamAssassin'} = ' ';
2230       print "  SpamAssassin (spamd) seems to be running\n";
2231       }
2232     }
2233   else
2234     {
2235     print "The spamc command failed: assume SpamAssassin (spamd) is not running\n";
2236     }
2237
2238   # For ClamAV, we need to find the clamd socket for use in the Exim
2239   # configuration. Search for the clamd configuration file.
2240
2241   if (system("clamscan -h 2>/dev/null >/dev/null") == 0)
2242     {
2243     my($f, $clamconf, $test_prefix);
2244
2245     print "The clamscan command works";
2246
2247     $test_prefix = $ENV{EXIM_TEST_PREFIX};
2248     $test_prefix = "" if !defined $test_prefix;
2249
2250     foreach $f ("$test_prefix/etc/clamd.conf",
2251                 "$test_prefix/usr/local/etc/clamd.conf",
2252                 "$test_prefix/etc/clamav/clamd.conf", "")
2253       {
2254       if (-e $f)
2255         {
2256         $clamconf = $f;
2257         last;
2258         }
2259       }
2260
2261     # Read the ClamAV configuration file and find the socket interface.
2262
2263     if ($clamconf ne "")
2264       {
2265       my $socket_domain;
2266       open(IN, "$clamconf") || die "\n** Unable to open $clamconf: $!\n";
2267       while (<IN>)
2268         {
2269         if (/^LocalSocket\s+(.*)/)
2270           {
2271           $parm_clamsocket = $1;
2272           $socket_domain = AF_UNIX;
2273           last;
2274           }
2275         if (/^TCPSocket\s+(\d+)/)
2276           {
2277           if (defined $parm_clamsocket)
2278             {
2279             $parm_clamsocket .= " $1";
2280             $socket_domain = AF_INET;
2281             last;
2282             }
2283           else
2284             {
2285             $parm_clamsocket = " $1";
2286             }
2287           }
2288         elsif (/^TCPAddr\s+(\S+)/)
2289           {
2290           if (defined $parm_clamsocket)
2291             {
2292             $parm_clamsocket = $1 . $parm_clamsocket;
2293             $socket_domain = AF_INET;
2294             last;
2295             }
2296           else
2297             {
2298             $parm_clamsocket = $1;
2299             }
2300           }
2301         }
2302       close(IN);
2303
2304       if (defined $socket_domain)
2305         {
2306         print ":\n  The clamd socket is $parm_clamsocket\n";
2307         # This test for an active ClamAV is courtesy of Daniel Tiefnig.
2308         eval
2309           {
2310           my $socket;
2311           if ($socket_domain == AF_UNIX)
2312             {
2313             $socket = sockaddr_un($parm_clamsocket) or die "** Failed packing '$parm_clamsocket'\n";
2314             }
2315           elsif ($socket_domain == AF_INET)
2316             {
2317             my ($ca_host, $ca_port) = split(/\s+/,$parm_clamsocket);
2318             my $ca_hostent = gethostbyname($ca_host) or die "** Failed to get raw address for host '$ca_host'\n";
2319             $socket = sockaddr_in($ca_port, $ca_hostent) or die "** Failed packing '$parm_clamsocket'\n";
2320             }
2321           else
2322             {
2323             die "** Unknown socket domain '$socket_domain' (should not happen)\n";
2324             }
2325           socket(SOCK, $socket_domain, SOCK_STREAM, 0) or die "** Unable to open socket '$parm_clamsocket'\n";
2326           local $SIG{ALRM} = sub { die "** Timeout while connecting to socket '$parm_clamsocket'\n"; };
2327           alarm(5);
2328           connect(SOCK, $socket) or die "** Unable to connect to socket '$parm_clamsocket'\n";
2329           alarm(0);
2330
2331           my $ofh = select SOCK; $| = 1; select $ofh;
2332           print SOCK "PING\n";
2333
2334           $SIG{ALRM} = sub { die "** Timeout while reading from socket '$parm_clamsocket'\n"; };
2335           alarm(10);
2336           my $res = <SOCK>;
2337           alarm(0);
2338
2339           $res =~ /PONG/ or die "** Did not get PONG from socket '$parm_clamsocket'. It said: $res\n";
2340           };
2341         alarm(0);
2342
2343         if($@)
2344           {
2345           print "  $@";
2346           print "  Assume ClamAV is not running\n";
2347           }
2348         else
2349           {
2350           $parm_running{'ClamAV'} = ' ';
2351           print "  ClamAV seems to be running\n";
2352           }
2353         }
2354       else
2355         {
2356         print ", but the socket for clamd could not be determined\n";
2357         print "Assume ClamAV is not running\n";
2358         }
2359       }
2360
2361     else
2362       {
2363       print ", but I can't find a configuration for clamd\n";
2364       print "Assume ClamAV is not running\n";
2365       }
2366     }
2367   }
2368
2369
2370 ##################################################
2371 #         Test for the basic requirements        #
2372 ##################################################
2373
2374 # This test suite assumes that Exim has been built with at least the "usual"
2375 # set of routers, transports, and lookups. Ensure that this is so.
2376
2377 $missing = "";
2378
2379 $missing .= "     Lookup: lsearch\n" if (!defined $parm_lookups{'lsearch'});
2380
2381 $missing .= "     Router: accept\n" if (!defined $parm_routers{'accept'});
2382 $missing .= "     Router: dnslookup\n" if (!defined $parm_routers{'dnslookup'});
2383 $missing .= "     Router: manualroute\n" if (!defined $parm_routers{'manualroute'});
2384 $missing .= "     Router: redirect\n" if (!defined $parm_routers{'redirect'});
2385
2386 $missing .= "     Transport: appendfile\n" if (!defined $parm_transports{'appendfile'});
2387 $missing .= "     Transport: autoreply\n" if (!defined $parm_transports{'autoreply'});
2388 $missing .= "     Transport: pipe\n" if (!defined $parm_transports{'pipe'});
2389 $missing .= "     Transport: smtp\n" if (!defined $parm_transports{'smtp'});
2390
2391 if ($missing ne "")
2392   {
2393   print "\n";
2394   print "** Many features can be included or excluded from Exim binaries.\n";
2395   print "** This test suite requires that Exim is built to contain a certain\n";
2396   print "** set of basic facilities. It seems that some of these are missing\n";
2397   print "** from the binary that is under test, so the test cannot proceed.\n";
2398   print "** The missing facilities are:\n";
2399   print "$missing";
2400   die "** Test script abandoned\n";
2401   }
2402
2403
2404 ##################################################
2405 #      Check for the auxiliary programs          #
2406 ##################################################
2407
2408 # These are always required:
2409
2410 for $prog ("cf", "checkaccess", "client", "client-ssl", "client-gnutls",
2411            "fakens", "iefbr14", "server")
2412   {
2413   next if ($prog eq "client-ssl" && !defined $parm_support{'OpenSSL'});
2414   next if ($prog eq "client-gnutls" && !defined $parm_support{'GnuTLS'});
2415   if (!-e "bin/$prog")
2416     {
2417     print "\n";
2418     print "** bin/$prog does not exist. Have you run ./configure and make?\n";
2419     die "** Test script abandoned\n";
2420     }
2421   }
2422
2423 # If the "loaded" binary is missing, we cut out tests for ${dlfunc. It isn't
2424 # compiled on systems where we don't know how to. However, if Exim does not
2425 # have that functionality compiled, we needn't bother.
2426
2427 $dlfunc_deleted = 0;
2428 if (defined $parm_support{'Expand_dlfunc'} && !-e "bin/loaded")
2429   {
2430   delete $parm_support{'Expand_dlfunc'};
2431   $dlfunc_deleted = 1;
2432   }
2433
2434
2435 ##################################################
2436 #          Find environmental details            #
2437 ##################################################
2438
2439 # Find the caller of this program.
2440
2441 ($parm_caller,$pwpw,$parm_caller_uid,$parm_caller_gid,$pwquota,$pwcomm,
2442  $parm_caller_gecos, $parm_caller_home) = getpwuid($>);
2443
2444 $pwpw = $pwpw;       # Kill Perl warnings
2445 $pwquota = $pwquota;
2446 $pwcomm = $pwcomm;
2447
2448 $parm_caller_group = getgrgid($parm_caller_gid);
2449
2450 print "Program caller is $parm_caller, whose group is $parm_caller_group\n";
2451 print "Home directory is $parm_caller_home\n";
2452
2453 unless (defined $parm_eximgroup)
2454   {
2455   print "Unable to derive \$parm_eximgroup.\n";
2456   die "** ABANDONING.\n";
2457   }
2458
2459 print "You need to be in the Exim group to run these tests. Checking ...";
2460
2461 if (`groups` =~ /\b\Q$parm_eximgroup\E\b/)
2462   {
2463   print " OK\n";
2464   }
2465 else
2466   {
2467   print "\nOh dear, you are not in the Exim group.\n";
2468   die "** Testing abandoned.\n";
2469   }
2470
2471 # Find this host's IP addresses - there may be many, of course, but we keep
2472 # one of each type (IPv4 and IPv6).
2473
2474 $parm_ipv4 = "";
2475 $parm_ipv6 = "";
2476
2477 $local_ipv4 = "";
2478 $local_ipv6 = "";
2479
2480 open(IFCONFIG, "ifconfig -a|") || die "** Cannot run \"ifconfig\": $!\n";
2481 while (($parm_ipv4 eq "" || $parm_ipv6 eq "") && ($_ = <IFCONFIG>))
2482   {
2483   my($ip);
2484   if ($parm_ipv4 eq "" &&
2485       $_ =~ /^\s*inet(?:\saddr)?:?\s?(\d+\.\d+\.\d+\.\d+)\s/i)
2486     {
2487     $ip = $1;
2488     next if ($ip eq "127.0.0.1");
2489     $parm_ipv4 = $ip;
2490     }
2491
2492   if ($parm_ipv6 eq "" &&
2493       $_ =~ /^\s*inet6(?:\saddr)?:?\s?([abcdef\d:]+)/i)
2494     {
2495     $ip = $1;
2496     next if ($ip eq "::1" || $ip =~ /^fe80/i);
2497     $parm_ipv6 = $ip;
2498     }
2499   }
2500 close(IFCONFIG);
2501
2502 # Use private IP addresses if there are no public ones.
2503
2504 $parm_ipv4 = $local_ipv4 if ($parm_ipv4 eq "");
2505 $parm_ipv6 = $local_ipv6 if ($parm_ipv6 eq "");
2506
2507 # If either type of IP address is missing, we need to set the value to
2508 # something other than empty, because that wrecks the substitutions. The value
2509 # is reflected, so use a meaningful string. Set appropriate options for the
2510 # "server" command. In practice, however, many tests assume 127.0.0.1 is
2511 # available, so things will go wrong if there is no IPv4 address. The lack
2512 # of IPV4 or IPv6 can be simulated by command options, which force $have_ipv4
2513 # and $have_ipv6 false.
2514
2515 if ($parm_ipv4 eq "")
2516   {
2517   $have_ipv4 = 0;
2518   $parm_ipv4 = "<no IPv4 address found>";
2519   $server_opts .= " -noipv4";
2520   }
2521 elsif ($have_ipv4 == 0)
2522   {
2523   $parm_ipv4 = "<IPv4 testing disabled>";
2524   $server_opts .= " -noipv4";
2525   }
2526 else
2527   {
2528   $parm_running{"IPv4"} = " ";
2529   }
2530
2531 if ($parm_ipv6 eq "")
2532   {
2533   $have_ipv6 = 0;
2534   $parm_ipv6 = "<no IPv6 address found>";
2535   $server_opts .= " -noipv6";
2536   delete($parm_support{"IPv6"});
2537   }
2538 elsif ($have_ipv6 == 0)
2539   {
2540   $parm_ipv6 = "<IPv6 testing disabled>";
2541   $server_opts .= " -noipv6";
2542   delete($parm_support{"IPv6"});
2543   }
2544 elsif (!defined $parm_support{'IPv6'})
2545   {
2546   $have_ipv6 = 0;
2547   $parm_ipv6 = "<no IPv6 support in Exim binary>";
2548   $server_opts .= " -noipv6";
2549   }
2550 else
2551   {
2552   $parm_running{"IPv6"} = " ";
2553   }
2554
2555 print "IPv4 address is $parm_ipv4\n";
2556 print "IPv6 address is $parm_ipv6\n";
2557
2558 # For munging test output, we need the reversed IP addresses.
2559
2560 $parm_ipv4r = ($parm_ipv4 !~ /^\d/)? "" :
2561   join(".", reverse(split /\./, $parm_ipv4));
2562
2563 $parm_ipv6r = $parm_ipv6;             # Appropriate if not in use
2564 if ($parm_ipv6 =~ /^[\da-f]/)
2565   {
2566   my(@comps) = split /:/, $parm_ipv6;
2567   my(@nibbles);
2568   foreach $comp (@comps)
2569     {
2570     push @nibbles, sprintf("%lx", hex($comp) >> 8);
2571     push @nibbles, sprintf("%lx", hex($comp) & 0xff);
2572     }
2573   $parm_ipv6r = join(".", reverse(@nibbles));
2574   }
2575
2576 # Find the host name, fully qualified.
2577
2578 chomp($temp = `hostname`);
2579 $parm_hostname = (gethostbyname($temp))[0];
2580 $parm_hostname = "no.host.name.found" if $parm_hostname eq "";
2581 print "Hostname is $parm_hostname\n";
2582
2583 if ($parm_hostname !~ /\./)
2584   {
2585   print "\n*** Host name is not fully qualified: this may cause problems ***\n\n";
2586   }
2587
2588 # Find the user's shell
2589
2590 $parm_shell = $ENV{'SHELL'};
2591
2592
2593 ##################################################
2594 #     Create a testing version of Exim           #
2595 ##################################################
2596
2597 # We want to be able to run Exim with a variety of configurations. Normally,
2598 # the use of -C to change configuration causes Exim to give up its root
2599 # privilege (unless the caller is exim or root). For these tests, we do not
2600 # want this to happen. Also, we want Exim to know that it is running in its
2601 # test harness.
2602
2603 # We achieve this by copying the binary and patching it as we go. The new
2604 # binary knows it is a testing copy, and it allows -C and -D without loss of
2605 # privilege. Clearly, this file is dangerous to have lying around on systems
2606 # where there are general users with login accounts. To protect against this,
2607 # we put the new binary in a special directory that is accessible only to the
2608 # caller of this script, who is known to have sudo root privilege from the test
2609 # that was done above. Furthermore, we ensure that the binary is deleted at the
2610 # end of the test. First ensure the directory exists.
2611
2612 if (-d "eximdir")
2613   { unlink "eximdir/exim"; }     # Just in case
2614 else
2615   {
2616   mkdir("eximdir", 0710) || die "** Unable to mkdir $parm_cwd/eximdir: $!\n";
2617   system("sudo chgrp $parm_eximgroup eximdir");
2618   }
2619
2620 # The construction of the patched binary must be done as root, so we use
2621 # a separate script. As well as indicating that this is a test-harness binary,
2622 # the version number is patched to "x.yz" so that its length is always the
2623 # same. Otherwise, when it appears in Received: headers, it affects the length
2624 # of the message, which breaks certain comparisons.
2625
2626 die "** Unable to make patched exim: $!\n"
2627   if (system("sudo ./patchexim $parm_exim") != 0);
2628
2629 # From this point on, exits from the program must go via the subroutine
2630 # tests_exit(), so that suitable cleaning up can be done when required.
2631 # Arrange to catch interrupting signals, to assist with this.
2632
2633 $SIG{'INT'} = \&inthandler;
2634 $SIG{'PIPE'} = \&pipehandler;
2635
2636 # For some tests, we need another copy of the binary that is setuid exim rather
2637 # than root.
2638
2639 system("sudo cp eximdir/exim eximdir/exim_exim;" .
2640        "sudo chown $parm_eximuser eximdir/exim_exim;" .
2641        "sudo chgrp $parm_eximgroup eximdir/exim_exim;" .
2642        "sudo chmod 06755 eximdir/exim_exim");
2643
2644
2645 ##################################################
2646 #     Make copies of utilities we might need     #
2647 ##################################################
2648
2649 # Certain of the tests make use of some of Exim's utilities. We do not need
2650 # to be root to copy these.
2651
2652 ($parm_exim_dir) = $parm_exim =~ ?^(.*)/exim?;
2653
2654 $dbm_build_deleted = 0;
2655 if (defined $parm_lookups{'dbm'} &&
2656     system("cp $parm_exim_dir/exim_dbmbuild eximdir") != 0)
2657   {
2658   delete $parm_lookups{'dbm'};
2659   $dbm_build_deleted = 1;
2660   }
2661
2662 if (system("cp $parm_exim_dir/exim_dumpdb eximdir") != 0)
2663   {
2664   tests_exit(-1, "Failed to make a copy of exim_dumpdb: $!");
2665   }
2666
2667 if (system("cp $parm_exim_dir/exim_lock eximdir") != 0)
2668   {
2669   tests_exit(-1, "Failed to make a copy of exim_lock: $!");
2670   }
2671
2672 if (system("cp $parm_exim_dir/exinext eximdir") != 0)
2673   {
2674   tests_exit(-1, "Failed to make a copy of exinext: $!");
2675   }
2676
2677 if (system("cp $parm_exim_dir/exigrep eximdir") != 0)
2678   {
2679   tests_exit(-1, "Failed to make a copy of exigrep: $!");
2680   }
2681
2682 if (system("cp $parm_exim_dir/eximstats eximdir") != 0)
2683   {
2684   tests_exit(-1, "Failed to make a copy of eximstats: $!");
2685   }
2686
2687
2688 ##################################################
2689 #    Check that the Exim user can access stuff   #
2690 ##################################################
2691
2692 # We delay this test till here so that we can check access to the actual test
2693 # binary. This will be needed when Exim re-exec's itself to do deliveries.
2694
2695 print "Exim user is $parm_eximuser ($parm_exim_uid)\n";
2696 print "Exim group is $parm_eximgroup ($parm_exim_gid)\n";
2697
2698 if ($parm_caller_uid eq $parm_exim_uid) {
2699   tests_exit(-1, "Exim user ($parm_eximuser,$parm_exim_uid) cannot be "
2700                 ."the same as caller ($parm_caller,$parm_caller_uid)");
2701 }
2702
2703 print "The Exim user needs access to the test suite directory. Checking ...";
2704
2705 if (($rc = system("sudo bin/checkaccess $parm_cwd/eximdir/exim $parm_eximuser $parm_eximgroup")) != 0)
2706   {
2707   my($why) = "unknown failure $rc";
2708   $rc >>= 8;
2709   $why = "Couldn't find user \"$parm_eximuser\"" if $rc == 1;
2710   $why = "Couldn't find group \"$parm_eximgroup\"" if $rc == 2;
2711   $why = "Couldn't read auxiliary group list" if $rc == 3;
2712   $why = "Couldn't get rid of auxiliary groups" if $rc == 4;
2713   $why = "Couldn't set gid" if $rc == 5;
2714   $why = "Couldn't set uid" if $rc == 6;
2715   $why = "Couldn't open \"$parm_cwd/eximdir/exim\"" if $rc == 7;
2716   print "\n** $why\n";
2717   tests_exit(-1, "$parm_eximuser cannot access the test suite directory");
2718   }
2719 else
2720   {
2721   print " OK\n";
2722   }
2723
2724
2725 ##################################################
2726 #        Create a list of available tests        #
2727 ##################################################
2728
2729 # The scripts directory contains a number of subdirectories whose names are
2730 # of the form 0000-xxxx, 1100-xxxx, 2000-xxxx, etc. Each set of tests apart
2731 # from the first requires certain optional features to be included in the Exim
2732 # binary. These requirements are contained in a file called "REQUIRES" within
2733 # the directory. We scan all these tests, discarding those that cannot be run
2734 # because the current binary does not support the right facilities, and also
2735 # those that are outside the numerical range selected.
2736
2737 print "\nTest range is $test_start to $test_end\n";
2738 print "Omitting \${dlfunc expansion tests (loadable module not present)\n"
2739   if $dlfunc_deleted;
2740 print "Omitting dbm tests (unable to copy exim_dbmbuild)\n"
2741   if $dbm_build_deleted;
2742
2743 opendir(DIR, "scripts") || tests_exit(-1, "Failed to opendir(\"scripts\"): $!");
2744 @test_dirs = sort readdir(DIR);
2745 closedir(DIR);
2746
2747 # Remove . and .. and CVS from the list.
2748
2749 for ($i = 0; $i < @test_dirs; $i++)
2750   {
2751   my($d) = $test_dirs[$i];
2752   if ($d eq "." || $d eq ".." || $d eq "CVS")
2753     {
2754     splice @test_dirs, $i, 1;
2755     $i--;
2756     }
2757   }
2758
2759 # Scan for relevant tests
2760
2761 for ($i = 0; $i < @test_dirs; $i++)
2762   {
2763   my($testdir) = $test_dirs[$i];
2764   my($wantthis) = 1;
2765
2766   print ">>Checking $testdir\n" if $debug;
2767
2768   # Skip this directory if the first test is equal or greater than the first
2769   # test in the next directory.
2770
2771   next if ($i < @test_dirs - 1) &&
2772           ($test_start >= substr($test_dirs[$i+1], 0, 4));
2773
2774   # No need to carry on if the end test is less than the first test in this
2775   # subdirectory.
2776
2777   last if $test_end < substr($testdir, 0, 4);
2778
2779   # Check requirements, if any.
2780
2781   if (open(REQUIRES, "scripts/$testdir/REQUIRES"))
2782     {
2783     while (<REQUIRES>)
2784       {
2785       next if /^\s*$/;
2786       s/\s+$//;
2787       if (/^support (.*)$/)
2788         {
2789         if (!defined $parm_support{$1}) { $wantthis = 0; last; }
2790         }
2791       elsif (/^running (.*)$/)
2792         {
2793         if (!defined $parm_running{$1}) { $wantthis = 0; last; }
2794         }
2795       elsif (/^lookup (.*)$/)
2796         {
2797         if (!defined $parm_lookups{$1}) { $wantthis = 0; last; }
2798         }
2799       elsif (/^authenticators? (.*)$/)
2800         {
2801         if (!defined $parm_authenticators{$1}) { $wantthis = 0; last; }
2802         }
2803       elsif (/^router (.*)$/)
2804         {
2805         if (!defined $parm_routers{$1}) { $wantthis = 0; last; }
2806         }
2807       elsif (/^transport (.*)$/)
2808         {
2809         if (!defined $parm_transports{$1}) { $wantthis = 0; last; }
2810         }
2811       else
2812         {
2813         tests_exit(-1, "Unknown line in \"scripts/$testdir/REQUIRES\": \"$_\"");
2814         }
2815       }
2816     close(REQUIRES);
2817     }
2818   else
2819     {
2820     tests_exit(-1, "Failed to open \"scripts/$testdir/REQUIRES\": $!")
2821       unless $!{ENOENT};
2822     }
2823
2824   # Loop if we do not want the tests in this subdirectory.
2825
2826   if (!$wantthis)
2827     {
2828     chomp;
2829     print "Omitting tests in $testdir (missing $_)\n";
2830     next;
2831     }
2832
2833   # We want the tests from this subdirectory, provided they are in the
2834   # range that was selected.
2835
2836   opendir(SUBDIR, "scripts/$testdir") ||
2837     tests_exit(-1, "Failed to opendir(\"scripts/$testdir\"): $!");
2838   @testlist = sort readdir(SUBDIR);
2839   close(SUBDIR);
2840
2841   foreach $test (@testlist)
2842     {
2843     next if $test !~ /^\d{4}$/;
2844     next if $test < $test_start || $test > $test_end;
2845     push @test_list, "$testdir/$test";
2846     }
2847   }
2848
2849 print ">>Test List: @test_list\n", if $debug;
2850
2851
2852 ##################################################
2853 #         Munge variable auxiliary data          #
2854 ##################################################
2855
2856 # Some of the auxiliary data files have to refer to the current testing
2857 # directory and other parameter data. The generic versions of these files are
2858 # stored in the aux-var-src directory. At this point, we copy each of them
2859 # to the aux-var directory, making appropriate substitutions. There aren't very
2860 # many of them, so it's easiest just to do this every time. Ensure the mode
2861 # is standardized, as this path is used as a test for the ${stat: expansion.
2862
2863 # A similar job has to be done for the files in the dnszones-src directory, to
2864 # make the fake DNS zones for testing. Most of the zone files are copied to
2865 # files of the same name, but db.ipv4.V4NET and db.ipv6.V6NET use the testing
2866 # networks that are defined by parameter.
2867
2868 foreach $basedir ("aux-var", "dnszones")
2869   {
2870   system("sudo rm -rf $parm_cwd/$basedir");
2871   mkdir("$parm_cwd/$basedir", 0777);
2872   chmod(0755, "$parm_cwd/$basedir");
2873
2874   opendir(AUX, "$parm_cwd/$basedir-src") ||
2875     tests_exit(-1, "Failed to opendir $parm_cwd/$basedir-src: $!");
2876   my(@filelist) = readdir(AUX);
2877   close(AUX);
2878
2879   foreach $file (@filelist)
2880     {
2881     my($outfile) = $file;
2882     next if $file =~ /^\./;
2883
2884     if ($file eq "db.ip4.V4NET")
2885       {
2886       $outfile = "db.ip4.$parm_ipv4_test_net";
2887       }
2888     elsif ($file eq "db.ip6.V6NET")
2889       {
2890       my(@nibbles) = reverse(split /\s*/, $parm_ipv6_test_net);
2891       $" = '.';
2892       $outfile = "db.ip6.@nibbles";
2893       $" = ' ';
2894       }
2895
2896     print ">>Copying $basedir-src/$file to $basedir/$outfile\n" if $debug;
2897     open(IN, "$parm_cwd/$basedir-src/$file") ||
2898       tests_exit(-1, "Failed to open $parm_cwd/$basedir-src/$file: $!");
2899     open(OUT, ">$parm_cwd/$basedir/$outfile") ||
2900       tests_exit(-1, "Failed to open $parm_cwd/$basedir/$outfile: $!");
2901     while (<IN>)
2902       {
2903       do_substitute(0);
2904       print OUT;
2905       }
2906     close(IN);
2907     close(OUT);
2908     }
2909   }
2910
2911
2912 ##################################################
2913 #     Create fake DNS zones for this host        #
2914 ##################################################
2915
2916 # There are fixed zone files for 127.0.0.1 and ::1, but we also want to be
2917 # sure that there are forward and reverse registrations for this host, using
2918 # its real IP addresses. Dynamically created zone files achieve this.
2919
2920 if ($have_ipv4 || $have_ipv6)
2921   {
2922   my($shortname,$domain) = $parm_hostname =~ /^([^.]+)(.*)/;
2923   open(OUT, ">$parm_cwd/dnszones/db$domain") ||
2924     tests_exit(-1, "Failed to open $parm_cwd/dnszones/db$domain: $!");
2925   print OUT "; This is a dynamically constructed fake zone file.\n" .
2926     "; The following line causes fakens to return PASS_ON\n" .
2927     "; for queries that it cannot answer\n\n" .
2928     "PASS ON NOT FOUND\n\n";
2929   print OUT "$shortname  A     $parm_ipv4\n" if $have_ipv4;
2930   print OUT "$shortname  AAAA  $parm_ipv6\n" if $have_ipv6;
2931   print OUT "\n; End\n";
2932   close(OUT);
2933   }
2934
2935 if ($have_ipv4 && $parm_ipv4 ne "127.0.0.1")
2936   {
2937   my(@components) = $parm_ipv4 =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)/;
2938   open(OUT, ">$parm_cwd/dnszones/db.ip4.$components[0]") ||
2939     tests_exit(-1,
2940       "Failed  to open $parm_cwd/dnszones/db.ip4.$components[0]: $!");
2941   print OUT "; This is a dynamically constructed fake zone file.\n" .
2942     "; The zone is $components[0].in-addr.arpa.\n\n" .
2943     "$components[3].$components[2].$components[1]  PTR  $parm_hostname.\n\n" .
2944     "; End\n";
2945   close(OUT);
2946   }
2947
2948 if ($have_ipv6 && $parm_ipv6 ne "::1")
2949   {
2950   my(@components) = split /:/, $parm_ipv6;
2951   my(@nibbles) = reverse (split /\s*/, shift @components);
2952   my($sep) =  "";
2953
2954   $" = ".";
2955   open(OUT, ">$parm_cwd/dnszones/db.ip6.@nibbles") ||
2956     tests_exit(-1,
2957       "Failed  to open $parm_cwd/dnszones/db.ip6.@nibbles: $!");
2958   print OUT "; This is a dynamically constructed fake zone file.\n" .
2959     "; The zone is @nibbles.ip6.arpa.\n\n";
2960
2961   @components = reverse @components;
2962   foreach $c (@components)
2963     {
2964     $c = "0$c" until $c =~ /^..../;
2965     @nibbles = reverse(split /\s*/, $c);
2966     print OUT "$sep@nibbles";
2967     $sep = ".";
2968     }
2969
2970   print OUT "  PTR  $parm_hostname.\n\n; End\n";
2971   close(OUT);
2972   $" = " ";
2973   }
2974
2975
2976
2977 ##################################################
2978 #    Create lists of mailboxes and message logs  #
2979 ##################################################
2980
2981 # We use these lists to check that a test has created the expected files. It
2982 # should be faster than looking for the file each time. For mailboxes, we have
2983 # to scan a complete subtree, in order to handle maildirs. For msglogs, there
2984 # is just a flat list of files.
2985
2986 @oldmails = list_files_below("mail");
2987 opendir(DIR, "msglog") || tests_exit(-1, "Failed to opendir msglog: $!");
2988 @oldmsglogs = readdir(DIR);
2989 closedir(DIR);
2990
2991
2992
2993 ##################################################
2994 #         Run the required tests                 #
2995 ##################################################
2996
2997 # Each test script contains a number of tests, separated by a line that
2998 # contains ****. We open input from the terminal so that we can read responses
2999 # to prompts.
3000
3001 open(T, "/dev/tty") || tests_exit(-1, "Failed to open /dev/tty: $!");
3002
3003 print "\nPress RETURN to run the tests: ";
3004 $_ = <T>;
3005 print "\n";
3006
3007 $lasttestdir = "";
3008
3009 foreach $test (@test_list)
3010   {
3011   local($lineno) = 0;
3012   local($commandno) = 0;
3013   local($subtestno) = 0;
3014   local($testno) = substr($test, -4);
3015   local($sortlog) = 0;
3016
3017   my($gnutls) = 0;
3018   my($docheck) = 1;
3019   my($thistestdir) = substr($test, 0, -5);
3020
3021   if ($lasttestdir ne $thistestdir)
3022     {
3023     $gnutls = 0;
3024     if (-s "scripts/$thistestdir/REQUIRES")
3025       {
3026       my($indent) = "";
3027       print "\n>>> The following tests require: ";
3028       open(IN, "scripts/$thistestdir/REQUIRES") ||
3029         tests_exit(-1, "Failed to open scripts/$thistestdir/REQUIRES: $1");
3030       while (<IN>)
3031         {
3032         $gnutls = 1 if /^support GnuTLS/;
3033         print $indent, $_;
3034         $indent = ">>>                              ";
3035         }
3036       close(IN);
3037       }
3038     }
3039   $lasttestdir = $thistestdir;
3040
3041   # Remove any debris in the spool directory and the test-mail directory
3042   # and also the files for collecting stdout and stderr. Then put back
3043   # the test-mail directory for appendfile deliveries.
3044
3045   system "sudo /bin/rm -rf spool test-*";
3046   system "mkdir test-mail 2>/dev/null";
3047
3048   # A privileged Exim will normally make its own spool directory, but some of
3049   # the tests run in unprivileged modes that don't always work if the spool
3050   # directory isn't already there. What is more, we want anybody to be able
3051   # to read it in order to find the daemon's pid.
3052
3053   system "mkdir spool; " .
3054          "sudo chown $parm_eximuser:$parm_eximgroup spool; " .
3055          "sudo chmod 0755 spool";
3056
3057   # Empty the cache that keeps track of things like message id mappings, and
3058   # set up the initial sequence strings.
3059
3060   undef %cache;
3061   $next_msgid = "aX";
3062   $next_pid = 1234;
3063   $next_port = 1111;
3064   $message_skip = 0;
3065   $msglog_skip = 0;
3066   $stderr_skip = 0;
3067   $stdout_skip = 0;
3068   $rmfiltertest = 0;
3069   $is_ipv6test = 0;
3070
3071   # Remove the associative arrays used to hold checked mail files and msglogs
3072
3073   undef %expected_mails;
3074   undef %expected_msglogs;
3075
3076   # Open the test's script
3077
3078   open(SCRIPT, "scripts/$test") ||
3079     tests_exit(-1, "Failed to open \"scripts/$test\": $!");
3080
3081   # The first line in the script must be a comment that is used to identify
3082   # the set of tests as a whole.
3083
3084   $_ = <SCRIPT>;
3085   $lineno++;
3086   tests_exit(-1, "Missing identifying comment at start of $test") if (!/^#/);
3087   printf("%s %s", (substr $test, 5), (substr $_, 2));
3088
3089   # Loop for each of the subtests within the script. The variable $server_pid
3090   # is used to remember the pid of a "server" process, for which we do not
3091   # wait until we have waited for a subsequent command.
3092
3093   local($server_pid) = 0;
3094   for ($commandno = 1; !eof SCRIPT; $commandno++)
3095     {
3096     # Skip further leading comments and blank lines, handle the flag setting
3097     # commands, and deal with tests for IP support.
3098
3099     while (<SCRIPT>)
3100       {
3101       $lineno++;
3102       if (/^no_message_check/) { $message_skip = 1; next; }
3103       if (/^no_msglog_check/)  { $msglog_skip = 1; next; }
3104       if (/^no_stderr_check/)  { $stderr_skip = 1; next; }
3105       if (/^no_stdout_check/)  { $stdout_skip = 1; next; }
3106       if (/^rmfiltertest/)     { $rmfiltertest = 1; next; }
3107       if (/^sortlog/)          { $sortlog = 1; next; }
3108
3109       if (/^need_largefiles/)
3110         {
3111         next if $have_largefiles;
3112         print ">>> Large file support is needed for test $testno, but is not available: skipping\n";
3113         $docheck = 0;      # don't check output
3114         undef $_;          # pretend EOF
3115         last;
3116         }
3117
3118       if (/^need_ipv4/)
3119         {
3120         next if $have_ipv4;
3121         print ">>> IPv4 is needed for test $testno, but is not available: skipping\n";
3122         $docheck = 0;      # don't check output
3123         undef $_;          # pretend EOF
3124         last;
3125         }
3126
3127       if (/^need_ipv6/)
3128         {
3129         if ($have_ipv6)
3130           {
3131           $is_ipv6test = 1;
3132           next;
3133           }
3134         print ">>> IPv6 is needed for test $testno, but is not available: skipping\n";
3135         $docheck = 0;      # don't check output
3136         undef $_;          # pretend EOF
3137         last;
3138         }
3139
3140       if (/^need_move_frozen_messages/)
3141         {
3142         next if defined $parm_support{"move_frozen_messages"};
3143         print ">>> move frozen message support is needed for test $testno, " .
3144           "but is not\n>>> available: skipping\n";
3145         $docheck = 0;      # don't check output
3146         undef $_;          # pretend EOF
3147         last;
3148         }
3149
3150       last unless /^(#|\s*$)/;
3151       }
3152     last if !defined $_;  # Hit EOF
3153
3154     my($subtest_startline) = $lineno;
3155
3156     # Now run the command. The function returns 0 if exim was run and waited
3157     # for, 1 if any other command was run and waited for, and 2 if a command
3158     # was run and not waited for (usually a daemon or server startup).
3159
3160     my($commandname) = "";
3161     my($expectrc) = 0;
3162     my($rc) = run_command($testno, \$subtestno, \$expectrc, \$commandname);
3163     my($cmdrc) = $?;
3164
3165     print ">> rc=$rc cmdrc=$cmdrc\n" if $debug;
3166
3167     # Hit EOF after an initial return code number
3168
3169     tests_exit(-1, "Unexpected EOF in script") if ($rc == 4);
3170
3171     # Carry on with the next command if we did not wait for this one. $rc == 0
3172     # if no subprocess was run; $rc == 3 if we started a process but did not
3173     # wait for it.
3174
3175     next if ($rc == 0 || $rc == 3);
3176
3177     # We ran and waited for a command. Check for the expected result unless
3178     # it died.
3179
3180     if ($cmdrc != $expectrc && !$sigpipehappened)
3181       {
3182       printf("** Command $commandno (\"$commandname\", starting at line $subtest_startline)\n");
3183       if (($cmdrc & 0xff) == 0)
3184         {
3185         printf("** Return code %d (expected %d)", $cmdrc/256, $expectrc/256);
3186         }
3187       elsif (($cmdrc & 0xff00) == 0)
3188         { printf("** Killed by signal %d", $cmdrc & 255); }
3189       else
3190         { printf("** Status %x", $cmdrc); }
3191
3192       for (;;)
3193         {
3194         print "\nshow stdErr, show stdOut, Continue (without file comparison), or Quit? [Q] ";
3195         $_ = <T>;
3196         tests_exit(1) if /^q?$/i;
3197         last if /^c$/i;
3198         if (/^e$/i)
3199           {
3200           system("$more test-stderr");
3201           }
3202         elsif (/^o$/i)
3203           {
3204           system("$more test-stdout");
3205           }
3206         }
3207
3208       $docheck = 0;
3209       }
3210
3211     # If the command was exim, and a listening server is running, we can now
3212     # close its input, which causes us to wait for it to finish, which is why
3213     # we didn't close it earlier.
3214
3215     if ($rc == 2 && $server_pid != 0)
3216       {
3217       close SERVERCMD;
3218       $server_pid = 0;
3219       if ($? != 0)
3220         {
3221         if (($? & 0xff) == 0)
3222           { printf("Server return code %d", $?/256); }
3223         elsif (($? & 0xff00) == 0)
3224           { printf("Server killed by signal %d", $? & 255); }
3225         else
3226           { printf("Server status %x", $?); }
3227
3228         for (;;)
3229           {
3230           print "\nShow server stdout, Continue, or Quit? [Q] ";
3231           $_ = <T>;
3232           tests_exit(1) if /^q?$/i;
3233           last if /^c$/i;
3234
3235           if (/^s$/i)
3236             {
3237             open(S, "test-stdout-server") ||
3238               tests_exit(-1, "Failed to open test-stdout-server: $!");
3239             print while <S>;
3240             close(S);
3241             }
3242           }
3243         }
3244       }
3245     }
3246
3247   close SCRIPT;
3248
3249   # The script has finished. Check the all the output that was generated. The
3250   # function returns 0 if all is well, 1 if we should rerun the test (the files
3251   # have been updated). It does not return if the user responds Q to a prompt.
3252
3253   if ($docheck)
3254     {
3255     if (check_output() != 0)
3256       {
3257       print (("#" x 79) . "\n");
3258       redo;
3259       }
3260     else
3261       {
3262       print ("  Script completed\n");
3263       }
3264     }
3265   }
3266
3267
3268 ##################################################
3269 #         Exit from the test script              #
3270 ##################################################
3271
3272 tests_exit(-1, "No runnable tests selected") if @test_list == 0;
3273 tests_exit(0);
3274
3275 # End of runtest script
3276 # vim: set sw=2 :