1#*************************************************************************** 2# _ _ ____ _ 3# Project ___| | | | _ \| | 4# / __| | | | |_) | | 5# | (__| |_| | _ <| |___ 6# \___|\___/|_| \_\_____| 7# 8# Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. 9# 10# This software is licensed as described in the file COPYING, which 11# you should have received as part of this distribution. The terms 12# are also available at https://curl.se/docs/copyright.html. 13# 14# You may opt to use, copy, modify, merge, publish, distribute and/or sell 15# copies of the Software, and permit persons to whom the Software is 16# furnished to do so, under the terms of the COPYING file. 17# 18# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY 19# KIND, either express or implied. 20# 21# SPDX-License-Identifier: curl 22# 23########################################################################### 24 25# This module contains entry points to run a single test. runner_init 26# determines whether they will run in a separate process or in the process of 27# the caller. The relevant interface is asynchronous so it will work in either 28# case. Program arguments are marshalled and then written to the end of a pipe 29# (in controlleripccall) which is later read from and the arguments 30# unmarshalled (in ipcrecv) before the desired function is called normally. 31# The function return values are then marshalled and written into another pipe 32# (again in ipcrecv) when is later read from and unmarshalled (in runnerar) 33# before being returned to the caller. 34 35package runner; 36 37use strict; 38use warnings; 39use 5.006; 40 41BEGIN { 42 use base qw(Exporter); 43 44 our @EXPORT = qw( 45 checktestcmd 46 prepro 47 readtestkeywords 48 restore_test_env 49 runner_init 50 runnerac_clearlocks 51 runnerac_shutdown 52 runnerac_stopservers 53 runnerac_test_preprocess 54 runnerac_test_run 55 runnerar 56 runnerar_ready 57 stderrfilename 58 stdoutfilename 59 $DBGCURL 60 $gdb 61 $gdbthis 62 $gdbxwin 63 $shallow 64 $tortalloc 65 $valgrind_logfile 66 $valgrind_tool 67 ); 68 69 # these are for debugging only 70 our @EXPORT_OK = qw( 71 singletest_preprocess 72 ); 73} 74 75use B qw( 76 svref_2object 77 ); 78use Storable qw( 79 freeze 80 thaw 81 ); 82 83use pathhelp qw( 84 exe_ext 85 ); 86use processhelp qw( 87 portable_sleep 88 ); 89use servers qw( 90 checkcmd 91 clearlocks 92 initserverconfig 93 serverfortest 94 stopserver 95 stopservers 96 subvariables 97 ); 98use getpart; 99use globalconfig; 100use testutil qw( 101 clearlogs 102 logmsg 103 runclient 104 shell_quote 105 subbase64 106 subnewlines 107 ); 108use valgrind; 109 110 111####################################################################### 112# Global variables set elsewhere but used only by this package 113# These may only be set *before* runner_init is called 114our $DBGCURL=$CURL; #"../src/.libs/curl"; # alternative for debugging 115our $valgrind_logfile="--log-file"; # the option name for valgrind >=3 116our $valgrind_tool="--tool=memcheck"; 117our $gdb = checktestcmd("gdb"); 118our $gdbthis = 0; # run test case with debugger (gdb or lldb) 119our $gdbxwin; # use windowed gdb when using gdb 120 121# torture test variables 122our $shallow; 123our $tortalloc; 124 125# local variables 126my %oldenv; # environment variables before test is started 127my $UNITDIR="./unit"; 128my $CURLLOG="$LOGDIR/commands.log"; # all command lines run 129my $defserverlogslocktimeout = 5; # timeout to await server logs lock removal 130my $defpostcommanddelay = 0; # delay between command and postcheck sections 131my $multiprocess; # nonzero with a separate test runner process 132 133# pipes 134my $runnerr; # pipe that runner reads from 135my $runnerw; # pipe that runner writes to 136 137# per-runner variables, indexed by runner ID; these are used by controller only 138my %controllerr; # pipe that controller reads from 139my %controllerw; # pipe that controller writes to 140 141# redirected stdout/stderr to these files 142sub stdoutfilename { 143 my ($logdir, $testnum)=@_; 144 return "$logdir/stdout$testnum"; 145} 146 147sub stderrfilename { 148 my ($logdir, $testnum)=@_; 149 return "$logdir/stderr$testnum"; 150} 151 152####################################################################### 153# Initialize the runner and prepare it to run tests 154# The runner ID returned by this function must be passed into the other 155# runnerac_* functions 156# Called by controller 157sub runner_init { 158 my ($logdir, $jobs)=@_; 159 160 $multiprocess = !!$jobs; 161 162 # enable memory debugging if curl is compiled with it 163 $ENV{'CURL_MEMDEBUG'} = "$logdir/$MEMDUMP"; 164 $ENV{'CURL_ENTROPY'}="12345678"; 165 $ENV{'CURL_FORCETIME'}=1; # for debug NTLM magic 166 $ENV{'CURL_GLOBAL_INIT'}=1; # debug curl_global_init/cleanup use 167 $ENV{'HOME'}=$pwd; 168 $ENV{'CURL_HOME'}=$ENV{'HOME'}; 169 $ENV{'XDG_CONFIG_HOME'}=$ENV{'HOME'}; 170 $ENV{'COLUMNS'}=79; # screen width! 171 172 # Incorporate the $logdir into the random seed and re-seed the PRNG. 173 # This gives each runner a unique yet consistent seed which provides 174 # more unique port number selection in each runner, yet is deterministic 175 # across runs. 176 $randseed += unpack('%16C*', $logdir); 177 srand $randseed; 178 179 # create pipes for communication with runner 180 my ($thisrunnerr, $thiscontrollerw, $thiscontrollerr, $thisrunnerw); 181 pipe $thisrunnerr, $thiscontrollerw; 182 pipe $thiscontrollerr, $thisrunnerw; 183 184 my $thisrunnerid; 185 if($multiprocess) { 186 # Create a separate process in multiprocess mode 187 my $child = fork(); 188 if(0 == $child) { 189 # TODO: set up better signal handlers 190 $SIG{INT} = 'IGNORE'; 191 $SIG{TERM} = 'IGNORE'; 192 eval { 193 # some msys2 perl versions don't define SIGUSR1 194 $SIG{USR1} = 'IGNORE'; 195 }; 196 197 $thisrunnerid = $$; 198 print "Runner $thisrunnerid starting\n" if($verbose); 199 200 # Here we are the child (runner). 201 close($thiscontrollerw); 202 close($thiscontrollerr); 203 $runnerr = $thisrunnerr; 204 $runnerw = $thisrunnerw; 205 206 # Set this directory as ours 207 $LOGDIR = $logdir; 208 mkdir("$LOGDIR/$PIDDIR", 0777); 209 mkdir("$LOGDIR/$LOCKDIR", 0777); 210 211 # Initialize various server variables 212 initserverconfig(); 213 214 # handle IPC calls 215 event_loop(); 216 217 # Can't rely on logmsg here in case it's buffered 218 print "Runner $thisrunnerid exiting\n" if($verbose); 219 220 # To reach this point, either the controller has sent 221 # runnerac_stopservers() and runnerac_shutdown() or we have called 222 # runnerabort(). In both cases, there are no more of our servers 223 # running and we can safely exit. 224 exit 0; 225 } 226 227 # Here we are the parent (controller). 228 close($thisrunnerw); 229 close($thisrunnerr); 230 231 $thisrunnerid = $child; 232 233 } else { 234 # Create our pid directory 235 mkdir("$LOGDIR/$PIDDIR", 0777); 236 237 # Don't create a separate process 238 $thisrunnerid = "integrated"; 239 } 240 241 $controllerw{$thisrunnerid} = $thiscontrollerw; 242 $runnerr = $thisrunnerr; 243 $runnerw = $thisrunnerw; 244 $controllerr{$thisrunnerid} = $thiscontrollerr; 245 246 return $thisrunnerid; 247} 248 249####################################################################### 250# Loop to execute incoming IPC calls until the shutdown call 251sub event_loop { 252 while () { 253 if(ipcrecv()) { 254 last; 255 } 256 } 257} 258 259####################################################################### 260# Check for a command in the PATH of the machine running curl. 261# 262sub checktestcmd { 263 my ($cmd)=@_; 264 my @testpaths=("$LIBDIR/.libs", "$LIBDIR"); 265 return checkcmd($cmd, @testpaths); 266} 267 268# See if Valgrind should actually be used 269sub use_valgrind { 270 if($valgrind) { 271 my @valgrindoption = getpart("verify", "valgrind"); 272 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { 273 return 1; 274 } 275 } 276 return 0; 277} 278 279# Massage the command result code into a useful form 280sub normalize_cmdres { 281 my $cmdres = $_[0]; 282 my $signal_num = $cmdres & 127; 283 my $dumped_core = $cmdres & 128; 284 285 if(!$anyway && ($signal_num || $dumped_core)) { 286 $cmdres = 1000; 287 } 288 else { 289 $cmdres >>= 8; 290 $cmdres = (2000 + $signal_num) if($signal_num && !$cmdres); 291 } 292 return ($cmdres, $dumped_core); 293} 294 295# 'prepro' processes the input array and replaces %-variables in the array 296# etc. Returns the processed version of the array 297sub prepro { 298 my $testnum = shift; 299 my (@entiretest) = @_; 300 my $show = 1; 301 my @out; 302 my $data_crlf; 303 my @pshow; 304 my @altshow; 305 my $plvl; 306 my $line; 307 for my $s (@entiretest) { 308 my $f = $s; 309 $line++; 310 if($s =~ /^ *%if (.*)/) { 311 my $cond = $1; 312 my $rev = 0; 313 314 if($cond =~ /^!(.*)/) { 315 $cond = $1; 316 $rev = 1; 317 } 318 $rev ^= $feature{$cond} ? 1 : 0; 319 push @pshow, $show; # push the previous state 320 $plvl++; 321 if($show) { 322 # only if this was showing before we can allow the alternative 323 # to go showing as well 324 push @altshow, $rev ^ 1; # push the reversed show state 325 } 326 else { 327 push @altshow, 0; # the alt should still hide 328 } 329 if($show) { 330 # we only allow show if already showing 331 $show = $rev; 332 } 333 next; 334 } 335 elsif($s =~ /^ *%else/) { 336 if(!$plvl) { 337 print STDERR "error: test$testnum:$line: %else no %if\n"; 338 last; 339 } 340 $show = pop @altshow; 341 push @altshow, $show; # put it back for consistency 342 next; 343 } 344 elsif($s =~ /^ *%endif/) { 345 if(!$plvl--) { 346 print STDERR "error: test$testnum:$line: %endif had no %if\n"; 347 last; 348 } 349 $show = pop @pshow; 350 pop @altshow; # not used here but we must pop it 351 next; 352 } 353 if($show) { 354 # The processor does CRLF replacements in the <data*> sections if 355 # necessary since those parts might be read by separate servers. 356 if($s =~ /^ *<data(.*)\>/) { 357 if($1 =~ /crlf="yes"/ || 358 ($feature{"hyper"} && ($keywords{"HTTP"} || $keywords{"HTTPS"}))) { 359 $data_crlf = 1; 360 } 361 } 362 elsif(($s =~ /^ *<\/data/) && $data_crlf) { 363 $data_crlf = 0; 364 } 365 subvariables(\$s, $testnum, "%"); 366 subbase64(\$s); 367 subnewlines(0, \$s) if($data_crlf); 368 push @out, $s; 369 } 370 } 371 return @out; 372} 373 374 375####################################################################### 376# Load test keywords into %keywords hash 377# 378sub readtestkeywords { 379 my @info_keywords = getpart("info", "keywords"); 380 381 # Clear the list of keywords from the last test 382 %keywords = (); 383 for my $k (@info_keywords) { 384 chomp $k; 385 $keywords{$k} = 1; 386 } 387} 388 389 390####################################################################### 391# Return a list of log locks that still exist 392# 393sub logslocked { 394 opendir(my $lockdir, "$LOGDIR/$LOCKDIR"); 395 my @locks; 396 foreach (readdir $lockdir) { 397 if(/^(.*)\.lock$/) { 398 push @locks, $1; 399 } 400 } 401 return @locks; 402} 403 404####################################################################### 405# Memory allocation test and failure torture testing. 406# 407sub torture { 408 my ($testcmd, $testnum, $gdbline) = @_; 409 410 # remove memdump first to be sure we get a new nice and clean one 411 unlink("$LOGDIR/$MEMDUMP"); 412 413 # First get URL from test server, ignore the output/result 414 runclient($testcmd); 415 416 logmsg " CMD: $testcmd\n" if($verbose); 417 418 # memanalyze -v is our friend, get the number of allocations made 419 my $count=0; 420 my @out = `$memanalyze -v "$LOGDIR/$MEMDUMP"`; 421 for(@out) { 422 if(/^Operations: (\d+)/) { 423 $count = $1; 424 last; 425 } 426 } 427 if(!$count) { 428 logmsg " found no functions to make fail\n"; 429 return 0; 430 } 431 432 my @ttests = (1 .. $count); 433 if($shallow && ($shallow < $count)) { 434 my $discard = scalar(@ttests) - $shallow; 435 my $percent = sprintf("%.2f%%", $shallow * 100 / scalar(@ttests)); 436 logmsg " $count functions found, but only fail $shallow ($percent)\n"; 437 while($discard) { 438 my $rm; 439 do { 440 # find a test to discard 441 $rm = rand(scalar(@ttests)); 442 } while(!$ttests[$rm]); 443 $ttests[$rm] = undef; 444 $discard--; 445 } 446 } 447 else { 448 logmsg " $count functions to make fail\n"; 449 } 450 451 for (@ttests) { 452 my $limit = $_; 453 my $fail; 454 my $dumped_core; 455 456 if(!defined($limit)) { 457 # --shallow can undefine them 458 next; 459 } 460 if($tortalloc && ($tortalloc != $limit)) { 461 next; 462 } 463 464 if($verbose) { 465 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 466 localtime(time()); 467 my $now = sprintf("%02d:%02d:%02d ", $hour, $min, $sec); 468 logmsg "Fail function no: $limit at $now\r"; 469 } 470 471 # make the memory allocation function number $limit return failure 472 $ENV{'CURL_MEMLIMIT'} = $limit; 473 474 # remove memdump first to be sure we get a new nice and clean one 475 unlink("$LOGDIR/$MEMDUMP"); 476 477 my $cmd = $testcmd; 478 if($valgrind && !$gdbthis) { 479 my @valgrindoption = getpart("verify", "valgrind"); 480 if((!@valgrindoption) || ($valgrindoption[0] !~ /disable/)) { 481 my $valgrindcmd = "$valgrind "; 482 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); 483 $valgrindcmd .= "--quiet --leak-check=yes "; 484 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; 485 # $valgrindcmd .= "--gen-suppressions=all "; 486 $valgrindcmd .= "--num-callers=16 "; 487 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; 488 $cmd = "$valgrindcmd $testcmd"; 489 } 490 } 491 logmsg "*** Function number $limit is now set to fail ***\n" if($gdbthis); 492 493 my $ret = 0; 494 if($gdbthis) { 495 runclient($gdbline); 496 } 497 else { 498 $ret = runclient($cmd); 499 } 500 #logmsg "$_ Returned " . ($ret >> 8) . "\n"; 501 502 # Now clear the variable again 503 delete $ENV{'CURL_MEMLIMIT'} if($ENV{'CURL_MEMLIMIT'}); 504 505 if(-r "core") { 506 # there's core file present now! 507 logmsg " core dumped\n"; 508 $dumped_core = 1; 509 $fail = 2; 510 } 511 512 if($valgrind) { 513 my @e = valgrindparse("$LOGDIR/valgrind$testnum"); 514 if(@e && $e[0]) { 515 if($automakestyle) { 516 logmsg "FAIL: torture $testnum - valgrind\n"; 517 } 518 else { 519 logmsg " valgrind ERROR "; 520 logmsg @e; 521 } 522 $fail = 1; 523 } 524 } 525 526 # verify that it returns a proper error code, doesn't leak memory 527 # and doesn't core dump 528 if(($ret & 255) || ($ret >> 8) >= 128) { 529 logmsg " system() returned $ret\n"; 530 $fail=1; 531 } 532 else { 533 my @memdata=`$memanalyze "$LOGDIR/$MEMDUMP"`; 534 my $leak=0; 535 for(@memdata) { 536 if($_ ne "") { 537 # well it could be other memory problems as well, but 538 # we call it leak for short here 539 $leak=1; 540 } 541 } 542 if($leak) { 543 logmsg "** MEMORY FAILURE\n"; 544 logmsg @memdata; 545 logmsg `$memanalyze -l "$LOGDIR/$MEMDUMP"`; 546 $fail = 1; 547 } 548 } 549 if($fail) { 550 logmsg " $testnum: torture FAILED: function number $limit in test.\n", 551 " invoke with \"-t$limit\" to repeat this single case.\n"; 552 stopservers($verbose); 553 return 1; 554 } 555 } 556 557 logmsg "\n" if($verbose); 558 logmsg "torture OK\n"; 559 return 0; 560} 561 562 563####################################################################### 564# restore environment variables that were modified in test 565sub restore_test_env { 566 my $deleteoldenv = $_[0]; # 1 to delete the saved contents after restore 567 foreach my $var (keys %oldenv) { 568 if($oldenv{$var} eq 'notset') { 569 delete $ENV{$var} if($ENV{$var}); 570 } 571 else { 572 $ENV{$var} = $oldenv{$var}; 573 } 574 if($deleteoldenv) { 575 delete $oldenv{$var}; 576 } 577 } 578} 579 580 581####################################################################### 582# Start the servers needed to run this test case 583sub singletest_startservers { 584 my ($testnum, $testtimings) = @_; 585 586 # remove old test server files before servers are started/verified 587 unlink("$LOGDIR/$SERVERCMD"); 588 unlink("$LOGDIR/$SERVERIN"); 589 unlink("$LOGDIR/$PROXYIN"); 590 591 # timestamp required servers verification start 592 $$testtimings{"timesrvrini"} = Time::HiRes::time(); 593 594 my $why; 595 my $error; 596 if (!$listonly) { 597 my @what = getpart("client", "server"); 598 if(!$what[0]) { 599 warn "Test case $testnum has no server(s) specified"; 600 $why = "no server specified"; 601 $error = -1; 602 } else { 603 my $err; 604 ($why, $err) = serverfortest(@what); 605 if($err == 1) { 606 # Error indicates an actual problem starting the server 607 $error = -2; 608 } else { 609 $error = -1; 610 } 611 } 612 } 613 614 # timestamp required servers verification end 615 $$testtimings{"timesrvrend"} = Time::HiRes::time(); 616 617 return ($why, $error); 618} 619 620 621####################################################################### 622# Generate preprocessed test file 623sub singletest_preprocess { 624 my $testnum = $_[0]; 625 626 # Save a preprocessed version of the entire test file. This allows more 627 # "basic" test case readers to enjoy variable replacements. 628 my @entiretest = fulltest(); 629 my $otest = "$LOGDIR/test$testnum"; 630 631 @entiretest = prepro($testnum, @entiretest); 632 633 # save the new version 634 open(my $fulltesth, ">", "$otest") || die "Failure writing test file"; 635 foreach my $bytes (@entiretest) { 636 print $fulltesth pack('a*', $bytes) or die "Failed to print '$bytes': $!"; 637 } 638 close($fulltesth) || die "Failure writing test file"; 639 640 # in case the process changed the file, reload it 641 loadtest("$LOGDIR/test${testnum}"); 642} 643 644 645####################################################################### 646# Set up the test environment to run this test case 647sub singletest_setenv { 648 my @setenv = getpart("client", "setenv"); 649 foreach my $s (@setenv) { 650 chomp $s; 651 if($s =~ /([^=]*)(.*)/) { 652 my ($var, $content) = ($1, $2); 653 # remember current setting, to restore it once test runs 654 $oldenv{$var} = ($ENV{$var})?"$ENV{$var}":'notset'; 655 656 if($content =~ /^=(.*)/) { 657 # assign it 658 $content = $1; 659 660 if($var =~ /^LD_PRELOAD/) { 661 if(exe_ext('TOOL') && (exe_ext('TOOL') eq '.exe')) { 662 logmsg "Skipping LD_PRELOAD due to lack of OS support\n" if($verbose); 663 next; 664 } 665 if($feature{"debug"} || !$has_shared) { 666 logmsg "Skipping LD_PRELOAD due to no release shared build\n" if($verbose); 667 next; 668 } 669 } 670 $ENV{$var} = "$content"; 671 logmsg "setenv $var = $content\n" if($verbose); 672 } 673 else { 674 # remove it 675 delete $ENV{$var} if($ENV{$var}); 676 } 677 678 } 679 } 680 if($proxy_address) { 681 $ENV{http_proxy} = $proxy_address; 682 $ENV{HTTPS_PROXY} = $proxy_address; 683 } 684} 685 686 687####################################################################### 688# Check that test environment is fine to run this test case 689sub singletest_precheck { 690 my $testnum = $_[0]; 691 my $why; 692 my @precheck = getpart("client", "precheck"); 693 if(@precheck) { 694 my $cmd = $precheck[0]; 695 chomp $cmd; 696 if($cmd) { 697 my @p = split(/ /, $cmd); 698 if($p[0] !~ /\//) { 699 # the first word, the command, does not contain a slash so 700 # we will scan the "improved" PATH to find the command to 701 # be able to run it 702 my $fullp = checktestcmd($p[0]); 703 704 if($fullp) { 705 $p[0] = $fullp; 706 } 707 $cmd = join(" ", @p); 708 } 709 710 my @o = `$cmd 2> $LOGDIR/precheck-$testnum`; 711 if($o[0]) { 712 $why = $o[0]; 713 $why =~ s/[\r\n]//g; 714 } 715 elsif($?) { 716 $why = "precheck command error"; 717 } 718 logmsg "prechecked $cmd\n" if($verbose); 719 } 720 } 721 return $why; 722} 723 724 725####################################################################### 726# Prepare the test environment to run this test case 727sub singletest_prepare { 728 my ($testnum) = @_; 729 730 if($feature{"TrackMemory"}) { 731 unlink("$LOGDIR/$MEMDUMP"); 732 } 733 unlink("core"); 734 735 # remove server output logfiles after servers are started/verified 736 unlink("$LOGDIR/$SERVERIN"); 737 unlink("$LOGDIR/$PROXYIN"); 738 739 # if this section exists, it might be FTP server instructions: 740 my @ftpservercmd = getpart("reply", "servercmd"); 741 push @ftpservercmd, "Testnum $testnum\n"; 742 # write the instructions to file 743 writearray("$LOGDIR/$SERVERCMD", \@ftpservercmd); 744 745 # create (possibly-empty) files before starting the test 746 for my $partsuffix (('', '1', '2', '3', '4')) { 747 my @inputfile=getpart("client", "file".$partsuffix); 748 my %fileattr = getpartattr("client", "file".$partsuffix); 749 my $filename=$fileattr{'name'}; 750 if(@inputfile || $filename) { 751 if(!$filename) { 752 logmsg " $testnum: IGNORED: section client=>file has no name attribute\n"; 753 return -1; 754 } 755 my $fileContent = join('', @inputfile); 756 757 # make directories if needed 758 my $path = $filename; 759 # cut off the file name part 760 $path =~ s/^(.*)\/[^\/]*/$1/; 761 my @ldparts = split(/\//, $LOGDIR); 762 my $nparts = @ldparts; 763 my @parts = split(/\//, $path); 764 if(join("/", @parts[0..$nparts-1]) eq $LOGDIR) { 765 # the file is in $LOGDIR/ 766 my $d = shift @parts; 767 for(@parts) { 768 $d .= "/$_"; 769 mkdir $d; # 0777 770 } 771 } 772 if (open(my $outfile, ">", "$filename")) { 773 binmode $outfile; # for crapage systems, use binary 774 if($fileattr{'nonewline'}) { 775 # cut off the final newline 776 chomp($fileContent); 777 } 778 print $outfile $fileContent; 779 close($outfile); 780 } else { 781 logmsg "ERROR: cannot write $filename\n"; 782 } 783 } 784 } 785 return 0; 786} 787 788 789####################################################################### 790# Run the test command 791sub singletest_run { 792 my ($testnum, $testtimings) = @_; 793 794 # get the command line options to use 795 my ($cmd, @blaha)= getpart("client", "command"); 796 if($cmd) { 797 # make some nice replace operations 798 $cmd =~ s/\n//g; # no newlines please 799 # substitute variables in the command line 800 } 801 else { 802 # there was no command given, use something silly 803 $cmd="-"; 804 } 805 806 my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout 807 808 # if stdout section exists, we verify that the stdout contained this: 809 my $out=""; 810 my %cmdhash = getpartattr("client", "command"); 811 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-output/)) { 812 #We may slap on --output! 813 if (!partexists("verify", "stdout") || 814 ($cmdhash{'option'} && $cmdhash{'option'} =~ /force-output/)) { 815 $out=" --output $CURLOUT "; 816 } 817 } 818 819 my @codepieces = getpart("client", "tool"); 820 my $tool=""; 821 if(@codepieces) { 822 $tool = $codepieces[0]; 823 chomp $tool; 824 $tool .= exe_ext('TOOL'); 825 } 826 827 my $disablevalgrind; 828 my $CMDLINE=""; 829 my $cmdargs; 830 my $cmdtype = $cmdhash{'type'} || "default"; 831 my $fail_due_event_based = $run_event_based; 832 if($cmdtype eq "perl") { 833 # run the command line prepended with "perl" 834 $cmdargs ="$cmd"; 835 $CMDLINE = "$perl "; 836 $tool=$CMDLINE; 837 $disablevalgrind=1; 838 } 839 elsif($cmdtype eq "shell") { 840 # run the command line prepended with "/bin/sh" 841 $cmdargs ="$cmd"; 842 $CMDLINE = "/bin/sh "; 843 $tool=$CMDLINE; 844 $disablevalgrind=1; 845 } 846 elsif(!$tool && !$keywords{"unittest"}) { 847 # run curl, add suitable command line options 848 my $inc=""; 849 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-include/)) { 850 $inc = " --include"; 851 } 852 $cmdargs = "$out$inc "; 853 854 if($cmdhash{'option'} && ($cmdhash{'option'} =~ /binary-trace/)) { 855 $cmdargs .= "--trace $LOGDIR/trace$testnum "; 856 } 857 else { 858 $cmdargs .= "--trace-ascii $LOGDIR/trace$testnum "; 859 } 860 $cmdargs .= "--trace-config all "; 861 $cmdargs .= "--trace-time "; 862 if($run_event_based) { 863 $cmdargs .= "--test-event "; 864 $fail_due_event_based--; 865 } 866 $cmdargs .= $cmd; 867 if ($proxy_address) { 868 $cmdargs .= " --proxy $proxy_address "; 869 } 870 } 871 else { 872 $cmdargs = " $cmd"; # $cmd is the command line for the test file 873 $CURLOUT = stdoutfilename($LOGDIR, $testnum); # sends received data to stdout 874 875 # Default the tool to a unit test with the same name as the test spec 876 if($keywords{"unittest"} && !$tool) { 877 $tool="unit$testnum"; 878 } 879 880 if($tool =~ /^lib/) { 881 $CMDLINE="$LIBDIR/$tool"; 882 } 883 elsif($tool =~ /^unit/) { 884 $CMDLINE="$UNITDIR/$tool"; 885 } 886 887 if(! -f $CMDLINE) { 888 logmsg " $testnum: IGNORED: The tool set in the test case for this: '$tool' does not exist\n"; 889 return (-1, 0, 0, "", "", 0); 890 } 891 $DBGCURL=$CMDLINE; 892 } 893 894 if($fail_due_event_based) { 895 logmsg " $testnum: IGNORED: This test cannot run event based\n"; 896 return (-1, 0, 0, "", "", 0); 897 } 898 899 if($gdbthis) { 900 # gdb is incompatible with valgrind, so disable it when debugging 901 # Perhaps a better approach would be to run it under valgrind anyway 902 # with --db-attach=yes or --vgdb=yes. 903 $disablevalgrind=1; 904 } 905 906 my @stdintest = getpart("client", "stdin"); 907 908 if(@stdintest) { 909 my $stdinfile="$LOGDIR/stdin-for-$testnum"; 910 911 my %hash = getpartattr("client", "stdin"); 912 if($hash{'nonewline'}) { 913 # cut off the final newline from the final line of the stdin data 914 chomp($stdintest[-1]); 915 } 916 917 writearray($stdinfile, \@stdintest); 918 919 $cmdargs .= " <$stdinfile"; 920 } 921 922 if(!$tool) { 923 $CMDLINE=shell_quote($CURL); 924 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-q/)) { 925 $CMDLINE .= " -q"; 926 } 927 } 928 929 if(use_valgrind() && !$disablevalgrind) { 930 my $valgrindcmd = "$valgrind "; 931 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); 932 $valgrindcmd .= "--quiet --leak-check=yes "; 933 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; 934 # $valgrindcmd .= "--gen-suppressions=all "; 935 $valgrindcmd .= "--num-callers=16 "; 936 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; 937 $CMDLINE = "$valgrindcmd $CMDLINE"; 938 } 939 940 $CMDLINE .= "$cmdargs > " . stdoutfilename($LOGDIR, $testnum) . 941 " 2> " . stderrfilename($LOGDIR, $testnum); 942 943 if($verbose) { 944 logmsg "$CMDLINE\n"; 945 } 946 947 open(my $cmdlog, ">", $CURLLOG) || die "Failure writing log file"; 948 print $cmdlog "$CMDLINE\n"; 949 close($cmdlog) || die "Failure writing log file"; 950 951 my $dumped_core; 952 my $cmdres; 953 954 if($gdbthis) { 955 my $gdbinit = "$TESTDIR/gdbinit$testnum"; 956 open(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file"; 957 if($gdbthis == 1) { 958 # gdb mode 959 print $gdbcmd "set args $cmdargs\n"; 960 print $gdbcmd "show args\n"; 961 print $gdbcmd "source $gdbinit\n" if -e $gdbinit; 962 } 963 else { 964 # lldb mode 965 print $gdbcmd "set args $cmdargs\n"; 966 } 967 close($gdbcmd) || die "Failure writing gdb file"; 968 } 969 970 # Flush output. 971 $| = 1; 972 973 # timestamp starting of test command 974 $$testtimings{"timetoolini"} = Time::HiRes::time(); 975 976 # run the command line we built 977 if ($torture) { 978 $cmdres = torture($CMDLINE, 979 $testnum, 980 "$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " -x $LOGDIR/gdbcmd"); 981 } 982 elsif($gdbthis == 1) { 983 # gdb 984 my $GDBW = ($gdbxwin) ? "-w" : ""; 985 runclient("$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " $GDBW -x $LOGDIR/gdbcmd"); 986 $cmdres=0; # makes it always continue after a debugged run 987 } 988 elsif($gdbthis == 2) { 989 # $gdb is "lldb" 990 print "runs lldb -- $CURL $cmdargs\n"; 991 runclient("lldb -- $CURL $cmdargs"); 992 $cmdres=0; # makes it always continue after a debugged run 993 } 994 else { 995 # Convert the raw result code into a more useful one 996 ($cmdres, $dumped_core) = normalize_cmdres(runclient("$CMDLINE")); 997 } 998 999 # timestamp finishing of test command 1000 $$testtimings{"timetoolend"} = Time::HiRes::time(); 1001 1002 return (0, $cmdres, $dumped_core, $CURLOUT, $tool, use_valgrind() && !$disablevalgrind); 1003} 1004 1005 1006####################################################################### 1007# Clean up after test command 1008sub singletest_clean { 1009 my ($testnum, $dumped_core, $testtimings)=@_; 1010 1011 if(!$dumped_core) { 1012 if(-r "core") { 1013 # there's core file present now! 1014 $dumped_core = 1; 1015 } 1016 } 1017 1018 if($dumped_core) { 1019 logmsg "core dumped\n"; 1020 if(0 && $gdb) { 1021 logmsg "running gdb for post-mortem analysis:\n"; 1022 open(my $gdbcmd, ">", "$LOGDIR/gdbcmd2") || die "Failure writing gdb file"; 1023 print $gdbcmd "bt\n"; 1024 close($gdbcmd) || die "Failure writing gdb file"; 1025 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch " . shell_quote($DBGCURL) . " core "); 1026 # unlink("$LOGDIR/gdbcmd2"); 1027 } 1028 } 1029 1030 # If a server logs advisor read lock file exists, it is an indication 1031 # that the server has not yet finished writing out all its log files, 1032 # including server request log files used for protocol verification. 1033 # So, if the lock file exists the script waits here a certain amount 1034 # of time until the server removes it, or the given time expires. 1035 my $serverlogslocktimeout = $defserverlogslocktimeout; 1036 my %cmdhash = getpartattr("client", "command"); 1037 if($cmdhash{'timeout'}) { 1038 # test is allowed to override default server logs lock timeout 1039 if($cmdhash{'timeout'} =~ /(\d+)/) { 1040 $serverlogslocktimeout = $1 if($1 >= 0); 1041 } 1042 } 1043 if($serverlogslocktimeout) { 1044 my $lockretry = $serverlogslocktimeout * 20; 1045 my @locks; 1046 while((@locks = logslocked()) && $lockretry--) { 1047 portable_sleep(0.05); 1048 } 1049 if(($lockretry < 0) && 1050 ($serverlogslocktimeout >= $defserverlogslocktimeout)) { 1051 logmsg "Warning: server logs lock timeout ", 1052 "($serverlogslocktimeout seconds) expired (locks: " . 1053 join(", ", @locks) . ")\n"; 1054 } 1055 } 1056 1057 # Test harness ssh server does not have this synchronization mechanism, 1058 # this implies that some ssh server based tests might need a small delay 1059 # once that the client command has run to avoid false test failures. 1060 # 1061 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv 1062 # based tests might need a small delay once that the client command has 1063 # run to avoid false test failures. 1064 my $postcommanddelay = $defpostcommanddelay; 1065 if($cmdhash{'delay'}) { 1066 # test is allowed to specify a delay after command is executed 1067 if($cmdhash{'delay'} =~ /(\d+)/) { 1068 $postcommanddelay = $1 if($1 > 0); 1069 } 1070 } 1071 1072 portable_sleep($postcommanddelay) if($postcommanddelay); 1073 1074 # timestamp removal of server logs advisor read lock 1075 $$testtimings{"timesrvrlog"} = Time::HiRes::time(); 1076 1077 # test definition might instruct to stop some servers 1078 # stop also all servers relative to the given one 1079 1080 my @killtestservers = getpart("client", "killserver"); 1081 if(@killtestservers) { 1082 foreach my $server (@killtestservers) { 1083 chomp $server; 1084 if(stopserver($server)) { 1085 logmsg " $testnum: killserver FAILED\n"; 1086 return 1; # normal error if asked to fail on unexpected alive 1087 } 1088 } 1089 } 1090 return 0; 1091} 1092 1093####################################################################### 1094# Verify that the postcheck succeeded 1095sub singletest_postcheck { 1096 my ($testnum)=@_; 1097 1098 # run the postcheck command 1099 my @postcheck= getpart("client", "postcheck"); 1100 if(@postcheck) { 1101 my $cmd = join("", @postcheck); 1102 chomp $cmd; 1103 if($cmd) { 1104 logmsg "postcheck $cmd\n" if($verbose); 1105 my $rc = runclient("$cmd"); 1106 # Must run the postcheck command in torture mode in order 1107 # to clean up, but the result can't be relied upon. 1108 if($rc != 0 && !$torture) { 1109 logmsg " $testnum: postcheck FAILED\n"; 1110 return -1; 1111 } 1112 } 1113 } 1114 return 0; 1115} 1116 1117 1118 1119################################################################### 1120# Get ready to run a single test case 1121sub runner_test_preprocess { 1122 my ($testnum)=@_; 1123 my %testtimings; 1124 1125 if(clearlogs()) { 1126 logmsg "Warning: log messages were lost\n"; 1127 } 1128 1129 # timestamp test preparation start 1130 # TODO: this metric now shows only a portion of the prep time; better would 1131 # be to time singletest_preprocess below instead 1132 $testtimings{"timeprepini"} = Time::HiRes::time(); 1133 1134 ################################################################### 1135 # Load test metadata 1136 # ignore any error here--if there were one, it would have been 1137 # caught during the selection phase and this test would not be 1138 # running now 1139 loadtest("${TESTDIR}/test${testnum}"); 1140 readtestkeywords(); 1141 1142 ################################################################### 1143 # Restore environment variables that were modified in a previous run. 1144 # Test definition may instruct to (un)set environment vars. 1145 restore_test_env(1); 1146 1147 ################################################################### 1148 # Start the servers needed to run this test case 1149 my ($why, $error) = singletest_startservers($testnum, \%testtimings); 1150 1151 if(!$why) { 1152 1153 ############################################################### 1154 # Generate preprocessed test file 1155 # This must be done after the servers are started so server 1156 # variables are available for substitution. 1157 singletest_preprocess($testnum); 1158 1159 ############################################################### 1160 # Set up the test environment to run this test case 1161 singletest_setenv(); 1162 1163 ############################################################### 1164 # Check that the test environment is fine to run this test case 1165 if (!$listonly) { 1166 $why = singletest_precheck($testnum); 1167 $error = -1; 1168 } 1169 } 1170 return ($why, $error, clearlogs(), \%testtimings); 1171} 1172 1173 1174################################################################### 1175# Run a single test case with an environment that already been prepared 1176# Returns 0=success, -1=skippable failure, -2=permanent error, 1177# 1=unskippable test failure, as first integer, plus any log messages, 1178# plus more return values when error is 0 1179sub runner_test_run { 1180 my ($testnum)=@_; 1181 1182 if(clearlogs()) { 1183 logmsg "Warning: log messages were lost\n"; 1184 } 1185 1186 ####################################################################### 1187 # Prepare the test environment to run this test case 1188 my $error = singletest_prepare($testnum); 1189 if($error) { 1190 return (-2, clearlogs()); 1191 } 1192 1193 ####################################################################### 1194 # Run the test command 1195 my %testtimings; 1196 my $cmdres; 1197 my $dumped_core; 1198 my $CURLOUT; 1199 my $tool; 1200 my $usedvalgrind; 1201 ($error, $cmdres, $dumped_core, $CURLOUT, $tool, $usedvalgrind) = singletest_run($testnum, \%testtimings); 1202 if($error) { 1203 return (-2, clearlogs(), \%testtimings); 1204 } 1205 1206 ####################################################################### 1207 # Clean up after test command 1208 $error = singletest_clean($testnum, $dumped_core, \%testtimings); 1209 if($error) { 1210 return ($error, clearlogs(), \%testtimings); 1211 } 1212 1213 ####################################################################### 1214 # Verify that the postcheck succeeded 1215 $error = singletest_postcheck($testnum); 1216 if($error) { 1217 return ($error, clearlogs(), \%testtimings); 1218 } 1219 1220 ####################################################################### 1221 # restore environment variables that were modified 1222 restore_test_env(0); 1223 1224 return (0, clearlogs(), \%testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind); 1225} 1226 1227# Async call runner_clearlocks 1228# Called by controller 1229sub runnerac_clearlocks { 1230 return controlleripccall(\&runner_clearlocks, @_); 1231} 1232 1233# Async call runner_shutdown 1234# This call does NOT generate an IPC response and must be the last IPC call 1235# received. 1236# Called by controller 1237sub runnerac_shutdown { 1238 my ($runnerid)=$_[0]; 1239 my $err = controlleripccall(\&runner_shutdown, @_); 1240 1241 # These have no more use 1242 close($controllerw{$runnerid}); 1243 undef $controllerw{$runnerid}; 1244 close($controllerr{$runnerid}); 1245 undef $controllerr{$runnerid}; 1246 return $err; 1247} 1248 1249# Async call of runner_stopservers 1250# Called by controller 1251sub runnerac_stopservers { 1252 return controlleripccall(\&runner_stopservers, @_); 1253} 1254 1255# Async call of runner_test_preprocess 1256# Called by controller 1257sub runnerac_test_preprocess { 1258 return controlleripccall(\&runner_test_preprocess, @_); 1259} 1260 1261# Async call of runner_test_run 1262# Called by controller 1263sub runnerac_test_run { 1264 return controlleripccall(\&runner_test_run, @_); 1265} 1266 1267################################################################### 1268# Call an arbitrary function via IPC 1269# The first argument is the function reference, the second is the runner ID 1270# Returns 0 on success, -1 on error writing to runner 1271# Called by controller (indirectly, via a more specific function) 1272sub controlleripccall { 1273 my $funcref = shift @_; 1274 my $runnerid = shift @_; 1275 # Get the name of the function from the reference 1276 my $cv = svref_2object($funcref); 1277 my $gv = $cv->GV; 1278 # Prepend the name to the function arguments so it's marshalled along with them 1279 unshift @_, $gv->NAME; 1280 # Marshall the arguments into a flat string 1281 my $margs = freeze \@_; 1282 1283 # Send IPC call via pipe 1284 my $err; 1285 while(! defined ($err = syswrite($controllerw{$runnerid}, (pack "L", length($margs)) . $margs)) || $err <= 0) { 1286 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1287 # Runner has likely died 1288 return -1; 1289 } 1290 # system call was interrupted, probably by ^C; restart it so we stay in sync 1291 } 1292 1293 if(!$multiprocess) { 1294 # Call the remote function here in single process mode 1295 ipcrecv(); 1296 } 1297 return 0; 1298} 1299 1300################################################################### 1301# Receive async response of a previous call via IPC 1302# The first return value is the runner ID or undef on error 1303# Called by controller 1304sub runnerar { 1305 my ($runnerid) = @_; 1306 my $err; 1307 my $datalen; 1308 while(! defined ($err = sysread($controllerr{$runnerid}, $datalen, 4)) || $err <= 0) { 1309 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1310 # Runner is likely dead and closed the pipe 1311 return undef; 1312 } 1313 # system call was interrupted, probably by ^C; restart it so we stay in sync 1314 } 1315 my $len=unpack("L", $datalen); 1316 my $buf; 1317 while(! defined ($err = sysread($controllerr{$runnerid}, $buf, $len)) || $err <= 0) { 1318 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1319 # Runner is likely dead and closed the pipe 1320 return undef; 1321 } 1322 # system call was interrupted, probably by ^C; restart it so we stay in sync 1323 } 1324 1325 # Decode response values 1326 my $resarrayref = thaw $buf; 1327 1328 # First argument is runner ID 1329 # TODO: remove this; it's unneeded since it's passed in 1330 unshift @$resarrayref, $runnerid; 1331 return @$resarrayref; 1332} 1333 1334################################################################### 1335# Returns runner ID if a response from an async call is ready or error 1336# First value is ready, second is error, however an error case shows up 1337# as ready in Linux, so you can't trust it. 1338# argument is 0 for nonblocking, undef for blocking, anything else for timeout 1339# Called by controller 1340sub runnerar_ready { 1341 my ($blocking) = @_; 1342 my $rin = ""; 1343 my %idbyfileno; 1344 my $maxfileno=0; 1345 foreach my $p (keys(%controllerr)) { 1346 my $fd = fileno($controllerr{$p}); 1347 vec($rin, $fd, 1) = 1; 1348 $idbyfileno{$fd} = $p; # save the runner ID for each pipe fd 1349 if($fd > $maxfileno) { 1350 $maxfileno = $fd; 1351 } 1352 } 1353 $maxfileno || die "Internal error: no runners are available to wait on\n"; 1354 1355 # Wait for any pipe from any runner to be ready 1356 # This may be interrupted and return EINTR, but this is ignored and the 1357 # caller will need to later call this function again. 1358 # TODO: this is relatively slow with hundreds of fds 1359 my $ein = $rin; 1360 if(select(my $rout=$rin, undef, my $eout=$ein, $blocking) >= 1) { 1361 for my $fd (0..$maxfileno) { 1362 # Return an error condition first in case it's both 1363 if(vec($eout, $fd, 1)) { 1364 return (undef, $idbyfileno{$fd}); 1365 } 1366 if(vec($rout, $fd, 1)) { 1367 return ($idbyfileno{$fd}, undef); 1368 } 1369 } 1370 die "Internal pipe readiness inconsistency\n"; 1371 } 1372 return (undef, undef); 1373} 1374 1375 1376################################################################### 1377# Cleanly abort and exit the runner 1378# This uses print since there is no longer any controller to write logs. 1379sub runnerabort{ 1380 print "Controller is gone: runner $$ for $LOGDIR exiting\n"; 1381 my ($error, $logs) = runner_stopservers(); 1382 print $logs; 1383 runner_shutdown(); 1384} 1385 1386################################################################### 1387# Receive an IPC call in the runner and execute it 1388# The IPC is read from the $runnerr pipe and the response is 1389# written to the $runnerw pipe 1390# Returns 0 if more IPC calls are expected or 1 if the runner should exit 1391sub ipcrecv { 1392 my $err; 1393 my $datalen; 1394 while(! defined ($err = sysread($runnerr, $datalen, 4)) || $err <= 0) { 1395 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1396 # pipe has closed; controller is gone and we must exit 1397 runnerabort(); 1398 # Special case: no response will be forthcoming 1399 return 1; 1400 } 1401 # system call was interrupted, probably by ^C; restart it so we stay in sync 1402 } 1403 my $len=unpack("L", $datalen); 1404 my $buf; 1405 while(! defined ($err = sysread($runnerr, $buf, $len)) || $err <= 0) { 1406 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1407 # pipe has closed; controller is gone and we must exit 1408 runnerabort(); 1409 # Special case: no response will be forthcoming 1410 return 1; 1411 } 1412 # system call was interrupted, probably by ^C; restart it so we stay in sync 1413 } 1414 1415 # Decode the function name and arguments 1416 my $argsarrayref = thaw $buf; 1417 1418 # The name of the function to call is the first argument 1419 my $funcname = shift @$argsarrayref; 1420 1421 # print "ipcrecv $funcname\n"; 1422 # Synchronously call the desired function 1423 my @res; 1424 if($funcname eq "runner_clearlocks") { 1425 @res = runner_clearlocks(@$argsarrayref); 1426 } 1427 elsif($funcname eq "runner_shutdown") { 1428 runner_shutdown(@$argsarrayref); 1429 # Special case: no response will be forthcoming 1430 return 1; 1431 } 1432 elsif($funcname eq "runner_stopservers") { 1433 @res = runner_stopservers(@$argsarrayref); 1434 } 1435 elsif($funcname eq "runner_test_preprocess") { 1436 @res = runner_test_preprocess(@$argsarrayref); 1437 } 1438 elsif($funcname eq "runner_test_run") { 1439 @res = runner_test_run(@$argsarrayref); 1440 } else { 1441 die "Unknown IPC function $funcname\n"; 1442 } 1443 # print "ipcrecv results\n"; 1444 1445 # Marshall the results to return 1446 $buf = freeze \@res; 1447 1448 while(! defined ($err = syswrite($runnerw, (pack "L", length($buf)) . $buf)) || $err <= 0) { 1449 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1450 # pipe has closed; controller is gone and we must exit 1451 runnerabort(); 1452 # Special case: no response will be forthcoming 1453 return 1; 1454 } 1455 # system call was interrupted, probably by ^C; restart it so we stay in sync 1456 } 1457 1458 return 0; 1459} 1460 1461################################################################### 1462# Kill the server processes that still have lock files in a directory 1463sub runner_clearlocks { 1464 my ($lockdir)=@_; 1465 if(clearlogs()) { 1466 logmsg "Warning: log messages were lost\n"; 1467 } 1468 clearlocks($lockdir); 1469 return clearlogs(); 1470} 1471 1472 1473################################################################### 1474# Kill all server processes 1475sub runner_stopservers { 1476 my $error = stopservers($verbose); 1477 my $logs = clearlogs(); 1478 return ($error, $logs); 1479} 1480 1481################################################################### 1482# Shut down this runner 1483sub runner_shutdown { 1484 close($runnerr); 1485 undef $runnerr; 1486 close($runnerw); 1487 undef $runnerw; 1488} 1489 1490 14911; 1492
