#! /usr/bin/perl -w # $Cambridge: exim/test/runtest,v 1.1 2006/02/06 16:07:10 ph10 Exp $ ############################################################################### # This is the controlling script for the "new" test suite for Exim. It should # # be possible to export this suite for running on a wide variety of hosts, in # # contrast to the old suite, which was very dependent on the environment of # # Philip Hazel's desktop computer. This implementation inspects the version # # of Exim that it finds, and tests only those features that are included. The # # surrounding environment is also tested to discover what is available. See # # the README file for details of how it all works. # # # # Implementation started: 03 August 2005 by Philip Hazel # # Placed in the Exim CVS: 06 February 2006 # ############################################################################### require Cwd; use Errno; use FileHandle; use Socket; # Start by initializing some global variables $testversion = "4.61 (06-Feb-06)"; $cf = "bin/cf"; $cr = "\r"; $debug = 0; $force_update = 0; $more = "less -XF"; $optargs = ""; $save_output = 0; $server_opts = ""; $have_ipv4 = 1; $have_ipv6 = 1; $test_start = 1; $test_end = $test_top = 8999; $test_special_top = 9999; @test_list = (); @test_dirs = (); # Networks to use for DNS tests. We need to choose some networks that will # never be used so that there is no chance that the host on which we are # running is actually in one of the test networks. Private networks such as # the IPv4 10.0.0.0/8 network are no good because hosts may well use them. # Rather than use some unassigned numbers (that might become assigned later), # I have chosen some multicast networks, in the belief that such addresses # won't ever be assigned to hosts. This is the only place where these numbers # are defined, so it is trivially possible to change them should that ever # become necessary. $parm_ipv4_test_net = "224"; $parm_ipv6_test_net = "ff00"; # Port numbers are currently hard-wired $parm_port_n = 1223; # Nothing listening on this port $parm_port_s = 1224; # Used for the "server" command $parm_port_d = 1225; # Used for the Exim daemon $parm_port_d2 = 1226; # Additional for daemon $parm_port_d3 = 1227; # Additional for daemon $parm_port_d4 = 1228; # Additional for daemon ############################################################################### ############################################################################### # Define a number of subroutines ############################################################################### ############################################################################### ################################################## # Handle signals # ################################################## sub pipehandler { $sigpipehappened = 1; } sub inthandler { print "\n"; tests_exit(-1, "Caught SIGINT"); } ################################################## # Do global macro substitutions # ################################################## # This function is applied to configurations, command lines and data lines in # scripts, and to lines in the files of the aux-var-src and the dnszones-src # directory. It takes one argument: the current test number, or zero when # setting up files before running any tests. sub do_substitute{ s?\bCALLER\b?$parm_caller?g; s?\bCALLER_UID\b?$parm_caller_uid?g; s?\bCALLER_GID\b?$parm_caller_gid?g; s?\bCLAMSOCKET\b?$parm_clamsocket?g; s?\bDIR/?$parm_cwd/?g; s?\bEXIMGROUP\b?$parm_eximgroup?g; s?\bEXIMUSER\b?$parm_eximuser?g; s?\bHOSTIPV4\b?$parm_ipv4?g; s?\bHOSTIPV6\b?$parm_ipv6?g; s?\bHOSTNAME\b?$parm_hostname?g; s?\bPORT_D\b?$parm_port_d?g; s?\bPORT_D2\b?$parm_port_d2?g; s?\bPORT_D3\b?$parm_port_d3?g; s?\bPORT_D4\b?$parm_port_d4?g; s?\bPORT_N\b?$parm_port_n?g; s?\bPORT_S\b?$parm_port_s?g; s?\bTESTNUM\b?$_[0]?g; s?(\b|_)V4NET([\._])?$1$parm_ipv4_test_net$2?g; s?\bV6NET:?$parm_ipv6_test_net:?g; } ################################################## # Subroutine to tidy up and exit # ################################################## # In all cases, we check for any Exim daemons that have been left running, and # kill them. Then remove all the spool data, test output, and the modified Exim # binary if we are ending normally. # Arguments: # $_[0] = 0 for a normal exit; full cleanup done # $_[0] > 0 for an error exit; no files cleaned up # $_[0] < 0 for a "die" exit; $_[1] contains a message sub tests_exit{ my($rc) = $_[0]; my($spool); # Search for daemon pid files and kill the daemons. We kill with SIGINT rather # than SIGTERM to stop it outputting "Terminated" to the terminal when not in # the background. if (opendir(DIR, "spool")) { my(@spools) = sort readdir(DIR); closedir(DIR); foreach $spool (@spools) { next if $spool !~ /^exim-daemon./; open(PID, "spool/$spool") || die "** Failed to open \"spool/$spool\": $!\n"; chomp($pid = ); close(PID); print "Tidyup: killing daemon pid=$pid\n"; system("sudo rm -f spool/$spool; sudo kill -SIGINT $pid"); } } else { die "** Failed to opendir(\"spool\"): $!\n" unless $!{ENOENT}; } # Close the terminal input and remove the test files if all went well, unless # the option to save them is set. Always remove the patched Exim binary. Then # exit normally, or die. close(T); system("sudo /bin/rm -rf ./spool test-* ./dnszones/*") if ($rc == 0 && !$save_output); system("sudo /bin/rm -rf ./eximdir/*"); exit $rc if ($rc >= 0); die "** runtest error: $_[1]\n"; } ################################################## # Subroutines used by the munging subroutine # ################################################## # This function is used for things like message ids, where we want to generate # more than one value, but keep a consistent mapping throughout. # # Arguments: # $oldid the value from the file # $base a base string into which we insert a sequence # $sequence the address of the current sequence counter sub new_value { my($oldid, $base, $sequence) = @_; my($newid) = $cache{$oldid}; if (! defined $newid) { $newid = sprintf($base, $$sequence++); $cache{$oldid} = $newid; } return $newid; } # This is used while munging the output from exim_dumpdb. We cheat by assuming # that the date always the same, and just return the number of seconds since # midnight. sub date_seconds { my($day,$month,$year,$hour,$min,$sec) = $_[0] =~ /^(\d\d)-(\w\w\w)-(\d{4})\s(\d\d):(\d\d):(\d\d)/; return $hour * 60 * 60 + $min * 60 + $sec; } # This is a subroutine to sort maildir files into time-order. The second field # is the microsecond field, and may vary in length, so must be compared # numerically. sub maildirsort { return $a cmp $b if ($a !~ /^\d+\.H\d/ || $b !~ /^\d+\.H\d/); my($x1,$y1) = $a =~ /^(\d+)\.H(\d+)/; my($x2,$y2) = $b =~ /^(\d+)\.H(\d+)/; return ($x1 != $x2)? ($x1 <=> $x2) : ($y1 <=> $y2); } ################################################## # Subroutine list files below a directory # ################################################## # This is used to build up a list of expected mail files below a certain path # in the directory tree. It has to be recursive in order to deal with multiple # maildir mailboxes. sub list_files_below { my($dir) = $_[0]; my(@yield) = (); my(@sublist, $file); opendir(DIR, $dir) || tests_exit(-1, "Failed to open $dir: $!"); @sublist = sort maildirsort readdir(DIR); closedir(DIR); foreach $file (@sublist) { next if $file eq "." || $file eq ".." || $file eq "CVS"; if (-d "$dir/$file") { @yield = (@yield, list_files_below("$dir/$file")); } else { push @yield, "$dir/$file"; } } return @yield; } ################################################## # Munge a file before comparing # ################################################## # The pre-processing turns all dates, times, Exim versions, message ids, and so # on into standard values, so that the compare works. Perl's substitution with # an expression provides a neat way to do some of these changes. # We keep a global associative array for repeatedly turning the same values # into the same standard values throughout the data from a single test. # Message ids get this treatment (can't be made reliable for times), and # times in dumped retry databases are also handled in a special way, as are # incoming port numbers. # On entry to the subroutine, the file to write to is already opened with the # name MUNGED. The input file name is the only argument to the subroutine. # Certain actions are taken only when the name contains "stderr", "stdout", # or "log". The yield of the function is 1 if a line matching "*** truncated # ***" is encountered; otherwise it is 0. sub munge { my($file) = $_[0]; my($yield) = 0; my(@saved) = (); open(IN, "$file") || tests_exit(-1, "Failed to open $file: $!"); my($is_log) = $file =~ /log/; my($is_stdout) = $file =~ /stdout/; my($is_stderr) = $file =~ /stderr/; # Date pattern $date = "\\d{2}-\\w{3}-\\d{4}\\s\\d{2}:\\d{2}:\\d{2}"; # Pattern for matching pids at start of stderr lines; initially something # that won't match. $spid = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"; # Scan the file and make the changes. Near the bottom there are some changes # that are specific to certain file types, though there are also some of those # inline too. while() { # Check for "*** truncated ***" $yield = 1 if /\*\*\* truncated \*\*\*/; # Replace the name of this host s/\Q$parm_hostname\E/the.local.host.name/g; # But convert "name=the.local.host address=127.0.0.1" to use "localhost" s/name=the\.local\.host address=127\.0\.0\.1/name=localhost address=127.0.0.1/g; # Replace the path to the testsuite directory s?\Q$parm_cwd\E?TESTSUITE?g; # Replace the Exim version number (may appear in various places) s/Exim \d+\.\d+[\w-]*/Exim x.yz/i; # Replace Exim message ids by a unique series s/((?:[^\W_]{6}-){2}[^\W_]{2}) /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx; # The names of lock files appear in some error and debug messages s/\.lock(\.[-\w]+)+(\.[\da-f]+){2}/.lock.test.ex.dddddddd.pppppppp/; # Unless we are in an IPv6 test, replace IPv4 and/or IPv6 in "listening on # port" message, because it is not always the same. s/port (\d+) \([^)]+\)/port $1/g if !$is_ipv6test && m/listening for SMTP(S?) on port/; # Challenges in SPA authentication s/TlRMTVNTUAACAAAAAAAAAAAoAAABgg[\w+\/]+/TlRMTVNTUAACAAAAAAAAAAAoAAABggAAAEbBRwqFwwIAAAAAAAAAAAAt1sgAAAAA/; # PRVS values s?prvs=([^/]+)/[\da-f]{10}@?prvs=$1/xxxxxxxxxx@?g; # Error lines on stdout from SSL contain process id values and file names. # They also contain a source file name and line number, which may vary from # release to release. s/^\d+:error:/pppp:error:/; s/:(?:\/[^\s:]+\/)?([^\/\s]+\.c):\d+:/:$1:dddd:/; # One error test in expansions mentions base 62 or 36 s/is not a base (36|62) number/is not a base 36\/62 number/; # This message sometimes has a different number of seconds s/forced fail after \d seconds/forced fail after d seconds/; # This message may contain a different DBM library name s/Failed to open \S+( \([^\)]+\))? file/Failed to open DBM file/; # The message for a non-listening FIFO varies s/:[^:]+: while opening named pipe/: Error: while opening named pipe/; # The name of the shell may vary s/\s\Q$parm_shell\E\b/ SHELL/; # Debugging output of lists of hosts may have different sort keys s/sort=\S+/sort=xx/ if /^\S+ (?:\d+\.){3}\d+ mx=\S+ sort=\S+/; # Random local part in callout cache testing s/myhost.test.ex-\d+-testing/myhost.test.ex-dddddddd-testing/; # ======== Dumpdb output ======== # This must be before the general date/date munging. # Time data lines, which look like this: # 25-Aug-2000 12:11:37 25-Aug-2000 12:11:37 26-Aug-2000 12:11:37 if (/^($date)\s+($date)\s+($date)(\s+\*)?\s*$/) { my($date1,$date2,$date3,$expired) = ($1,$2,$3,$4); $expired = "" if !defined $expired; my($increment) = date_seconds($date3) - date_seconds($date2); # We used to use globally unique replacement values, but timing # differences make this impossible. Just show the increment on the # last one. printf MUNGED ("first failed = time last try = time2 next try = time2 + %s%s\n", $increment, $expired); next; } # more_errno values in exim_dumpdb output which are times s/T:(\S+)\s-22\s(\S+)\s/T:$1 -22 xxxx /; # ======== Dates and times ======== # Dates and times are all turned into the same value - trying to turn # them into different ones cannot be done repeatedly because they are # real time stamps generated while running the test. The actual date and # time used was fixed when I first started running automatic Exim tests. # Date/time in header lines and SMTP responses 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} /Tue, 2 Mar 1999 09:44:33 +0000/gx; # Date/time in logs and in one instance of a filter test 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; s/^Logwrite\s"\d{4}-\d\d-\d\d\s\d\d:\d\d:\d\d/Logwrite "1999-03-02 09:44:33/gx; # Date/time in message separators s/(?:[A-Z][a-z]{2}\s){2}\d\d\s\d\d:\d\d:\d\d\s\d\d\d\d /Tue Mar 02 09:44:33 1999/gx; # Date of message arrival in spool file as shown by -Mvh s/^\d{9,10}\s0$/ddddddddd 0/; # Date/time in mbx mailbox files 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; # Date/time in debugging output for writing retry records if (/^ first failed=(\d+) last try=(\d+) next try=(\d+) (.*)$/) { my($next) = $3 - $2; $_ = " first failed=dddd last try=dddd next try=+$next $4\n"; } # Time to retry may vary s/time to retry = -\d+/time to retry = -ddddd/; s/retry record exists: age=\d/retry record exists: age=d/; # Date/time in exim -bV output s/\d\d-[A-Z][a-z]{2}-\d{4}\s\d\d:\d\d:\d\d/07-Mar-2000 12:21:52/g; # ======== Caller's login, uid, gid, home ======== s/\Q$parm_caller_home\E/CALLER_HOME/g; # NOTE: these must be done s/\b\Q$parm_caller\E\b/CALLER/g; # in this order! s/\b\Q$parm_caller_group\E\b/CALLER/g; # In case group name different s/\beuid=$parm_caller_uid\b/euid=CALLER_UID/g; s/\begid=$parm_caller_gid\b/egid=CALLER_GID/g; s/\buid=$parm_caller_uid\b/uid=CALLER_UID/g; s/\bgid=$parm_caller_gid\b/gid=CALLER_GID/g; # When looking at spool files with -Mvh, we will find not only the caller # login, but also the uid and gid. It seems that $) in some Perls gives all # the auxiliary gids as well, so don't bother checking for that. s/^CALLER $> \d+$/CALLER UID GID/; # There is one case where the caller's login is forced to something else, # in order to test the processing of logins that contain spaces. Weird what # some people do, isn't it? s/^spaced user $> \d+$/CALLER UID GID/; # ======== Exim's login ======== # For bounce messages, this will appear on the U= lines in logs and also # after Received: and in addresses. In one pipe test it appears after # "Running as:". It also appears in addresses, and in the names of lock # files. s/U=$parm_eximuser/U=EXIMUSER/; s/user=$parm_eximuser/user=EXIMUSER/; s/login=$parm_eximuser/login=EXIMUSER/; s/Received: from $parm_eximuser /Received: from EXIMUSER /; s/Running as: $parm_eximuser/Running as: EXIMUSER/; s/\b$parm_eximuser@/EXIMUSER@/; s/\b$parm_eximuser\.lock\./EXIMUSER.lock./; s/\beuid=$parm_exim_uid\b/euid=EXIM_UID/g; s/\begid=$parm_exim_gid\b/egid=EXIM_GID/g; s/\buid=$parm_exim_uid\b/uid=EXIM_UID/g; s/\bgid=$parm_exim_gid\b/gid=EXIM_GID/g; # ======== General uids, gids, and pids ======== # Note: this must come after munges for caller's and exim's uid/gid s/\bgid=\d+/gid=gggg/; s/\begid=\d+/egid=gggg/; s/\bpid=\d+/pid=pppp/; s/\buid=\d+/uid=uuuu/; s/\beuid=\d+/euid=uuuu/; s/set_process_info:\s+\d+/set_process_info: pppp/; s/queue run pid \d+/queue run pid ppppp/; s/process \d+ running as transport filter/process pppp running as transport filter/; s/process \d+ writing to transport filter/process pppp writing to transport filter/; s/reading pipe for subprocess \d+/reading pipe for subprocess pppp/; s/remote delivery process \d+ ended/remote delivery process pppp ended/; # Pid in temp file in appendfile transport s"test-mail/temp\.\d+\."test-mail/temp.pppp."; # Detect a daemon stderr line with a pid and save the pid for subsequent # removal from following lines. $spid = $1 if /^(\s*\d+) (?:listening|LOG: MAIN|(?:daemon_smtp_port|local_interfaces) overridden by)/; s/^$spid //; # Queue runner waiting messages s/waiting for children of \d+/waiting for children of pppp/; s/waiting for (\S+) \(\d+\)/waiting for $1 (pppp)/; # ======== Port numbers ======== # Incoming port numbers may vary, but not in daemon startup line. s/^Port: (\d+)/"Port: " . new_value($1, "%s", \$next_port)/e; s/\(port=(\d+)/"(port=" . new_value($1, "%s", \$next_port)/e; # This handles "connection from" and the like, when the port is given if (!/listening for SMTP on/ && !/Connecting to/ && !/=>/ && !/\*>/ && !/Connection refused/) { s/\[([a-z\d:]+|\d+(?:\.\d+){3})\]:(\d+)/"[".$1."]:".new_value($2,"%s",\$next_port)/ie; } # Port in host address in spool file output from -Mvh s/^-host_address (.*)\.\d+/-host_address $1.9999/; # ======== Local IP addresses ======== # The amount of space between "host" and the address in verification output # depends on the length of the host name. We therefore reduce it to one space # for all of them. s/^\s+host\s(\S+)\s+(\S+)/ host $1 $2/; s/^\s+(host\s\S+\s\S+)\s+(port=.*)/ host $1 $2/; s/^\s+(host\s\S+\s\S+)\s+(?=MX=)/ $1 /; s/host\s\Q$parm_ipv4\E\s\[\Q$parm_ipv4\E\]/host ipv4.ipv4.ipv4.ipv4 [ipv4.ipv4.ipv4.ipv4]/; 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]/; s/\b\Q$parm_ipv4\E\b/ip4.ip4.ip4.ip4/g; s/\b\Q$parm_ipv6\E\b/ip6:ip6:ip6:ip6:ip6:ip6:ip6:ip6/g; # ======== Test network IP addresses ======== s/(\b|_)\Q$parm_ipv4_test_net\E(?=\.\d+\.\d+\.\d+\b|_|\.rbl|\.in-addr|\.test\.again\.dns)/$1V4NET/g; s/\b\Q$parm_ipv6_test_net\E(?=:[\da-f]+:[\da-f]+:[\da-f]+)/V6NET/gi; # ======== IP error numbers and messages ======== # These vary between operating systems s/Can't assign requested address/Network Error/; s/Cannot assign requested address/Network Error/; s/Operation timed out/Connection timed out/; s/Address family not supported by protocol family/Network Error/; s/Network is unreachable/Network Error/; s/Invalid argument/Network Error/; s/\(\d+\): Network/(dd): Network/; s/\(\d+\): Connection refused/(dd): Connection refused/; s/\(\d+\): Connection timed out/(dd): Connection timed out/; s/\d+ 65 Connection refused/dd 65 Connection refused/; s/\d+ 321 Connection timed out/dd 321 Connection timed out/; # ======== Other error numbers ======== s/errno=\d+/errno=dd/g; # ======== Output from ls ======== # Different operating systems use different spacing on long output s/ +/ /g if /^[-rwd]{10} /; # ======== Message sizes ========= # Message sizes vary, owing to different logins and host names that get # automatically inserted. I can't think of any way of even approximately # comparing these. s/([\s,])S=\d+\b/$1S=sss/; s/:S\d+\b/:Ssss/; s/^(\s*\d+m\s+)\d+(\s+[a-z0-9-]{16} <)/$1sss$2/i if $is_stdout; s/\sSIZE=\d+\b/ SIZE=ssss/ if $is_stderr || $is_stdout; s/\ssize=\d+\b/ size=sss/ if $is_stderr; s/old size = \d+\b/old size = sssss/; s/message size = \d+\b/message size = sss/; s/this message = \d+\b/this message = sss/; s/Size of headers = \d+/Size of headers = sss/; s/sum=(?!0)\d+/sum=dddd/; s/(?<=sum=dddd )count=(?!0)\d+\b/count=dd/; s/(?<=sum=0 )count=(?!0)\d+\b/count=dd/; s/,S is \d+\b/,S is ddddd/; s/\+0100,\d+;/+0100,ddd;/; s/\(\d+ bytes written\)/(ddd bytes written)/; s/added '\d+ 1'/added 'ddd 1'/; # ======== Values in spool space failure message ======== s/space=\d+ inodes=\d+/space=xxxxx inodes=xxxxx/; # ======== Filter sizes ======== # The sizes of filter files may vary because of the substitution of local # filenames, logins, etc. s/^\d+(?= bytes read from )/ssss/; # ======== OpenSSL error messages ======== # Different releases of the OpenSSL libraries seem to give different error # numbers, or handle specific bad conditions in different ways, leading to # different wording in the error messages, so we cannot compare them. s/(TLS error on connection (?:from|to) .*? \(SSL_\w+\): error:)(.*)/$1 <>/; # ======== Maildir things ======== # timestamp output in maildir processing s/(timestamp=|\(timestamp_only\): )\d+/$1ddddddd/g; # maildir delivery files appearing in log lines (in cases of error) s/writing to(?: file)? tmp\/\d+\.[^.]+\.(\S+)/writing to tmp\/MAILDIR.$1/; s/renamed tmp\/\d+\.[^.]+\.(\S+) as new\/\d+\.[^.]+\.(\S+)/renamed tmp\/MAILDIR.$1 as new\/MAILDIR.$1/; # Maildir file names in general s/\b\d+\.H\d+P\d+\b/dddddddddd.HddddddPddddd/; # Maildirsize data if (/^\d+S,\d+C\s*$/) { print MUNGED "dddS,dC\n"; while () { last if !/^\d+ \d+\s*$/; print MUNGED "ddd d\n"; } last if !defined $_; } # ======== Output from the "fd" program about open descriptors ======== # The statuses seem to be different on different operating systems, but # at least we'll still be checking the number of open fd's. s/max fd = \d+/max fd = dddd/; s/status=0 RDONLY/STATUS/g; s/status=1 WRONLY/STATUS/g; s/status=2 RDWR/STATUS/g; # ======== Contents of spool files ======== # A couple of tests dump the contents of the -H file. The length fields # will be wrong because of different user names, etc. s/^\d\d\d(?=[PFS*])/ddd/; # ========================================================== # Some munging is specific to the specific file types # ======== stdout ======== if ($is_stdout) { # Skip translate_ip_address in -bP output because it ain't always there next if /translate_ip_address =/; # In certain filter tests, remove initial filter lines because they just # clog up by repetition. if ($rmfiltertest) { next if /^(Sender\staken\sfrom| Return-path\scopied\sfrom| Sender\s+=| Recipient\s+=)/x; if (/^Testing \S+ filter/) { $_ = ; # remove blank line next; } } } # ======== stderr ======== elsif ($is_stderr) { # The very first line of debugging output will vary s/^Exim version .*/Exim version x.yz ..../; # Debugging lines for Exim terminations s/(?<=^>>>>>>>>>>>>>>>> Exim pid=)\d+(?= terminating)/pppp/; # IP address lookups use gethostbyname() when IPv6 is not supported, # and gethostbyname2() or getipnodebyname() when it is. s/\bgethostbyname2?|\bgetipnodebyname/get[host|ipnode]byname[2]/; # We have to omit the localhost ::1 address so that all is well in # the IPv4-only case. print MUNGED "MUNGED: ::1 will be omitted in what follows\n" if (/looked up these IP addresses/); next if /name=localhost address=::1/; # Various other IPv6 lines must be omitted too next if /using host_fake_gethostbyname for \S+ \(IPv6\)/; next if /get\[host\|ipnode\]byname\[2\]\(af=inet6\)/; next if /DNS lookup of \S+ \(AAAA\) using fakens/; next if / in dns_ipv4_lookup?/; if (/DNS lookup of \S+ \(AAAA\) gave NO_DATA/) { $_= ; # Gets "returning DNS_NODATA" next; } # Skip tls_advertise_hosts and hosts_require_tls checks when the options # are unset, because tls ain't always there. next if /in\s(?:tls_advertise_hosts\?|hosts_require_tls\?) \sno\s\(option\sunset\)/x; # Skip auxiliary group lists because they will vary. next if /auxiliary group list:/; # Skip "extracted from gecos field" because the gecos field varies next if /extracted from gecos field/; # Skip "waiting for data on socket" and "read response data: size=" lines # because some systems pack more stuff into packets than others. next if /waiting for data on socket/; next if /read response data: size=/; # If Exim is compiled with readline support but it can't find the library # to load, there will be an extra debug line. Omit it. next if /failed to load readline:/; # Some DBM libraries seem to make DBM files on opening with O_RDWR without # O_CREAT; other's don't. In the latter case there is some debugging output # which is not present in the former. Skip the relevant lines (there are # two of them). if (/TESTSUITE\/spool\/db\/\S+ appears not to exist: trying to create/) { $_ = ; next; } # Some tests turn on +expand debugging to check on expansions. # Unfortunately, the Received: expansion varies, depending on whether TLS # is compiled or not. So we must remove the relevant debugging if it is. if (/^condition: def:tls_cipher/) { while () { last if /^condition: def:sender_address/; } } elsif (/^expanding: Received: /) { while () { last if !/^\s/; } } # When Exim is checking the size of directories for maildir, it uses # the check_dir_size() function to scan directories. Of course, the order # of the files that are obtained using readdir() varies from system to # system. We therefore buffer up debugging lines from check_dir_size() # and sort them before outputting them. if (/^check_dir_size:/ || /^skipping TESTSUITE\/test-mail\//) { push @saved, $_; } else { if (@saved > 0) { print MUNGED "MUNGED: the check_dir_size lines have been sorted " . "to ensure consistency\n"; @saved = sort(@saved); print MUNGED @saved; @saved = (); } # Skip some lines that Exim puts out at the start of debugging output # because they will be different in different binaries. print MUNGED unless (/^Berkeley DB: / || /^Probably (?:Berkeley DB|ndbm|GDBM)/ || /^Authenticators:/ || /^Lookups:/ || /^Support for:/ || /^Routers:/ || /^Transports:/ || /^log selectors =/ || /^cwd=/ || /^Fixed never_users:/ ); } next; } # ======== All files other than stderr ======== print MUNGED; } close(IN); return $yield; } ################################################## # Subroutine to interact with caller # ################################################## # Arguments: [0] the prompt string # [1] if there is a U in the prompt and $force_update is true # Returns: nothing (it sets $_) sub interact{ print $_[0]; if ($_[1]) { $_ = "u"; print "... update forced\n"; } else { $_ = ; } } ################################################## # Subroutine to compare one output file # ################################################## # When an Exim server is part of the test, its output is in separate files from # an Exim client. The server data is concatenated with the client data as part # of the munging operation. # # Arguments: [0] the name of the main raw output file # [1] the name of the server raw output file or undef # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted # # Returns: 0 comparison succeeded or differences to be ignored # 1 comparison failed; files were updated (=> re-compare) # # Does not return if the user replies "Q" to a prompt. sub check_file{ my($rf,$rsf,$mf,$sf,$sortfile) = @_; # If there is no saved file, the raw files must either not exist, or be # empty. The test ! -s is TRUE if the file does not exist or is empty. if (! -e $sf) { return 0 if (! -s $rf && ! -s $rsf); print "\n"; print "** $rf is not empty\n" if (-s $rf); print "** $rsf is not empty\n" if (defined $rsf && -s $rsf); for (;;) { print "Continue, Show, or Quit? [Q] "; $_ = ; tests_exit(1) if /^q?$/i; return 0 if /^c$/i; last if (/^s$/); } foreach $f ($rf, $rsf) { if (defined $f && -s $f) { print "\n"; print "------------ $f -----------\n" if (defined $rf && -s $rf && defined $rsf && -s $rsf); system("$more $f"); } } print "\n"; for (;;) { interact("Continue, Update & retry, Quit? [Q] ", $force_update); tests_exit(1) if /^q?$/i; return 0 if /^c$/i; last if (/^u$/i); } } # Control reaches here if either (a) there is a saved file ($sf), or (b) there # was a request to create a saved file. First, create the munged file from any # data that does exist. open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); my($truncated) = munge($rf) if -e $rf; if (defined $rsf && -e $rsf) { print MUNGED "\n******** SERVER ********\n"; $truncated |= munge($rsf); } close(MUNGED); # If a saved file exists, do the comparison. There are two awkward cases: # # If "*** truncated ***" was found in the new file, it means that a log line # was overlong, and truncated. The problem is that it may be truncated at # different points on different systems, because of different user name # lengths. We reload the file and the saved file, and remove lines from the new # file that precede "*** truncated ***" until we reach one that matches the # line that precedes it in the saved file. # # If $sortfile is set, we are dealing with a mainlog file where the deliveries # for an individual message might vary in their order from system to system, as # a result of parallel deliveries. We load the munged file and sort sequences # of delivery lines. if (-e $sf) { # Deal with truncated text items if ($truncated) { my(@munged, @saved, $i, $j, $k); open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!"); @munged = ; close(MUNGED); open(SAVED, "$sf") || tests_exit(-1, "Failed to open $sf: $!"); @saved = ; close(SAVED); $j = 0; for ($i = 0; $i < @munged; $i++) { if ($munged[$i] =~ /\*\*\* truncated \*\*\*/) { for (; $j < @saved; $j++) { last if $saved[$j] =~ /\*\*\* truncated \*\*\*/; } last if $j >= @saved; # not found in saved for ($k = $i - 1; $k >= 0; $k--) { last if $munged[$k] eq $saved[$j - 1]; } last if $k <= 0; # failed to find previous match splice @munged, $k + 1, $i - $k - 1; $i = $k + 1; } } open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); for ($i = 0; $i < @munged; $i++) { print MUNGED $munged[$i]; } close(MUNGED); } # Deal with log sorting if ($sortfile) { my(@munged, $i, $j); open(MUNGED, "$mf") || tests_exit(-1, "Failed to open $mf: $!"); @munged = ; close(MUNGED); for ($i = 0; $i < @munged; $i++) { if ($munged[$i] =~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/) { for ($j = $i + 1; $j < @munged; $j++) { last if $munged[$j] !~ /^[-\d]{10}\s[:\d]{8}\s[-A-Za-z\d]{16}\s[-=*]>/; } @temp = splice(@munged, $i, $j - $i); @temp = sort(@temp); splice(@munged, $i, 0, @temp); } } open(MUNGED, ">$mf") || tests_exit(-1, "Failed to open $mf: $!"); print MUNGED "**NOTE: The delivery lines in this file have been sorted.\n"; for ($i = 0; $i < @munged; $i++) { print MUNGED $munged[$i]; } close(MUNGED); } # Do the comparison return 0 if (system("$cf $mf $sf >test-cf") == 0); # Handle comparison failure print "** Comparison of $mf with $sf failed"; system("$more test-cf"); print "\n"; for (;;) { interact("Continue, Update & retry, Quit? [Q] ", $force_update); tests_exit(1) if /^q?$/i; return 0 if /^c$/i; last if (/^u$/i); } } # Update or delete the saved file, and give the appropriate return code. if (-s $mf) { tests_exit(-1, "Failed to cp $mf $sf") if system("cp $mf $sf") != 0; } else { tests_exit(-1, "Failed to unlink $sf") if !unlink($sf); } return 1; } ################################################## # Subroutine to check the output of a test # ################################################## # This function is called when the series of subtests is complete. It makes # use of check() file, whose arguments are: # # [0] the name of the main raw output file # [1] the name of the server raw output file or undef # [2] where to put the munged copy # [3] the name of the saved file # [4] TRUE if this is a log file whose deliveries must be sorted # # Arguments: none # Returns: 0 if the output compared equal # 1 if files were updated and the test must be re-run sub check_output{ my($yield) = 0; $yield = 1 if check_file("spool/log/paniclog", "spool/log/serverpaniclog", "test-paniclog-munged", "paniclog/$testno", 0); $yield = 1 if check_file("spool/log/rejectlog", "spool/log/serverrejectlog", "test-rejectlog-munged", "rejectlog/$testno", 0); $yield = 1 if check_file("spool/log/mainlog", "spool/log/servermainlog", "test-mainlog-munged", "log/$testno", $sortlog); if (!$stdout_skip) { $yield = 1 if check_file("test-stdout", "test-stdout-server", "test-stdout-munged", "stdout/$testno", 0); } if (!$stderr_skip) { $yield = 1 if check_file("test-stderr", "test-stderr-server", "test-stderr-munged", "stderr/$testno", 0); } # Compare any delivered messages, unless this test is skipped. if (! $message_skip) { my($msgno) = 0; # Get a list of expected mailbox files for this script. We don't bother with # directories, just the files within them. foreach $oldmail (@oldmails) { next unless $oldmail =~ /^mail\/$testno\./; print ">> EXPECT $oldmail\n" if $debug; $expected_mails{$oldmail} = 1; } # If there are any files in test-mail, compare them. Note that "." and # ".." are automatically omitted by list_files_below(). @mails = list_files_below("test-mail"); foreach $mail (@mails) { next if $mail eq "test-mail/oncelog"; $saved_mail = substr($mail, 10); # Remove "test-mail/" $saved_mail =~ s/^$parm_caller(\/|$)/CALLER/; # Convert caller name if ($saved_mail =~ /(\d+\.[^.]+\.)/) { $msgno++; $saved_mail =~ s/(\d+\.[^.]+\.)/$msgno./gx; } print ">> COMPARE $mail mail/$testno.$saved_mail\n" if $debug; $yield = 1 if check_file($mail, undef, "test-mail-munged", "mail/$testno.$saved_mail", 0); delete $expected_mails{"mail/$testno.$saved_mail"}; } # Complain if not all expected mails have been found if (scalar(keys %expected_mails) != 0) { foreach $key (keys %expected_mails) { print "** no test file found for $key\n"; } for (;;) { interact("Continue, Update & retry, or Quit? [Q] ", $force_update); tests_exit(1) if /^q?$/i; last if /^c$/i; # For update, we not only have to unlink the file, but we must also # remove it from the @oldmails vector, as otherwise it will still be # checked for when we re-run the test. if (/^u$/i) { foreach $key (keys %expected_mails) { my($i); tests_exit(-1, "Failed to unlink $key") if !unlink("$key"); for ($i = 0; $i < @oldmails; $i++) { if ($oldmails[$i] eq $key) { splice @oldmails, $i, 1; last; } } } last; } } } } # Compare any remaining message logs, unless this test is skipped. if (! $msglog_skip) { # Get a list of expected msglog files for this test foreach $oldmsglog (@oldmsglogs) { next unless $oldmsglog =~ /^$testno\./; $expected_msglogs{$oldmsglog} = 1; } # If there are any files in spool/msglog, compare them. However, we have # to munge the file names because they are message ids, which are # time dependent. if (opendir(DIR, "spool/msglog")) { @msglogs = sort readdir(DIR); closedir(DIR); foreach $msglog (@msglogs) { next if ($msglog eq "." || $msglog eq ".." || $msglog eq "CVS"); ($munged_msglog = $msglog) =~ s/((?:[^\W_]{6}-){2}[^\W_]{2}) /new_value($1, "10Hm%s-0005vi-00", \$next_msgid)/egx; $yield = 1 if check_file("spool/msglog/$msglog", undef, "test-msglog-munged", "msglog/$testno.$munged_msglog", 0); delete $expected_msglogs{"$testno.$munged_msglog"}; } } # Complain if not all expected msglogs have been found if (scalar(keys %expected_msglogs) != 0) { foreach $key (keys %expected_msglogs) { print "** no test msglog found for msglog/$key\n"; ($msgid) = $key =~ /^\d+\.(.*)$/; foreach $cachekey (keys %cache) { if ($cache{$cachekey} eq $msgid) { print "** original msgid $cachekey\n"; last; } } } for (;;) { interact("Continue, Update, or Quit? [Q] ", $force_update); tests_exit(1) if /^q?$/i; last if /^c$/i; if (/^u$/i) { foreach $key (keys %expected_msglogs) { tests_exit(-1, "Failed to unlink msglog/$key") if !unlink("msglog/$key"); } last; } } } } return $yield; } ################################################## # Subroutine to run one "system" command # ################################################## # We put this in a subroutine so that the command can be reflected when # debugging. # # Argument: the command to be run # Returns: nothing sub run_system { my($cmd) = $_[0]; if ($debug) { my($prcmd) = $cmd; $prcmd =~ s/; /;\n>> /; print ">> $prcmd\n"; } system("$cmd"); } ################################################## # Subroutine to run one script command # ################################################## # The