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-time "; 861 if($run_event_based) { 862 $cmdargs .= "--test-event "; 863 $fail_due_event_based--; 864 } 865 $cmdargs .= $cmd; 866 if ($proxy_address) { 867 $cmdargs .= " --proxy $proxy_address "; 868 } 869 } 870 else { 871 $cmdargs = " $cmd"; # $cmd is the command line for the test file 872 $CURLOUT = stdoutfilename($LOGDIR, $testnum); # sends received data to stdout 873 874 # Default the tool to a unit test with the same name as the test spec 875 if($keywords{"unittest"} && !$tool) { 876 $tool="unit$testnum"; 877 } 878 879 if($tool =~ /^lib/) { 880 $CMDLINE="$LIBDIR/$tool"; 881 } 882 elsif($tool =~ /^unit/) { 883 $CMDLINE="$UNITDIR/$tool"; 884 } 885 886 if(! -f $CMDLINE) { 887 logmsg " $testnum: IGNORED: The tool set in the test case for this: '$tool' does not exist\n"; 888 return (-1, 0, 0, "", "", 0); 889 } 890 $DBGCURL=$CMDLINE; 891 } 892 893 if($fail_due_event_based) { 894 logmsg " $testnum: IGNORED: This test cannot run event based\n"; 895 return (-1, 0, 0, "", "", 0); 896 } 897 898 if($gdbthis) { 899 # gdb is incompatible with valgrind, so disable it when debugging 900 # Perhaps a better approach would be to run it under valgrind anyway 901 # with --db-attach=yes or --vgdb=yes. 902 $disablevalgrind=1; 903 } 904 905 my @stdintest = getpart("client", "stdin"); 906 907 if(@stdintest) { 908 my $stdinfile="$LOGDIR/stdin-for-$testnum"; 909 910 my %hash = getpartattr("client", "stdin"); 911 if($hash{'nonewline'}) { 912 # cut off the final newline from the final line of the stdin data 913 chomp($stdintest[-1]); 914 } 915 916 writearray($stdinfile, \@stdintest); 917 918 $cmdargs .= " <$stdinfile"; 919 } 920 921 if(!$tool) { 922 $CMDLINE=shell_quote($CURL); 923 if((!$cmdhash{'option'}) || ($cmdhash{'option'} !~ /no-q/)) { 924 $CMDLINE .= " -q"; 925 } 926 } 927 928 if(use_valgrind() && !$disablevalgrind) { 929 my $valgrindcmd = "$valgrind "; 930 $valgrindcmd .= "$valgrind_tool " if($valgrind_tool); 931 $valgrindcmd .= "--quiet --leak-check=yes "; 932 $valgrindcmd .= "--suppressions=$srcdir/valgrind.supp "; 933 # $valgrindcmd .= "--gen-suppressions=all "; 934 $valgrindcmd .= "--num-callers=16 "; 935 $valgrindcmd .= "${valgrind_logfile}=$LOGDIR/valgrind$testnum"; 936 $CMDLINE = "$valgrindcmd $CMDLINE"; 937 } 938 939 $CMDLINE .= "$cmdargs > " . stdoutfilename($LOGDIR, $testnum) . 940 " 2> " . stderrfilename($LOGDIR, $testnum); 941 942 if($verbose) { 943 logmsg "$CMDLINE\n"; 944 } 945 946 open(my $cmdlog, ">", $CURLLOG) || die "Failure writing log file"; 947 print $cmdlog "$CMDLINE\n"; 948 close($cmdlog) || die "Failure writing log file"; 949 950 my $dumped_core; 951 my $cmdres; 952 953 if($gdbthis) { 954 my $gdbinit = "$TESTDIR/gdbinit$testnum"; 955 open(my $gdbcmd, ">", "$LOGDIR/gdbcmd") || die "Failure writing gdb file"; 956 if($gdbthis == 1) { 957 # gdb mode 958 print $gdbcmd "set args $cmdargs\n"; 959 print $gdbcmd "show args\n"; 960 print $gdbcmd "source $gdbinit\n" if -e $gdbinit; 961 } 962 else { 963 # lldb mode 964 print $gdbcmd "set args $cmdargs\n"; 965 } 966 close($gdbcmd) || die "Failure writing gdb file"; 967 } 968 969 # Flush output. 970 $| = 1; 971 972 # timestamp starting of test command 973 $$testtimings{"timetoolini"} = Time::HiRes::time(); 974 975 # run the command line we built 976 if ($torture) { 977 $cmdres = torture($CMDLINE, 978 $testnum, 979 "$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " -x $LOGDIR/gdbcmd"); 980 } 981 elsif($gdbthis == 1) { 982 # gdb 983 my $GDBW = ($gdbxwin) ? "-w" : ""; 984 runclient("$gdb --directory $LIBDIR " . shell_quote($DBGCURL) . " $GDBW -x $LOGDIR/gdbcmd"); 985 $cmdres=0; # makes it always continue after a debugged run 986 } 987 elsif($gdbthis == 2) { 988 # $gdb is "lldb" 989 print "runs lldb -- $CURL $cmdargs\n"; 990 runclient("lldb -- $CURL $cmdargs"); 991 $cmdres=0; # makes it always continue after a debugged run 992 } 993 else { 994 # Convert the raw result code into a more useful one 995 ($cmdres, $dumped_core) = normalize_cmdres(runclient("$CMDLINE")); 996 } 997 998 # timestamp finishing of test command 999 $$testtimings{"timetoolend"} = Time::HiRes::time(); 1000 1001 return (0, $cmdres, $dumped_core, $CURLOUT, $tool, use_valgrind() && !$disablevalgrind); 1002} 1003 1004 1005####################################################################### 1006# Clean up after test command 1007sub singletest_clean { 1008 my ($testnum, $dumped_core, $testtimings)=@_; 1009 1010 if(!$dumped_core) { 1011 if(-r "core") { 1012 # there's core file present now! 1013 $dumped_core = 1; 1014 } 1015 } 1016 1017 if($dumped_core) { 1018 logmsg "core dumped\n"; 1019 if(0 && $gdb) { 1020 logmsg "running gdb for post-mortem analysis:\n"; 1021 open(my $gdbcmd, ">", "$LOGDIR/gdbcmd2") || die "Failure writing gdb file"; 1022 print $gdbcmd "bt\n"; 1023 close($gdbcmd) || die "Failure writing gdb file"; 1024 runclient("$gdb --directory libtest -x $LOGDIR/gdbcmd2 -batch " . shell_quote($DBGCURL) . " core "); 1025 # unlink("$LOGDIR/gdbcmd2"); 1026 } 1027 } 1028 1029 # If a server logs advisor read lock file exists, it is an indication 1030 # that the server has not yet finished writing out all its log files, 1031 # including server request log files used for protocol verification. 1032 # So, if the lock file exists the script waits here a certain amount 1033 # of time until the server removes it, or the given time expires. 1034 my $serverlogslocktimeout = $defserverlogslocktimeout; 1035 my %cmdhash = getpartattr("client", "command"); 1036 if($cmdhash{'timeout'}) { 1037 # test is allowed to override default server logs lock timeout 1038 if($cmdhash{'timeout'} =~ /(\d+)/) { 1039 $serverlogslocktimeout = $1 if($1 >= 0); 1040 } 1041 } 1042 if($serverlogslocktimeout) { 1043 my $lockretry = $serverlogslocktimeout * 20; 1044 my @locks; 1045 while((@locks = logslocked()) && $lockretry--) { 1046 portable_sleep(0.05); 1047 } 1048 if(($lockretry < 0) && 1049 ($serverlogslocktimeout >= $defserverlogslocktimeout)) { 1050 logmsg "Warning: server logs lock timeout ", 1051 "($serverlogslocktimeout seconds) expired (locks: " . 1052 join(", ", @locks) . ")\n"; 1053 } 1054 } 1055 1056 # Test harness ssh server does not have this synchronization mechanism, 1057 # this implies that some ssh server based tests might need a small delay 1058 # once that the client command has run to avoid false test failures. 1059 # 1060 # gnutls-serv also lacks this synchronization mechanism, so gnutls-serv 1061 # based tests might need a small delay once that the client command has 1062 # run to avoid false test failures. 1063 my $postcommanddelay = $defpostcommanddelay; 1064 if($cmdhash{'delay'}) { 1065 # test is allowed to specify a delay after command is executed 1066 if($cmdhash{'delay'} =~ /(\d+)/) { 1067 $postcommanddelay = $1 if($1 > 0); 1068 } 1069 } 1070 1071 portable_sleep($postcommanddelay) if($postcommanddelay); 1072 1073 # timestamp removal of server logs advisor read lock 1074 $$testtimings{"timesrvrlog"} = Time::HiRes::time(); 1075 1076 # test definition might instruct to stop some servers 1077 # stop also all servers relative to the given one 1078 1079 my @killtestservers = getpart("client", "killserver"); 1080 if(@killtestservers) { 1081 foreach my $server (@killtestservers) { 1082 chomp $server; 1083 if(stopserver($server)) { 1084 logmsg " $testnum: killserver FAILED\n"; 1085 return 1; # normal error if asked to fail on unexpected alive 1086 } 1087 } 1088 } 1089 return 0; 1090} 1091 1092####################################################################### 1093# Verify that the postcheck succeeded 1094sub singletest_postcheck { 1095 my ($testnum)=@_; 1096 1097 # run the postcheck command 1098 my @postcheck= getpart("client", "postcheck"); 1099 if(@postcheck) { 1100 my $cmd = join("", @postcheck); 1101 chomp $cmd; 1102 if($cmd) { 1103 logmsg "postcheck $cmd\n" if($verbose); 1104 my $rc = runclient("$cmd"); 1105 # Must run the postcheck command in torture mode in order 1106 # to clean up, but the result can't be relied upon. 1107 if($rc != 0 && !$torture) { 1108 logmsg " $testnum: postcheck FAILED\n"; 1109 return -1; 1110 } 1111 } 1112 } 1113 return 0; 1114} 1115 1116 1117 1118################################################################### 1119# Get ready to run a single test case 1120sub runner_test_preprocess { 1121 my ($testnum)=@_; 1122 my %testtimings; 1123 1124 if(clearlogs()) { 1125 logmsg "Warning: log messages were lost\n"; 1126 } 1127 1128 # timestamp test preparation start 1129 # TODO: this metric now shows only a portion of the prep time; better would 1130 # be to time singletest_preprocess below instead 1131 $testtimings{"timeprepini"} = Time::HiRes::time(); 1132 1133 ################################################################### 1134 # Load test metadata 1135 # ignore any error here--if there were one, it would have been 1136 # caught during the selection phase and this test would not be 1137 # running now 1138 loadtest("${TESTDIR}/test${testnum}"); 1139 readtestkeywords(); 1140 1141 ################################################################### 1142 # Restore environment variables that were modified in a previous run. 1143 # Test definition may instruct to (un)set environment vars. 1144 restore_test_env(1); 1145 1146 ################################################################### 1147 # Start the servers needed to run this test case 1148 my ($why, $error) = singletest_startservers($testnum, \%testtimings); 1149 1150 if(!$why) { 1151 1152 ############################################################### 1153 # Generate preprocessed test file 1154 # This must be done after the servers are started so server 1155 # variables are available for substitution. 1156 singletest_preprocess($testnum); 1157 1158 ############################################################### 1159 # Set up the test environment to run this test case 1160 singletest_setenv(); 1161 1162 ############################################################### 1163 # Check that the test environment is fine to run this test case 1164 if (!$listonly) { 1165 $why = singletest_precheck($testnum); 1166 $error = -1; 1167 } 1168 } 1169 return ($why, $error, clearlogs(), \%testtimings); 1170} 1171 1172 1173################################################################### 1174# Run a single test case with an environment that already been prepared 1175# Returns 0=success, -1=skippable failure, -2=permanent error, 1176# 1=unskippable test failure, as first integer, plus any log messages, 1177# plus more return values when error is 0 1178sub runner_test_run { 1179 my ($testnum)=@_; 1180 1181 if(clearlogs()) { 1182 logmsg "Warning: log messages were lost\n"; 1183 } 1184 1185 ####################################################################### 1186 # Prepare the test environment to run this test case 1187 my $error = singletest_prepare($testnum); 1188 if($error) { 1189 return (-2, clearlogs()); 1190 } 1191 1192 ####################################################################### 1193 # Run the test command 1194 my %testtimings; 1195 my $cmdres; 1196 my $dumped_core; 1197 my $CURLOUT; 1198 my $tool; 1199 my $usedvalgrind; 1200 ($error, $cmdres, $dumped_core, $CURLOUT, $tool, $usedvalgrind) = singletest_run($testnum, \%testtimings); 1201 if($error) { 1202 return (-2, clearlogs(), \%testtimings); 1203 } 1204 1205 ####################################################################### 1206 # Clean up after test command 1207 $error = singletest_clean($testnum, $dumped_core, \%testtimings); 1208 if($error) { 1209 return ($error, clearlogs(), \%testtimings); 1210 } 1211 1212 ####################################################################### 1213 # Verify that the postcheck succeeded 1214 $error = singletest_postcheck($testnum); 1215 if($error) { 1216 return ($error, clearlogs(), \%testtimings); 1217 } 1218 1219 ####################################################################### 1220 # restore environment variables that were modified 1221 restore_test_env(0); 1222 1223 return (0, clearlogs(), \%testtimings, $cmdres, $CURLOUT, $tool, $usedvalgrind); 1224} 1225 1226# Async call runner_clearlocks 1227# Called by controller 1228sub runnerac_clearlocks { 1229 return controlleripccall(\&runner_clearlocks, @_); 1230} 1231 1232# Async call runner_shutdown 1233# This call does NOT generate an IPC response and must be the last IPC call 1234# received. 1235# Called by controller 1236sub runnerac_shutdown { 1237 my ($runnerid)=$_[0]; 1238 my $err = controlleripccall(\&runner_shutdown, @_); 1239 1240 # These have no more use 1241 close($controllerw{$runnerid}); 1242 undef $controllerw{$runnerid}; 1243 close($controllerr{$runnerid}); 1244 undef $controllerr{$runnerid}; 1245 return $err; 1246} 1247 1248# Async call of runner_stopservers 1249# Called by controller 1250sub runnerac_stopservers { 1251 return controlleripccall(\&runner_stopservers, @_); 1252} 1253 1254# Async call of runner_test_preprocess 1255# Called by controller 1256sub runnerac_test_preprocess { 1257 return controlleripccall(\&runner_test_preprocess, @_); 1258} 1259 1260# Async call of runner_test_run 1261# Called by controller 1262sub runnerac_test_run { 1263 return controlleripccall(\&runner_test_run, @_); 1264} 1265 1266################################################################### 1267# Call an arbitrary function via IPC 1268# The first argument is the function reference, the second is the runner ID 1269# Returns 0 on success, -1 on error writing to runner 1270# Called by controller (indirectly, via a more specific function) 1271sub controlleripccall { 1272 my $funcref = shift @_; 1273 my $runnerid = shift @_; 1274 # Get the name of the function from the reference 1275 my $cv = svref_2object($funcref); 1276 my $gv = $cv->GV; 1277 # Prepend the name to the function arguments so it's marshalled along with them 1278 unshift @_, $gv->NAME; 1279 # Marshall the arguments into a flat string 1280 my $margs = freeze \@_; 1281 1282 # Send IPC call via pipe 1283 my $err; 1284 while(! defined ($err = syswrite($controllerw{$runnerid}, (pack "L", length($margs)) . $margs)) || $err <= 0) { 1285 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1286 # Runner has likely died 1287 return -1; 1288 } 1289 # system call was interrupted, probably by ^C; restart it so we stay in sync 1290 } 1291 1292 if(!$multiprocess) { 1293 # Call the remote function here in single process mode 1294 ipcrecv(); 1295 } 1296 return 0; 1297} 1298 1299################################################################### 1300# Receive async response of a previous call via IPC 1301# The first return value is the runner ID or undef on error 1302# Called by controller 1303sub runnerar { 1304 my ($runnerid) = @_; 1305 my $err; 1306 my $datalen; 1307 while(! defined ($err = sysread($controllerr{$runnerid}, $datalen, 4)) || $err <= 0) { 1308 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1309 # Runner is likely dead and closed the pipe 1310 return undef; 1311 } 1312 # system call was interrupted, probably by ^C; restart it so we stay in sync 1313 } 1314 my $len=unpack("L", $datalen); 1315 my $buf; 1316 while(! defined ($err = sysread($controllerr{$runnerid}, $buf, $len)) || $err <= 0) { 1317 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1318 # Runner is likely dead and closed the pipe 1319 return undef; 1320 } 1321 # system call was interrupted, probably by ^C; restart it so we stay in sync 1322 } 1323 1324 # Decode response values 1325 my $resarrayref = thaw $buf; 1326 1327 # First argument is runner ID 1328 # TODO: remove this; it's unneeded since it's passed in 1329 unshift @$resarrayref, $runnerid; 1330 return @$resarrayref; 1331} 1332 1333################################################################### 1334# Returns runner ID if a response from an async call is ready or error 1335# First value is ready, second is error, however an error case shows up 1336# as ready in Linux, so you can't trust it. 1337# argument is 0 for nonblocking, undef for blocking, anything else for timeout 1338# Called by controller 1339sub runnerar_ready { 1340 my ($blocking) = @_; 1341 my $rin = ""; 1342 my %idbyfileno; 1343 my $maxfileno=0; 1344 foreach my $p (keys(%controllerr)) { 1345 my $fd = fileno($controllerr{$p}); 1346 vec($rin, $fd, 1) = 1; 1347 $idbyfileno{$fd} = $p; # save the runner ID for each pipe fd 1348 if($fd > $maxfileno) { 1349 $maxfileno = $fd; 1350 } 1351 } 1352 $maxfileno || die "Internal error: no runners are available to wait on\n"; 1353 1354 # Wait for any pipe from any runner to be ready 1355 # This may be interrupted and return EINTR, but this is ignored and the 1356 # caller will need to later call this function again. 1357 # TODO: this is relatively slow with hundreds of fds 1358 my $ein = $rin; 1359 if(select(my $rout=$rin, undef, my $eout=$ein, $blocking) >= 1) { 1360 for my $fd (0..$maxfileno) { 1361 # Return an error condition first in case it's both 1362 if(vec($eout, $fd, 1)) { 1363 return (undef, $idbyfileno{$fd}); 1364 } 1365 if(vec($rout, $fd, 1)) { 1366 return ($idbyfileno{$fd}, undef); 1367 } 1368 } 1369 die "Internal pipe readiness inconsistency\n"; 1370 } 1371 return (undef, undef); 1372} 1373 1374 1375################################################################### 1376# Cleanly abort and exit the runner 1377# This uses print since there is no longer any controller to write logs. 1378sub runnerabort{ 1379 print "Controller is gone: runner $$ for $LOGDIR exiting\n"; 1380 my ($error, $logs) = runner_stopservers(); 1381 print $logs; 1382 runner_shutdown(); 1383} 1384 1385################################################################### 1386# Receive an IPC call in the runner and execute it 1387# The IPC is read from the $runnerr pipe and the response is 1388# written to the $runnerw pipe 1389# Returns 0 if more IPC calls are expected or 1 if the runner should exit 1390sub ipcrecv { 1391 my $err; 1392 my $datalen; 1393 while(! defined ($err = sysread($runnerr, $datalen, 4)) || $err <= 0) { 1394 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1395 # pipe has closed; controller is gone and we must exit 1396 runnerabort(); 1397 # Special case: no response will be forthcoming 1398 return 1; 1399 } 1400 # system call was interrupted, probably by ^C; restart it so we stay in sync 1401 } 1402 my $len=unpack("L", $datalen); 1403 my $buf; 1404 while(! defined ($err = sysread($runnerr, $buf, $len)) || $err <= 0) { 1405 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1406 # pipe has closed; controller is gone and we must exit 1407 runnerabort(); 1408 # Special case: no response will be forthcoming 1409 return 1; 1410 } 1411 # system call was interrupted, probably by ^C; restart it so we stay in sync 1412 } 1413 1414 # Decode the function name and arguments 1415 my $argsarrayref = thaw $buf; 1416 1417 # The name of the function to call is the first argument 1418 my $funcname = shift @$argsarrayref; 1419 1420 # print "ipcrecv $funcname\n"; 1421 # Synchronously call the desired function 1422 my @res; 1423 if($funcname eq "runner_clearlocks") { 1424 @res = runner_clearlocks(@$argsarrayref); 1425 } 1426 elsif($funcname eq "runner_shutdown") { 1427 runner_shutdown(@$argsarrayref); 1428 # Special case: no response will be forthcoming 1429 return 1; 1430 } 1431 elsif($funcname eq "runner_stopservers") { 1432 @res = runner_stopservers(@$argsarrayref); 1433 } 1434 elsif($funcname eq "runner_test_preprocess") { 1435 @res = runner_test_preprocess(@$argsarrayref); 1436 } 1437 elsif($funcname eq "runner_test_run") { 1438 @res = runner_test_run(@$argsarrayref); 1439 } else { 1440 die "Unknown IPC function $funcname\n"; 1441 } 1442 # print "ipcrecv results\n"; 1443 1444 # Marshall the results to return 1445 $buf = freeze \@res; 1446 1447 while(! defined ($err = syswrite($runnerw, (pack "L", length($buf)) . $buf)) || $err <= 0) { 1448 if((!defined $err && ! $!{EINTR}) || (defined $err && $err == 0)) { 1449 # pipe has closed; controller is gone and we must exit 1450 runnerabort(); 1451 # Special case: no response will be forthcoming 1452 return 1; 1453 } 1454 # system call was interrupted, probably by ^C; restart it so we stay in sync 1455 } 1456 1457 return 0; 1458} 1459 1460################################################################### 1461# Kill the server processes that still have lock files in a directory 1462sub runner_clearlocks { 1463 my ($lockdir)=@_; 1464 if(clearlogs()) { 1465 logmsg "Warning: log messages were lost\n"; 1466 } 1467 clearlocks($lockdir); 1468 return clearlogs(); 1469} 1470 1471 1472################################################################### 1473# Kill all server processes 1474sub runner_stopservers { 1475 my $error = stopservers($verbose); 1476 my $logs = clearlogs(); 1477 return ($error, $logs); 1478} 1479 1480################################################################### 1481# Shut down this runner 1482sub runner_shutdown { 1483 close($runnerr); 1484 undef $runnerr; 1485 close($runnerw); 1486 undef $runnerw; 1487} 1488 1489 14901; 1491
