X-Git-Url: https://git.exim.org/exim.git/blobdiff_plain/e498ab40197936833f696439e78c5cb08e5180cb..ef394e8db2af178e91ed15cc63905016d00952f4:/test/runtest diff --git a/test/runtest b/test/runtest index 6cb90fb7d..fb1cfc762 100755 --- a/test/runtest +++ b/test/runtest @@ -1,4 +1,6 @@ -#! /usr/bin/perl -w +#! /usr/bin/env perl +# We use env, because in some environments of our build farm +# the Perl 5.010 interpreter is only reachable via $PATH ############################################################################### # This is the controlling script for the "new" test suite for Exim. It should # @@ -14,12 +16,21 @@ ############################################################################### #use strict; +use 5.010; +use feature 'state'; # included in 5.010 +use warnings; + use Errno; use FileHandle; use Socket; use Time::Local; use Cwd; use File::Basename; +use FindBin qw'$Bin'; + +use lib "$Bin/lib"; +use Exim::Runtest; + use if $ENV{DEBUG} && $ENV{DEBUG} =~ /\bruntest\b/ => ('Smart::Comments' => '####'); @@ -80,15 +91,23 @@ $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 +my $dynamic_socket; # allocated later for PORT_DYNAMIC + +# Find a suiteable group name for test (currently only 0001 +# uses a group name. A numeric group id would do +my $parm_mailgroup = Exim::Runtest::mailgroup('mail'); # Manually set locale -$ENV{'LC_ALL'} = 'C'; +$ENV{LC_ALL} = 'C'; # In some environments USER does not exists, but we # need it for some test(s) $ENV{USER} = getpwuid($>) if not exists $ENV{USER}; +my ($parm_configure_owner, $parm_configure_group); +my ($parm_ipv4, $parm_ipv6); +my $parm_hostname; ############################################################################### ############################################################################### @@ -138,6 +157,8 @@ 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; +s?\bPORT_DYNAMIC\b?$dynamic_socket->sockport()?eg; +s?\bMAILGROUP\b?$parm_mailgroup?g; } @@ -427,7 +448,7 @@ RESET_AFTER_EXTRA_LINE_READ: # File descriptor numbers may vary s/^writing data block fd=\d+/writing data block fd=dddd/; - s/running as transport filter: write=\d+ read=\d+/running as transport filter: write=dddd read=dddd/; + s/(running as transport filter:) fd_write=\d+ fd_read=\d+/$1 fd_write=dddd fd_read=dddd/; # ======== Dumpdb output ======== @@ -672,6 +693,10 @@ RESET_AFTER_EXTRA_LINE_READ: # Port in host address in spool file output from -Mvh s/^-host_address (.*)\.\d+/-host_address $1.9999/; + if ($dynamic_socket and $dynamic_socket->opened and my $port = $dynamic_socket->sockport) { + s/^Connecting to 127\.0\.0\.1 port \K$port//; + } + # ======== Local IP addresses ======== # The amount of space between "host" and the address in verification output @@ -863,7 +888,7 @@ RESET_AFTER_EXTRA_LINE_READ: next if /^SSL info: SSLv2\/v3 write client hello A/; next if /^SSL info: SSLv3 read server key exchange A/; next if /SSL verify error: depth=0 error=certificate not trusted/; - s/SSL3_READ_BYTES/ssl3_read_bytes/; + s/SSL3_READ_BYTES/ssl3_read_bytes/i; # gnutls version variances next if /^Error in the pull function./; @@ -1024,6 +1049,36 @@ RESET_AFTER_EXTRA_LINE_READ: # Environment cleaning next if /\w+ in keep_environment\? (yes|no)/; + # Sizes vary with test hostname + s/^cmd buf flush \d+ bytes$/cmd buf flush ddd bytes/; + + # Spool filesystem free space changes on different systems. + s/^((?:spool|log) directory space =) -?\d+K (inodes =)\s*-?\d+/$1 nnnnnK $2 nnnnn/; + + # Non-TLS builds have different expansions for received_header_text + if (s/(with \$received_protocol)\}\} \$\{if def:tls_cipher \{\(\$tls_cipher\)\n$/$1/) + { + $_ .= ; + s/\s+\}\}(?=\(Exim )/\}\} /; + } + if (/^ condition: def:tls_cipher$/) + { + ; ; ; ; ; ; + ; ; ; ; ; next; + } + + # Not all platforms build with DKIM enabled + next if /^PDKIM >> Body data for hash, canonicalized/; + + # Not all platforms support TCP Fast Open, and the compile omits the check + if (s/\S+ in hosts_try_fastopen\? no \(option unset\)\n$//) + { + $_ .= ; + s/ \.\.\. >>> / ... /; + } + + next if /^(ppppp )?setsockopt FASTOPEN: Protocol not available$/; + # 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 @@ -1059,6 +1114,7 @@ RESET_AFTER_EXTRA_LINE_READ: /^log selectors =/ || /^cwd=/ || /^Fixed never_users:/ || + /^Configure owner:/ || /^Size of off_t:/ ); @@ -1097,11 +1153,22 @@ return $yield; # [2] if there is a C in the prompt and $force_continue is true # Returns: returns the answer -sub interact{ -print $_[0]; -if ($_[1]) { $_ = "u"; print "... update forced\n"; } - elsif ($_[2]) { $_ = "c"; print "... continue forced\n"; } - else { $_ = ; } +sub interact { + my ($prompt, $have_u, $have_c) = @_; + + print $prompt; + + if ($have_u) { + print "... update forced\n"; + return 'u'; + } + + if ($have_c) { + print "... continue forced\n"; + return 'c'; + } + + return lc ; } @@ -1121,13 +1188,13 @@ if ($_[1]) { $_ = "u"; print "... update forced\n"; } sub log_failure { - my $logfile = shift(); - my $testno = shift(); - my $detail = shift() || ''; - if ( open(my $fh, ">>", $logfile) ) { - print $fh "Test $testno $detail failed\n"; - close $fh; - } + my ($logfile, $testno, $detail) = @_; + + open(my $fh, '>>', $logfile) or return; + + print $fh "Test $testno " + . (defined $detail ? "$detail " : '') + . "failed\n"; } @@ -1174,10 +1241,9 @@ if (! -e $sf_current) for (;;) { - print "Continue, Show, or Quit? [Q] "; - $_ = $force_continue ? "c" : ; - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, $rf) if (/^c$/i && $force_continue); + $_ = interact('Continue, Show, or Quit? [Q] ', undef, $force_continue); + tests_exit(1) if /^q?$/; + log_failure($log_failed_filename, $testno, $rf) if (/^c$/ && $force_continue); return 0 if /^c$/i; last if (/^s$/); } @@ -1196,9 +1262,9 @@ if (! -e $sf_current) print "\n"; for (;;) { - interact("Continue, Update & retry, Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, $rsf) if (/^c$/i && $force_continue); + $_ = interact('Continue, Update & retry, Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + log_failure($log_failed_filename, $testno, $rsf) if (/^c$/ && $force_continue); return 0 if /^c$/i; last if (/^u$/i); } @@ -1316,10 +1382,10 @@ if (-e $sf_current) print "\n"; for (;;) { - interact("Continue, Retry, Update current" - . ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : "") - . " & retry, Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; + $_ = interact('Continue, Retry, Update current' + . ($sf_current ne $sf_flavour ? "/Save for flavour '$flavour'" : '') + . ' & retry, Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; log_failure($log_failed_filename, $testno, $sf_current) if (/^c$/i && $force_continue); return 0 if /^c$/i; return 1 if /^r$/i; @@ -1421,6 +1487,9 @@ $munges = { 'stdout' => 's/^\d\d:\d\d:\d\d\s+\d+ //; s/Process \d+ is ready for new message/Process pppp is ready for new message/' }, + + 'timeout_errno' => # actual errno differs Solaris vs. Linux + { 'mainlog' => 's/(host deferral .* errno) <\d+> /$1 /' }, }; @@ -1533,16 +1602,16 @@ if (! $message_skip) for (;;) { - interact("Continue, Update & retry, or Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "missing email") if (/^c$/i && $force_continue); - last if /^c$/i; + $_ = interact('Continue, Update & retry, or Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + log_failure($log_failed_filename, $testno, "missing email") if (/^c$/ && $force_continue); + last if /^c$/; # 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) + if (/^u$/) { foreach $key (keys %expected_mails) { @@ -1617,11 +1686,11 @@ if (! $msglog_skip) for (;;) { - interact("Continue, Update, or Quit? [Q] ", $force_update, $force_continue); - tests_exit(1) if /^q?$/i; - log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/i && $force_continue); - last if /^c$/i; - if (/^u$/i) + $_ = interact('Continue, Update, or Quit? [Q] ', $force_update, $force_continue); + tests_exit(1) if /^q?$/; + log_failure($log_failed_filename, $testno, "missing msglog") if (/^c$/ && $force_continue); + last if /^c$/; + if (/^u$/) { foreach $key (keys %expected_msglogs) { @@ -1963,7 +2032,7 @@ if (/^sleep\s+(.*)$/) # Various Unix management commands are recognized if (/^(ln|ls|du|mkdir|mkfifo|touch|cp|cat)\s/ || - /^sudo\s(rmdir|rm|chown|chmod)\s/) + /^sudo\s(rmdir|rm|mv|chown|chmod)\s/) { run_system("$_ >>test-stdout 2>>test-stderr"); return 1; @@ -2149,8 +2218,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ # Done backwards just in case there are more than 9 - my($i); - for ($i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; } + for (my $i = @msglist; $i > 0; $i--) { $args =~ s/\$msg$i/$msglist[$i-1]/g; } if ( $args =~ /\$msg\d/ ) { tests_exit(-1, "Not enough messages in spool, for test $testno line $lineno\n") @@ -2215,31 +2283,24 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ } elsif ($cmd =~ /\s-DSERVER=wait:(\d+)\s/) { + + # The port and the $dynamic_socket was already allocated while parsing the + # script file, where -DSERVER=wait:PORT_DYNAMIC was encountered. + my $listen_port = $1; - my $waitmode_sock = new FileHandle; if ($debug) { printf ">> wait-mode daemon: $cmd\n"; } run_system("sudo mkdir spool/log 2>/dev/null"); run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); - my ($s_ip,$s_port) = ('127.0.0.1', $listen_port); - my $sin = sockaddr_in($s_port, inet_aton($s_ip)) - or die "** Failed packing $s_ip:$s_port\n"; - socket($waitmode_sock, PF_INET, SOCK_STREAM, getprotobyname('tcp')) - or die "** Unable to open socket $s_ip:$s_port: $!\n"; - setsockopt($waitmode_sock, SOL_SOCKET, SO_REUSEADDR, 1) - or die "** Unable to setsockopt(SO_REUSEADDR): $!\n"; - bind($waitmode_sock, $sin) - or die "** Unable to bind socket ($s_port): $!\n"; - listen($waitmode_sock, 5); my $pid = fork(); if (not defined $pid) { die "** fork failed: $!\n" } if (not $pid) { close(STDIN); - open(STDIN, "<&", $waitmode_sock) or die "** dup sock to stdin failed: $!\n"; - close($waitmode_sock); + open(STDIN, '<&', $dynamic_socket) or die "** dup sock to stdin failed: $!\n"; + close($dynamic_socket); print "[$$]>> ${cmd}-server\n" if ($debug); exec "exec ${cmd}-server"; - exit(1); + die "Can't exec ${cmd}-server: $!\n"; } while (