X-Git-Url: https://git.netwichtig.de/gitweb/?a=blobdiff_plain;f=test%2Fruntest;h=a0d7fd14b92e249f7a0dd1c0c114ebbbb7779a26;hb=2d47f67729aecd3dcbacdfd303b719893f2d61fa;hp=8dca8316bc368dc882cdf904cf72fe073a954d2e;hpb=bb660b564b18e962c4f7221075b5e556d4dc4360;p=user%2Fhenk%2Fcode%2Fexim.git diff --git a/test/runtest b/test/runtest index 8dca8316b..a0d7fd14b 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,13 +16,21 @@ ############################################################################### #use strict; -#use 5.010; +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' => '####'); @@ -36,10 +46,13 @@ $testversion = "4.80 (08-May-12)"; # normal = 2432 tls_dh_max_bits = 2236 $gnutls_dh_bits_normal = 2236; -$cf = "bin/cf -exact"; +$cf = 'bin/cf -exact'; $cr = "\r"; $debug = 0; -$flavour = 'FOO'; +$flavour = do { + my $f = Exim::Runtest::flavour(); + (grep { $f eq $_ } Exim::Runtest::flavours()) ? $f : 'FOO'; +}; $force_continue = 0; $force_update = 0; $log_failed_filename = "failed-summary.log"; @@ -81,6 +94,11 @@ $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'; @@ -142,6 +160,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; } @@ -676,6 +696,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 @@ -867,7 +891,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./; @@ -1034,6 +1058,30 @@ RESET_AFTER_EXTRA_LINE_READ: # 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 @@ -1108,11 +1156,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 ; } @@ -1132,13 +1191,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"; } @@ -1185,10 +1244,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$/); } @@ -1207,9 +1265,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); } @@ -1327,10 +1385,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; @@ -1432,6 +1490,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 /' }, }; @@ -1544,16 +1605,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) { @@ -1628,11 +1689,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) { @@ -1661,14 +1722,9 @@ return $yield; # Returns: nothing sub run_system { -my($cmd) = $_[0]; -if ($debug) - { - my($prcmd) = $cmd; - $prcmd =~ s/; /;\n>> /; - print ">> $prcmd\n"; - } -system("$cmd"); + my $cmd = shift; + print '>> ' . $cmd =~ s/; /;\n>>/r . "\n" if $debug; + system $cmd; } @@ -2160,8 +2216,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") @@ -2196,7 +2251,7 @@ elsif (/^((?i:[A-Z\d_]+=\S+\s+)+)?(\d+)?\s*(sudo(?:\s+-u\s+(\w+))?\s+)?exim(_\S+ { $pidfile = "$parm_cwd/spool/exim-daemon.pid"; if ($debug) { printf ">> daemon: $cmd\n"; } - run_system("sudo mkdir spool/log 2>/dev/null"); + run_system('sudo mkdir spool/log 2>/dev/null'); run_system("sudo chown $parm_eximuser:$parm_eximgroup spool/log"); # Before running the command, convert the -bd option into -bdf so that an @@ -2226,31 +2281,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 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 (