neo/curl/tests/runtests.pl

   1 #!/usr/bin/env perl
   2 #***************************************************************************
   3 #                                  _   _ ____  _
   4 #  Project                     ___| | | |  _ \| |
   5 #                             / __| | | | |_) | |
   6 #                            | (__| |_| |  _ <| |___
   7 #                             \___|\___/|_| \_\_____|
   8 #
   9 # Copyright (C) 1998 - 2004, Daniel Stenberg, <daniel@haxx.se>, et al.
  10 #
  11 # This software is licensed as described in the file COPYING, which
  12 # you should have received as part of this distribution. The terms
  13 # are also available at http://curl.haxx.se/docs/copyright.html.
  14 #
  15 # You may opt to use, copy, modify, merge, publish, distribute and/or sell
  16 # copies of the Software, and permit persons to whom the Software is
  17 # furnished to do so, under the terms of the COPYING file.
  18 #
  19 # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
  20 # KIND, either express or implied.
  21 #
  22 # $Id: runtests.pl,v 1.111 2004/03/01 16:24:54 bagder Exp $
  23 ###########################################################################
  24 # These should be the only variables that might be needed to get edited:
  25
  26 use strict;
  27 #use warnings;
  28
  29 @INC=(@INC, $ENV{'srcdir'}, ".");
  30
  31 require "getpart.pm"; # array functions
  32
  33 my $srcdir = $ENV{'srcdir'} || '.';
  34 my $HOSTIP="127.0.0.1";
  35 my $HOSTPORT=8999; # bad name, but this is the HTTP server port
  36 my $HTTPSPORT=8433; # this is the HTTPS server port
  37 my $FTPPORT=8921;  # this is the FTP server port
  38 my $FTPSPORT=8821;  # this is the FTPS server port
  39 my $CURL="../src/curl"; # what curl executable to run on the tests
  40 my $DBGCURL=$CURL; #"../src/.libs/curl";  # alternative for debugging
  41 my $LOGDIR="log";
  42 my $TESTDIR="$srcdir/data";
  43 my $LIBDIR="./libtest";
  44 my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
  45 my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
  46 my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here
  47
  48 # Normally, all test cases should be run, but at times it is handy to
  49 # simply run a particular one:
  50 my $TESTCASES="all";
  51
  52 # To run specific test cases, set them like:
  53 # $TESTCASES="1 2 3 7 8";
  54
  55 #######################################################################
  56 # No variables below this point should need to be modified
  57 #
  58
  59 my $HTTPPIDFILE=".http.pid";
  60 my $HTTPSPIDFILE=".https.pid";
  61 my $FTPPIDFILE=".ftp.pid";
  62 my $FTPSPIDFILE=".ftps.pid";
  63
  64 # invoke perl like this:
  65 my $perl="perl -I$srcdir";
  66
  67 # this gets set if curl is compiled with debugging:
  68 my $curl_debug=0;
  69
  70 # name of the file that the memory debugging creates:
  71 my $memdump="memdump";
  72
  73 # the path to the script that analyzes the memory debug output file:
  74 my $memanalyze="./memanalyze.pl";
  75
  76 my $stunnel = checkcmd("stunnel");
  77 my $valgrind = checkcmd("valgrind");
  78
  79 my $ssl_version; # set if libcurl is built with SSL support
  80 my $large_file;  # set if libcurl is built with large file support
  81
  82 my $skipped=0;  # number of tests skipped; reported in main loop
  83 my %skipped;    # skipped{reason}=counter, reasons for skip
  84 my @teststat;   # teststat[testnum]=reason, reasons for skip
  85
  86 #######################################################################
  87 # variables the command line options may set
  88 #
  89
  90 my $short;
  91 my $verbose;
  92 my $debugprotocol;
  93 my $anyway;
  94 my $gdbthis;      # run test case with gdb debugger
  95 my $keepoutfiles; # keep stdout and stderr files after tests
  96 my $listonly;     # only list the tests
  97
  98 my $pwd;          # current working directory
  99
 100 my %run;          # running server
 101
 102 # torture test variables
 103 my $torture;
 104 my $tortnum;
 105 my $tortalloc;
 106
 107 chomp($pwd = `pwd`);
 108
 109 # enable memory debugging if curl is compiled with it
 110 $ENV{'CURL_MEMDEBUG'} = 1;
 111 $ENV{'HOME'}=$pwd;
 112
 113 ##########################################################################
 114 # Clear all possible '*_proxy' environment variables for various protocols
 115 # to prevent them to interfere with our testing!
 116
 117 my $protocol;
 118 foreach $protocol (('ftp', 'http', 'ftps', 'https', 'gopher', 'no')) {
 119     my $proxy = "${protocol}_proxy";
 120     # clear lowercase version
 121     $ENV{$proxy}=undef;
 122     # clear uppercase version
 123     $ENV{uc($proxy)}=undef;
 124 }
 125
 126 #######################################################################
 127 # Check for a command in the PATH.
 128 #
 129 sub checkcmd {
 130     my ($cmd)=@_;
 131     my @paths=("/usr/sbin", "/usr/local/sbin", "/sbin", "/usr/bin",
 132                "/usr/local/bin", split(":", $ENV{'PATH'}));
 133     for(@paths) {
 134         if( -x "$_/$cmd") {
 135             return "$_/$cmd";
 136         }
 137     }
 138 }
 139
 140 #######################################################################
 141 # Return the pid of the server as found in the given pid file
 142 #
 143 sub serverpid {
 144     my $PIDFILE = $_[0];
 145     open(PFILE, "<$PIDFILE");
 146     my $PID=0+<PFILE>;
 147     close(PFILE);
 148     return $PID;
 149 }
 150
 151 #######################################################################
 152 # Memory allocation test and failure torture testing.
 153 #
 154 sub torture {
 155     # start all test servers (http, https, ftp, ftps)
 156     &startservers(("http", "https", "ftp", "ftps"));
 157     my $c;
 158
 159     my @test=('http://%HOSTIP:%HOSTPORT/1',
 160               'ftp://%HOSTIP:%FTPPORT/');
 161
 162     # loop over the different tests commands
 163     for(@test) {
 164         my $cmdargs = "$_";
 165
 166         $c++;
 167
 168         if($tortnum && ($tortnum != $c)) {
 169             next;
 170         }
 171         print "We want test $c\n";
 172
 173         my $redir=">log/torture.stdout 2>log/torture.stderr";
 174
 175         subVariables(\$cmdargs);
 176
 177         my $testcmd = "$CURL $cmdargs $redir";
 178
 179         # First get URL from test server, ignore the output/result
 180         system($testcmd);
 181
 182         # Set up gdb-stuff if desired
 183         if($gdbthis) {
 184             open(GDBCMD, ">log/gdbcmd");
 185             print GDBCMD "set args $cmdargs\n";
 186             print GDBCMD "show args\n";
 187             close(GDBCMD);
 188             $testcmd = "gdb $CURL -x log/gdbcmd";
 189         }
 190
 191         print "Torture test $c:\n";
 192         print " CMD: $testcmd\n" if($verbose);
 193
 194         # memanalyze -v is our friend, get the number of allocations made
 195         my $count;
 196         my @out = `$memanalyze -v $memdump`;
 197         for(@out) {
 198             if(/^Allocations: (\d+)/) {
 199                 $count = $1;
 200                 last;
 201             }
 202         }
 203         if(!$count) {
 204             # hm, no allocations in this fetch, ignore and get next
 205             print "BEEEP, no allocs found for test $c!!!\n";
 206             next;
 207         }
 208         print " $count allocations to excersize\n";
 209
 210         for ( 1 .. $count ) {
 211             my $limit = $_;
 212             my $fail;
 213
 214             if($tortalloc && ($tortalloc != $limit)) {
 215                 next;
 216             }
 217
 218             print "Alloc no: $limit\r" if(!$gdbthis);
 219
 220             # make the memory allocation function number $limit return failure
 221             $ENV{'CURL_MEMLIMIT'} = $limit;
 222
 223             # remove memdump first to be sure we get a new nice and clean one
 224             unlink($memdump);
 225
 226             print "**> Alloc number $limit is now set to fail <**\n" if($gdbthis);
 227
 228             my $ret = system($testcmd);
 229
 230             # verify that it returns a proper error code, doesn't leak memory
 231             # and doesn't core dump
 232             if($ret & 255) {
 233                 print " system() returned $ret\n";
 234                 $fail=1;
 235             }
 236             else {
 237                 my @memdata=`$memanalyze $memdump`;
 238                 my $leak=0;
 239                 for(@memdata) {
 240                     if($_ ne "") {
 241                         # well it could be other memory problems as well, but
 242                         # we call it leak for short here
 243                         $leak=1;
 244                     }
 245                 }
 246                 if($leak) {
 247                     print "** MEMORY FAILURE\n";
 248                     print @memdata;
 249                     print `$memanalyze -l $memdump`;
 250                     $fail = 1;
 251                 }
 252             }
 253             if($fail) {
 254                 print " Failed on alloc number $limit in test $c.\n",
 255                 " invoke with -t$c,$limit to repeat this single case.\n";
 256                 stopservers();
 257                 exit 1;
 258             }
 259         }
 260         print "\n torture test $c did GOOD\n";
 261
 262         # all is well, now test a different kind of URL
 263     }
 264     stopservers();
 265     exit; # for now, we stop after these tests
 266 }
 267
 268 #######################################################################
 269 # stop the given test server
 270 #
 271 sub stopserver {
 272     my $pid = $_[0];
 273     # check for pidfile
 274     if ( -f $pid ) {
 275         my $PIDFILE = $pid;
 276         $pid = serverpid($PIDFILE);
 277         unlink $PIDFILE; # server is killed
 278     }
 279     elsif($pid <= 0) {
 280         return; # this is not a good pid
 281     }
 282
 283     my $res = kill (9, $pid); # die!
 284
 285     if($res && $verbose) {
 286         print "RUN: Test server pid $pid signalled to die\n";
 287     }
 288     elsif($verbose) {
 289         print "RUN: Test server pid $pid didn't exist\n";
 290     }
 291 }
 292
 293 #######################################################################
 294 # check the given test server if it is still alive
 295 #
 296 sub checkserver {
 297     my ($pidfile)=@_;
 298     my $pid=0;
 299
 300     # check for pidfile
 301     if ( -f $pidfile ) {
 302         $pid=serverpid($pidfile);
 303         if ($pid ne "" && kill(0, $pid)) {
 304             return $pid;
 305         }
 306         else {
 307             return -$pid; # negative means dead process
 308         }
 309     }
 310     return 0;
 311 }
 312
 313 #######################################################################
 314 # start the http server, or if it already runs, verify that it is our
 315 # test server on the test-port!
 316 #
 317 sub runhttpserver {
 318     my $verbose = $_[0];
 319     my $RUNNING;
 320     my $pid;
 321
 322     $pid = checkserver ($HTTPPIDFILE);
 323
 324     # verify if our/any server is running on this port
 325     my $cmd = "$CURL -o log/verifiedserver --silent -i $HOSTIP:$HOSTPORT/verifiedserver 2>/dev/null";
 326     print "CMD; $cmd\n" if ($verbose);
 327     my $res = system($cmd);
 328
 329     $res >>= 8; # rotate the result
 330     my $data;
 331
 332     print "RUN: curl command returned $res\n" if ($verbose);
 333
 334     open(FILE, "<log/verifiedserver");
 335     my @file=<FILE>;
 336     close(FILE);
 337     $data=$file[0]; # first line
 338
 339     if ( $data =~ /WE ROOLZ: (\d+)/ ) {
 340         $pid = 0+$1;
 341     }
 342     elsif($data || ($res != 7)) {
 343         print "RUN: Unknown HTTP server is running on port $HOSTPORT\n";
 344         return -2;
 345     }
 346
 347     if($pid > 0) {
 348         my $res = kill (9, $pid); # die!
 349         if(!$res) {
 350             print "RUN: Failed to kill test HTTP server, do it manually and",
 351             " restart the tests.\n";
 352             exit;
 353         }
 354         sleep(1);
 355     }
 356
 357     my $flag=$debugprotocol?"-v ":"";
 358     my $dir=$ENV{'srcdir'};
 359     if($dir) {
 360         $flag .= "-d \"$dir\" ";
 361     }
 362     $cmd="$perl $srcdir/httpserver.pl $flag $HOSTPORT &";
 363     system($cmd);
 364     if($verbose) {
 365         print "CMD: $cmd\n";
 366     }
 367
 368     my $verified;
 369     for(1 .. 10) {
 370         # verify that our server is up and running:
 371         my $data=`$CURL --silent -i $HOSTIP:$HOSTPORT/verifiedserver 2>/dev/null`;
 372
 373         if ( $data =~ /WE ROOLZ: (\d+)/ ) {
 374             $pid = 0+$1;
 375             $verified = 1;
 376             last;
 377         }
 378         else {
 379             if($verbose) {
 380                 print STDERR "RUN: Retrying HTTP server existence in 3 sec\n";
 381             }
 382             sleep(3);
 383             next;
 384         }
 385     }
 386     if(!$verified) {
 387         print STDERR "RUN: failed to start our HTTP server\n";
 388         return -1;
 389     }
 390
 391     if($verbose) {
 392         print "RUN: HTTP server is now verified to be our server\n";
 393     }
 394
 395     return $pid;
 396 }
 397
 398 #######################################################################
 399 # start the https server (or rather, tunnel) if needed
 400 #
 401 sub runhttpsserver {
 402     my $verbose = $_[0];
 403     my $STATUS;
 404     my $RUNNING;
 405
 406     if(!$stunnel) {
 407         return 0;
 408     }
 409
 410     my $pid=checkserver($HTTPSPIDFILE );
 411
 412     if($pid > 0) {
 413         # kill previous stunnel!
 414         if($verbose) {
 415             print "RUN: kills off running stunnel at $pid\n";
 416         }
 417         stopserver($HTTPSPIDFILE);
 418     }
 419
 420     my $flag=$debugprotocol?"-v ":"";
 421     my $cmd="$perl $srcdir/httpsserver.pl $flag -s \"$stunnel\" -d $srcdir -r $HOSTPORT $HTTPSPORT &";
 422     system($cmd);
 423     if($verbose) {
 424         print "CMD: $cmd\n";
 425     }
 426     sleep(1);
 427
 428     for(1 .. 10) {
 429         $pid=checkserver($HTTPSPIDFILE);
 430
 431         if($pid <= 0) {
 432             if($verbose) {
 433                 print STDERR "RUN: waiting 3 sec for HTTPS server\n";
 434             }
 435             sleep(3);
 436         }
 437         else {
 438             last;
 439         }
 440     }
 441
 442     return $pid;
 443 }
 444
 445 #######################################################################
 446 # start the ftp server if needed
 447 #
 448 sub runftpserver {
 449     my $verbose = $_[0];
 450     my $STATUS;
 451     my $RUNNING;
 452     # check for pidfile
 453     my $pid = checkserver ($FTPPIDFILE );
 454
 455     if ($pid <= 0) {
 456         print "RUN: Check port $FTPPORT for our own FTP server\n"
 457             if ($verbose);
 458
 459
 460         my $time=time();
 461         # check if this is our server running on this port:
 462         my $data=`$CURL -m4 --silent -i ftp://$HOSTIP:$FTPPORT/verifiedserver 2>/dev/null`;
 463
 464         # if this took more than 2 secs, we assume it "hung" on a weird server
 465         my $took = time()-$time;
 466
 467         if ( $data =~ /WE ROOLZ: (\d+)/ ) {
 468             # this is our test server with a known pid!
 469             $pid = 0+$1;
 470         }
 471         else {
 472             if($data || ($took > 2)) {
 473                 # this is not a known server
 474                 print "RUN: Unknown server on our favourite port: $FTPPORT\n";
 475                 return -1;
 476             }
 477         }
 478     }
 479
 480     if($pid > 0) {
 481         print "RUN: Killing a previous server using pid $pid\n" if($verbose);
 482         my $res = kill (9, $pid); # die!
 483         if(!$res) {
 484             print "RUN: Failed to kill our FTP test server, do it manually and",
 485             " restart the tests.\n";
 486             return -1;
 487         }
 488         sleep(1);
 489     }
 490
 491     # now (re-)start our server:
 492     my $flag=$debugprotocol?"-v ":"";
 493     $flag .= "-s \"$srcdir\"";
 494     my $cmd="$perl $srcdir/ftpserver.pl $flag $FTPPORT &";
 495     if($verbose) {
 496         print "CMD: $cmd\n";
 497     }
 498     system($cmd);
 499
 500     my $verified;
 501     for(1 .. 10) {
 502         # verify that our server is up and running:
 503         my $data=`$CURL --silent -i ftp://$HOSTIP:$FTPPORT/verifiedserver 2>/dev/null`;
 504
 505         if ( $data =~ /WE ROOLZ: (\d+)/ ) {
 506             $pid = 0+$1;
 507             $verified = 1;
 508             last;
 509         }
 510         else {
 511             if($verbose) {
 512                 print STDERR "RUN: Retrying FTP server existence in 3 sec\n";
 513             }
 514             sleep(3);
 515             next;
 516         }
 517     }
 518     if(!$verified) {
 519         warn "RUN: failed to start our FTP server\n";
 520         return -2;
 521     }
 522
 523     if($verbose) {
 524         print "RUN: FTP server is now verified to be our server\n";
 525     }
 526
 527     return $pid;
 528 }
 529
 530 #######################################################################
 531 # start the ftps server (or rather, tunnel) if needed
 532 #
 533 sub runftpsserver {
 534     my $verbose = $_[0];
 535     my $STATUS;
 536     my $RUNNING;
 537
 538     if(!$stunnel) {
 539         return 0;
 540     }
 541     my $pid=checkserver($FTPSPIDFILE );
 542
 543     if($pid > 0) {
 544         # kill previous stunnel!
 545         if($verbose) {
 546             print "kills off running stunnel at $pid\n";
 547         }
 548         stopserver($FTPSPIDFILE);
 549     }
 550
 551     my $flag=$debugprotocol?"-v ":"";
 552     my $cmd="$perl $srcdir/ftpsserver.pl $flag -s \"$stunnel\" -d $srcdir -r $FTPPORT $FTPSPORT &";
 553     system($cmd);
 554     if($verbose) {
 555         print "CMD: $cmd\n";
 556     }
 557     sleep(1);
 558
 559     for(1 .. 10) {
 560
 561         $pid=checkserver($FTPSPIDFILE );
 562
 563         if($pid <= 0) {
 564             if($verbose) {
 565                 print STDERR "RUN: waiting 3 sec for FTPS server\n";
 566             }
 567             sleep(3);
 568         }
 569         else {
 570             last;
 571         }
 572     }
 573
 574     return $pid;
 575 }
 576
 577 #######################################################################
 578 # Remove all files in the specified directory
 579 #
 580 sub cleardir {
 581     my $dir = $_[0];
 582     my $count;
 583     my $file;
 584
 585     # Get all files
 586     opendir(DIR, $dir) ||
 587         return 0; # can't open dir
 588     while($file = readdir(DIR)) {
 589         if($file !~ /^\./) {
 590             unlink("$dir/$file");
 591             $count++;
 592         }
 593     }
 594     closedir DIR;
 595     return $count;
 596 }
 597
 598 #######################################################################
 599 # filter out the specified pattern from the given input file and store the
 600 # results in the given output file
 601 #
 602 sub filteroff {
 603     my $infile=$_[0];
 604     my $filter=$_[1];
 605     my $ofile=$_[2];
 606
 607     open(IN, "<$infile")
 608         || return 1;
 609
 610     open(OUT, ">$ofile")
 611         || return 1;
 612
 613     # print "FILTER: off $filter from $infile to $ofile\n";
 614
 615     while(<IN>) {
 616         $_ =~ s/$filter//;
 617         print OUT $_;
 618     }
 619     close(IN);
 620     close(OUT);
 621     return 0;
 622 }
 623
 624 #######################################################################
 625 # compare test results with the expected output, we might filter off
 626 # some pattern that is allowed to differ, output test results
 627 #
 628
 629 sub compare {
 630     # filter off patterns _before_ this comparison!
 631     my ($subject, $firstref, $secondref)=@_;
 632
 633     my $result = compareparts($firstref, $secondref);
 634
 635     if($result) {
 636         if(!$short) {
 637             print "\n $subject FAILED:\n";
 638             print showdiff($firstref, $secondref);
 639         }
 640         else {
 641             print "FAILED\n";
 642         }
 643     }
 644     return $result;
 645 }
 646
 647 #######################################################################
 648 # display information about curl and the host the test suite runs on
 649 #
 650 sub checkcurl {
 651
 652     unlink($memdump); # remove this if there was one left
 653
 654     my $curl;
 655     my $libcurl;
 656     my @version=`$CURL -V 2>/dev/null`;
 657     for(@version) {
 658         chomp;
 659
 660         if($_ =~ /^curl/) {
 661             $curl = $_;
 662
 663             $curl =~ s/^(.*)(libcurl.*)/$1/g;
 664             $libcurl = $2;
 665
 666            if ($curl =~ /win32/)
 667            {
 668                # Native Windows builds don't understand the
 669                # output of cygwin's pwd.  It will be
 670                # something like /cygdrive/c/<some path>.
 671                #
 672                # Use the cygpath utility to convert the
 673                # working directory to a Windows friendly
 674                # path.  The -m option converts to use drive
 675                # letter:, but it uses / instead \.  Forward
 676                # slashes (/) are easier for us.  We don't
 677                # have to escape them to get them to curl
 678                # through a shell.
 679                chomp($pwd = `cygpath -m $pwd`);
 680            }
 681         }
 682         elsif($_ =~ /^Protocols: (.*)/i) {
 683             # these are the supported protocols, we don't use this knowledge
 684             # at this point
 685         }
 686         elsif($_ =~ /^Features: (.*)/i) {
 687             my $feat = $1;
 688             if($feat =~ /debug/i) {
 689                 # debug is a listed "feature", use that knowledge
 690                 $curl_debug = 1;
 691                 # set the NETRC debug env
 692                 $ENV{'CURL_DEBUG_NETRC'} = 'log/netrc';
 693             }
 694             if($feat =~ /SSL/i) {
 695                 # ssl enabled
 696                 $ssl_version=1;
 697             }
 698             if($feat =~ /Largefile/i) {
 699                 # large file support
 700                 $large_file=1;
 701             }
 702         }
 703     }
 704     if(!$curl) {
 705         die "couldn't run curl!"
 706     }
 707
 708     my $hostname=`hostname`;
 709     my $hosttype=`uname -a`;
 710
 711     print "********* System characteristics ******** \n",
 712     "* $curl\n",
 713     "* $libcurl\n",
 714     "* Host: $hostname",
 715     "* System: $hosttype";
 716
 717     printf("* Server SSL:       %s\n", $stunnel?"ON":"OFF");
 718     printf("* libcurl SSL:      %s\n", $ssl_version?"ON":"OFF");
 719     printf("* libcurl debug:    %s\n", $curl_debug?"ON":"OFF");
 720     printf("* valgrind:         %s\n", $valgrind?"ON":"OFF");
 721     print "***************************************** \n";
 722 }
 723
 724 #######################################################################
 725 # substitute the variable stuff into either a joined up file or
 726 # a command, in either case passed by reference
 727 #
 728 sub subVariables {
 729   my ($thing) = @_;
 730   $$thing =~ s/%HOSTIP/$HOSTIP/g;
 731   $$thing =~ s/%HOSTPORT/$HOSTPORT/g;
 732   $$thing =~ s/%HTTPPORT/$HOSTPORT/g;
 733   $$thing =~ s/%HTTPSPORT/$HTTPSPORT/g;
 734   $$thing =~ s/%FTPPORT/$FTPPORT/g;
 735   $$thing =~ s/%FTPSPORT/$FTPSPORT/g;
 736   $$thing =~ s/%SRCDIR/$srcdir/g;
 737   $$thing =~ s/%PWD/$pwd/g;
 738 }
 739
 740 #######################################################################
 741 # Run a single specified test case
 742 #
 743
 744 sub singletest {
 745     my $testnum=$_[0];
 746
 747     my @what;
 748     my $why;
 749     my $serverproblem;
 750
 751     # load the test case file definition
 752     if(loadtest("${TESTDIR}/test${testnum}")) {
 753         if($verbose) {
 754             # this is not a test
 755             print "RUN: $testnum doesn't look like a test case!\n";
 756         }
 757         $serverproblem = 100;
 758     }
 759     else {
 760         @what = getpart("client", "features");
 761     }
 762
 763     printf("test %03d...", $testnum);
 764
 765     for(@what) {
 766         my $f = $_;
 767         $f =~ s/\s//g;
 768
 769         if($f eq "SSL") {
 770             if($ssl_version) {
 771                 next;
 772             }
 773         }
 774         elsif($f eq "netrc_debug") {
 775             if($curl_debug) {
 776                 next;
 777             }
 778         }
 779         elsif($f eq "large_file") {
 780             if($large_file) {
 781                 next;
 782             }
 783         }
 784
 785         $why = "curl lacks $f support";
 786         $serverproblem = 15; # set it here
 787         last;
 788     }
 789
 790     if(!$serverproblem) {
 791         $serverproblem = serverfortest($testnum);
 792     }
 793
 794     if($serverproblem) {
 795         # there's a problem with the server, don't run
 796         # this particular server, but count it as "skipped"
 797         if($serverproblem == 2) {
 798             $why = "server problems";
 799         }
 800         elsif($serverproblem == 100) {
 801             $why = "no test";
 802         }
 803         elsif($serverproblem == 99) {
 804             $why = "bad test";
 805         }
 806         elsif($serverproblem == 15) {
 807             # set above, a lacking prereq
 808         }
 809         elsif($serverproblem == 1) {
 810             $why = "no HTTPS server";
 811         }
 812         elsif($serverproblem == 3) {
 813             $why = "no FTPS server";
 814         }
 815         else {
 816             $why = "unfulfilled requirements";
 817         }
 818         $skipped++;
 819         $skipped{$why}++;
 820         $teststat[$testnum]=$why; # store reason for this test case
 821
 822         print "SKIPPED\n";
 823         if(!$short) {
 824             print "* Test $testnum: $why\n";
 825         }
 826
 827         return -1;
 828     }
 829
 830     # extract the reply data
 831     my @reply = getpart("reply", "data");
 832     my @replycheck = getpart("reply", "datacheck");
 833
 834     if (@replycheck) {
 835         # we use this file instead to check the final output against
 836
 837         my %hash = getpartattr("reply", "datacheck");
 838         if($hash{'nonewline'}) {
 839             # Yes, we must cut off the final newline from the final line
 840             # of the datacheck
 841             chomp($replycheck[$#replycheck]);
 842         }
 843
 844         @reply=@replycheck;
 845     }
 846
 847     # curl command to run
 848     my @curlcmd= getpart("client", "command");
 849
 850     # this is the valid protocol blurb curl should generate
 851     my @protocol= getpart("verify", "protocol");
 852
 853     # redirected stdout/stderr to these files
 854     $STDOUT="$LOGDIR/stdout$testnum";
 855     $STDERR="$LOGDIR/stderr$testnum";
 856
 857     # if this section exists, we verify that the stdout contained this:
 858     my @validstdout = getpart("verify", "stdout");
 859
 860     # if this section exists, we verify upload
 861     my @upload = getpart("verify", "upload");
 862
 863     # if this section exists, it is FTP server instructions:
 864     my @ftpservercmd = getpart("server", "instruction");
 865
 866     my $CURLOUT="$LOGDIR/curl$testnum.out"; # curl output if not stdout
 867
 868     # name of the test
 869     my @testname= getpart("client", "name");
 870
 871     if(!$short) {
 872         my $name = $testname[0];
 873         $name =~ s/\n//g;
 874         print "[$name]\n";
 875     }
 876
 877     if($listonly) {
 878         return 0; # look successful
 879     }
 880
 881     my @codepieces = getpart("client", "tool");
 882
 883     my $tool="";
 884     if(@codepieces) {
 885         $tool = $codepieces[0];
 886         chomp $tool;
 887     }
 888
 889     # remove previous server output logfile
 890     unlink($SERVERIN);
 891
 892     if(@ftpservercmd) {
 893         # write the instructions to file
 894         writearray($FTPDCMD, \@ftpservercmd);
 895     }
 896
 897     my (@setenv)= getpart("client", "setenv");
 898     my @envs;
 899
 900     my $s;
 901     for $s (@setenv) {
 902         chomp $s; # cut off the newline
 903
 904         subVariables \$s;
 905
 906         if($s =~ /([^=]*)=(.*)/) {
 907             my ($var, $content)=($1, $2);
 908             $ENV{$var}=$content;
 909             # remember which, so that we can clear them afterwards!
 910             push @envs, $var;
 911         }
 912     }
 913
 914     # get the command line options to use
 915     my ($cmd, @blaha)= getpart("client", "command");
 916
 917     # make some nice replace operations
 918     $cmd =~ s/\n//g; # no newlines please
 919
 920     # substitute variables in the command line
 921     subVariables \$cmd;
 922
 923     if($curl_debug) {
 924         unlink($memdump);
 925     }
 926
 927     my @inputfile=getpart("client", "file");
 928     if(@inputfile) {
 929         # we need to generate a file before this test is invoked
 930         my %hash = getpartattr("client", "file");
 931
 932         my $filename=$hash{'name'};
 933
 934         if(!$filename) {
 935             print "ERROR: section client=>file has no name attribute!\n";
 936             exit;
 937         }
 938         my $fileContent = join('', @inputfile);
 939         subVariables \$fileContent;
 940 #        print "DEBUG: writing file " . $filename . "\n";
 941         open OUTFILE, ">$filename";
 942         binmode OUTFILE; # for crapage systems, use binary
 943         print OUTFILE $fileContent;
 944         close OUTFILE;
 945     }
 946
 947     my %cmdhash = getpartattr("client", "command");
 948
 949     my $out="";
 950
 951     if($cmdhash{'option'} !~ /no-output/) {
 952         #We may slap on --output!
 953         if (!@validstdout) {
 954             $out=" --output $CURLOUT ";
 955         }
 956     }
 957
 958     my $cmdargs;
 959     if(!$tool) {
 960         # run curl, add -v for debug information output
 961         $cmdargs ="$out --include -v $cmd";
 962     }
 963     else {
 964         $cmdargs = " $cmd"; # $cmd is the command line for the test file
 965         $CURLOUT = $STDOUT; # sends received data to stdout
 966     }
 967
 968     my @stdintest = getpart("client", "stdin");
 969
 970     if(@stdintest) {
 971         my $stdinfile="$LOGDIR/stdin-for-$testnum";
 972         writearray($stdinfile, \@stdintest);
 973
 974         $cmdargs .= " <$stdinfile";
 975     }
 976     if($valgrind) {
 977         $cmdargs .= " 3>log/valgrind$testnum";
 978     }
 979     my $CMDLINE;
 980
 981     if(!$tool) {
 982         $CMDLINE="$CURL";
 983     }
 984     else {
 985         $CMDLINE="$LIBDIR/$tool";
 986         $DBGCURL=$CMDLINE;
 987     }
 988
 989     $CMDLINE .= "$cmdargs >>$STDOUT 2>>$STDERR";
 990
 991     if($verbose) {
 992         print "$CMDLINE\n";
 993    }
 994
 995     print CMDLOG "$CMDLINE\n";
 996
 997     my $cmdres;
 998     # run the command line we built
 999     if($gdbthis) {
1000         open(GDBCMD, ">log/gdbcmd");
1001         print GDBCMD "set args $cmdargs\n";
1002         print GDBCMD "show args\n";
1003         close(GDBCMD);
1004         system("gdb --directory libtest $DBGCURL -x log/gdbcmd");
1005         $cmdres=0; # makes it always continue after a debugged run
1006     }
1007     else {
1008         $cmdres = system("$CMDLINE");
1009         my $signal_num  = $cmdres & 127;
1010         my $dumped_core = $cmdres & 128;
1011
1012         if(!$anyway && ($signal_num || $dumped_core)) {
1013             $cmdres = 1000;
1014         }
1015         else {
1016             $cmdres /= 256;
1017         }
1018     }
1019
1020     # remove the special FTP command file after each test!
1021     unlink($FTPDCMD);
1022
1023     my $e;
1024     for $e (@envs) {
1025         $ENV{$e}=""; # clean up
1026     }
1027
1028     my @err = getpart("verify", "errorcode");
1029     my $errorcode = $err[0];
1030
1031     my $res;
1032     if (@validstdout) {
1033         # verify redirected stdout
1034         my @actual = loadarray($STDOUT);
1035
1036         $res = compare("stdout", \@actual, \@validstdout);
1037         if($res) {
1038             return 1;
1039         }
1040         if(!$short) {
1041             print " stdout OK";
1042         }
1043     }
1044
1045     my %replyattr = getpartattr("reply", "data");
1046     if(!$replyattr{'nocheck'} && @reply) {
1047         # verify the received data
1048         my @out = loadarray($CURLOUT);
1049         $res = compare("data", \@out, \@reply);
1050         if ($res) {
1051             return 1;
1052         }
1053         if(!$short) {
1054             print " data OK";
1055         }
1056     }
1057
1058     if(@upload) {
1059         # verify uploaded data
1060         my @out = loadarray("$LOGDIR/upload.$testnum");
1061         $res = compare("upload", \@out, \@upload);
1062         if ($res) {
1063             return 1;
1064         }
1065         if(!$short) {
1066             print " upload OK";
1067         }
1068     }
1069
1070     if(@protocol) {
1071         # verify the sent request
1072         my @out = loadarray($SERVERIN);
1073
1074         # what to cut off from the live protocol sent by curl
1075         my @strip = getpart("verify", "strip");
1076
1077         my @protstrip=@protocol;
1078
1079         # check if there's any attributes on the verify/protocol section
1080         my %hash = getpartattr("verify", "protocol");
1081
1082         if($hash{'nonewline'}) {
1083             # Yes, we must cut off the final newline from the final line
1084             # of the protocol data
1085             chomp($protstrip[$#protstrip]);
1086         }
1087
1088         for(@strip) {
1089             # strip all patterns from both arrays
1090             @out = striparray( $_, \@out);
1091             @protstrip= striparray( $_, \@protstrip);
1092         }
1093
1094         $res = compare("protocol", \@out, \@protstrip);
1095         if($res) {
1096             return 1;
1097         }
1098         if(!$short) {
1099             print " protocol OK";
1100         }
1101     }
1102
1103     my @outfile=getpart("verify", "file");
1104     if(@outfile) {
1105         # we're supposed to verify a dynamicly generated file!
1106         my %hash = getpartattr("verify", "file");
1107
1108         my $filename=$hash{'name'};
1109         if(!$filename) {
1110             print "ERROR: section verify=>file has no name attribute!\n";
1111             exit;
1112         }
1113         my @generated=loadarray($filename);
1114
1115         $res = compare("output", \@generated, \@outfile);
1116         if($res) {
1117             return 1;
1118         }
1119         if(!$short) {
1120             print " output OK";
1121         }
1122     }
1123
1124     if($errorcode || $cmdres) {
1125         if($errorcode == $cmdres) {
1126             $errorcode =~ s/\n//;
1127             if($verbose) {
1128                 print " received errorcode $errorcode OK";
1129             }
1130             elsif(!$short) {
1131                 print " error OK";
1132             }
1133         }
1134         else {
1135             if(!$short) {
1136                 print "curl returned $cmdres, ".(0+$errorcode)." was expected\n";
1137             }
1138             print " error FAILED\n";
1139             return 1;
1140         }
1141     }
1142
1143     if(!$keepoutfiles) {
1144         # remove the stdout and stderr files
1145         unlink($STDOUT);
1146         unlink($STDERR);
1147         unlink($CURLOUT); # remove the downloaded results
1148
1149         unlink("$LOGDIR/upload.$testnum");  # remove upload leftovers
1150     }
1151
1152     unlink($FTPDCMD); # remove the instructions for this test
1153
1154     @what = getpart("client", "killserver");
1155     for(@what) {
1156         my $serv = $_;
1157         chomp $serv;
1158         if($run{$serv}) {
1159             stopserver($run{$serv}); # the pid file is in the hash table
1160             $run{$serv}=0; # clear pid
1161         }
1162         else {
1163             print STDERR "RUN: The $serv server is not running\n";
1164         }
1165     }
1166
1167     if($curl_debug) {
1168         if(! -f $memdump) {
1169             print "\n** ALERT! memory debuggin without any output file?\n";
1170         }
1171         else {
1172             my @memdata=`$memanalyze $memdump`;
1173             my $leak=0;
1174             for(@memdata) {
1175                 if($_ ne "") {
1176                     # well it could be other memory problems as well, but
1177                     # we call it leak for short here
1178                     $leak=1;
1179                 }
1180             }
1181             if($leak) {
1182                 print "\n** MEMORY FAILURE\n";
1183                 print @memdata;
1184                 return 1;
1185             }
1186             else {
1187                 if(!$short) {
1188                     print " memory OK";
1189                 }
1190             }
1191         }
1192     }
1193     if($short) {
1194         print "OK";
1195     }
1196     print "\n";
1197
1198     return 0;
1199 }
1200
1201 #######################################################################
1202 # Stop all running test servers
1203 sub stopservers {
1204     print "Shutting down test suite servers:\n" if ($verbose);
1205     for(keys %run) {
1206         printf ("* kill pid for %-5s => %-5d\n", $_, $run{$_}) if($verbose);
1207         stopserver($run{$_}); # the pid file is in the hash table
1208     }
1209 }
1210
1211 #######################################################################
1212 # startservers() starts all the named servers
1213 #
1214 sub startservers {
1215     my @what = @_;
1216     my $pid;
1217     for(@what) {
1218         my $what = lc($_);
1219         $what =~ s/[^a-z]//g;
1220         if($what eq "ftp") {
1221             if(!$run{'ftp'}) {
1222                 $pid = runftpserver($verbose);
1223                 if($pid <= 0) {
1224                     return 2; # error starting it
1225                 }
1226                 printf ("* pid ftp => %-5d\n", $pid) if($verbose);
1227                 $run{'ftp'}=$pid;
1228             }
1229         }
1230         elsif($what eq "http") {
1231             if(!$run{'http'}) {
1232                 $pid = runhttpserver($verbose);
1233                 if($pid <= 0) {
1234                     return 2; # error starting
1235                 }
1236                 printf ("* pid http => %-5d\n", $pid) if($verbose);
1237                 $run{'http'}=$pid;
1238             }
1239         }
1240         elsif($what eq "ftps") {
1241             if(!$stunnel || !$ssl_version) {
1242                 # we can't run ftps tests without stunnel
1243                 # or if libcurl is SSL-less
1244                 return 3;
1245             }
1246             if(!$run{'ftp'}) {
1247                 $pid = runftpserver($verbose);
1248                 if($pid <= 0) {
1249                     return 2; # error starting it
1250                 }
1251                 $run{'ftp'}=$pid;
1252             }
1253             if(!$run{'ftps'}) {
1254                 return 2;
1255
1256                 $pid = runftpsserver($verbose);
1257                 if($pid <= 0) {
1258                     return 2;
1259                 }
1260                 printf ("* pid ftps => %-5d\n", $pid) if($verbose);
1261                 $run{'ftps'}=$pid;
1262             }
1263         }
1264         elsif($what eq "file") {
1265             # we support it but have no server!
1266         }
1267         elsif($what eq "https") {
1268             if(!$stunnel || !$ssl_version) {
1269                 # we can't run https tests without stunnel
1270                 # or if libcurl is SSL-less
1271                 return 1;
1272             }
1273             if(!$run{'http'}) {
1274                 $pid = runhttpserver($verbose);
1275                 if($pid <= 0) {
1276                     return 2; # problems starting server
1277                 }
1278                 $run{'http'}=$pid;
1279             }
1280             if(!$run{'https'}) {
1281                 $pid = runhttpsserver($verbose);
1282                 if($pid <= 0) {
1283                     return 2;
1284                 }
1285                 printf ("* pid https => %-5d\n", $pid) if($verbose);
1286                 $run{'https'}=$pid;
1287             }
1288         }
1289         elsif($what eq "none") {
1290         }
1291         else {
1292             warn "we don't support a server for $what";
1293         }
1294     }
1295     return 0;
1296 }
1297
1298 ##############################################################################
1299 # This function makes sure the right set of server is running for the
1300 # specified test case. This is a useful design when we run single tests as not
1301 # all servers need to run then!
1302 #
1303 # Returns:
1304 # 100 if this is not a test case
1305 # 99  if this test case has no servers specified
1306 # 3   if this test is skipped due to no FTPS server
1307 # 2   if one of the required servers couldn't be started
1308 # 1   if this test is skipped due to no HTTPS server
1309
1310 sub serverfortest {
1311     my ($testnum)=@_;
1312
1313     # load the test case file definition
1314     if(loadtest("${TESTDIR}/test${testnum}")) {
1315         if($verbose) {
1316             # this is not a test
1317             print "$testnum doesn't look like a test case!\n";
1318         }
1319         return 100;
1320     }
1321
1322     my @what = getpart("client", "server");
1323
1324     if(!$what[0]) {
1325         warn "Test case $testnum has no server(s) specified!";
1326         return 99;
1327     }
1328
1329     return &startservers(@what);
1330 }
1331
1332 #######################################################################
1333 # Check options to this test program
1334 #
1335
1336 my $number=0;
1337 my $fromnum=-1;
1338 my @testthis;
1339 do {
1340     if ($ARGV[0] eq "-v") {
1341         # verbose output
1342         $verbose=1;
1343     }
1344     elsif ($ARGV[0] eq "-c") {
1345         # use this path to curl instead of default
1346         $CURL=$ARGV[1];
1347         shift @ARGV;
1348     }
1349     elsif ($ARGV[0] eq "-d") {
1350         # have the servers display protocol output
1351         $debugprotocol=1;
1352     }
1353     elsif ($ARGV[0] eq "-g") {
1354         # run this test with gdb
1355         $gdbthis=1;
1356     }
1357     elsif($ARGV[0] eq "-s") {
1358         # short output
1359         $short=1;
1360     }
1361     elsif($ARGV[0] eq "-n") {
1362         # no valgrind
1363         undef $valgrind;
1364     }
1365     elsif($ARGV[0] =~ /^-t(.*)/) {
1366         # torture
1367         $torture=1;
1368         my $xtra = $1;
1369         if($xtra =~ s/^(\d+)//) {
1370             $tortnum = $1;
1371         }
1372         if($xtra =~ s/(\d+)$//) {
1373             $tortalloc = $1;
1374         }
1375     }
1376     elsif($ARGV[0] eq "-a") {
1377         # continue anyway, even if a test fail
1378         $anyway=1;
1379     }
1380     elsif($ARGV[0] eq "-l") {
1381         # lists the test case names only
1382         $listonly=1;
1383     }
1384     elsif($ARGV[0] eq "-k") {
1385         # keep stdout and stderr files after tests
1386         $keepoutfiles=1;
1387     }
1388     elsif($ARGV[0] eq "-h") {
1389         # show help text
1390         print <<EOHELP
1391 Usage: runtests.pl [options]
1392   -a       continue even if a test fails
1393   -d       display server debug info
1394   -g       run the test case with gdb
1395   -h       this help text
1396   -k       keep stdout and stderr files present after tests
1397   -l       list all test case names/descriptions
1398   -n       No valgrind
1399   -s       short output
1400   -t       torture
1401   -v       verbose output
1402   [num]    like "5 6 9" or " 5 to 22 " to run those tests only
1403 EOHELP
1404     ;
1405         exit;
1406     }
1407     elsif($ARGV[0] =~ /^(\d+)/) {
1408         $number = $1;
1409         if($fromnum >= 0) {
1410             for($fromnum .. $number) {
1411                 push @testthis, $_;
1412             }
1413             $fromnum = -1;
1414         }
1415         else {
1416             push @testthis, $1;
1417         }
1418     }
1419     elsif($ARGV[0] =~ /^to$/i) {
1420         $fromnum = $number+1;
1421     }
1422 } while(shift @ARGV);
1423
1424 if($testthis[0] ne "") {
1425     $TESTCASES=join(" ", @testthis);
1426 }
1427
1428 if($valgrind) {
1429     # we have found valgrind on the host, use it
1430
1431     # verify that we can invoke it fine
1432     my $code = system("valgrind >/dev/null 2>&1");
1433
1434     if(($code>>8) != 1) {
1435         #print "Valgrind failure, disable it\n";
1436         undef $valgrind;
1437     }
1438     else {
1439         $CURL="valgrind --leak-check=yes --logfile-fd=3 -q $CURL";
1440     }
1441 }
1442
1443 #######################################################################
1444 # Output curl version and host info being tested
1445 #
1446
1447 if(!$listonly) {
1448     checkcurl();
1449 }
1450
1451 #######################################################################
1452 # clear and create logging directory:
1453 #
1454 cleardir($LOGDIR);
1455 mkdir($LOGDIR, 0777);
1456
1457 #######################################################################
1458 # If 'all' tests are requested, find out all test numbers
1459 #
1460
1461 if ( $TESTCASES eq "all") {
1462     # Get all commands and find out their test numbers
1463     opendir(DIR, $TESTDIR) || die "can't opendir $TESTDIR: $!";
1464     my @cmds = grep { /^test([0-9]+)$/ && -f "$TESTDIR/$_" } readdir(DIR);
1465     closedir DIR;
1466
1467     $TESTCASES=""; # start with no test cases
1468
1469     # cut off everything but the digits
1470     for(@cmds) {
1471         $_ =~ s/[a-z\/\.]*//g;
1472     }
1473     # the the numbers from low to high
1474     for(sort { $a <=> $b } @cmds) {
1475         $TESTCASES .= " $_";
1476     }
1477 }
1478
1479 #######################################################################
1480 # Start the command line log
1481 #
1482 open(CMDLOG, ">$CURLLOG") ||
1483     print "can't log command lines to $CURLLOG\n";
1484
1485 #######################################################################
1486 # Torture the memory allocation system and checks
1487 #
1488 if($torture) {
1489     &torture();
1490 }
1491 #######################################################################
1492 # The main test-loop
1493 #
1494
1495 my $failed;
1496 my $testnum;
1497 my $ok=0;
1498 my $total=0;
1499 my $lasttest;
1500
1501 foreach $testnum (split(" ", $TESTCASES)) {
1502
1503     $lasttest = $testnum if($testnum > $lasttest);
1504
1505     my $error = singletest($testnum);
1506     if($error < 0) {
1507         # not a test we can run
1508         next;
1509     }
1510
1511     $total++; # number of tests we've run
1512
1513     if($error>0) {
1514         $failed.= "$testnum ";
1515         if(!$anyway) {
1516             # a test failed, abort
1517             print "\n - abort tests\n";
1518             last;
1519         }
1520     }
1521     elsif(!$error) {
1522         $ok++; # successful test counter
1523     }
1524
1525     # loop for next test
1526 }
1527
1528 #######################################################################
1529 # Close command log
1530 #
1531 close(CMDLOG);
1532
1533
1534 # Tests done, stop the servers
1535 stopservers();
1536
1537 my $all = $total + $skipped;
1538
1539 if($total) {
1540     printf("TESTDONE: $ok tests out of $total reported OK: %d%%\n",
1541            $ok/$total*100);
1542
1543     if($ok != $total) {
1544         print "TESTFAIL: These test cases failed: $failed\n";
1545     }
1546 }
1547 else {
1548     print "TESTFAIL: No tests were performed!\n";
1549 }
1550
1551 if($all) {
1552     print "TESTDONE: $all tests were considered.\n";
1553 }
1554
1555 if($skipped) {
1556     my $s=0;
1557     print "TESTINFO: $skipped tests were skipped due to these restraints:\n";
1558
1559     for(keys %skipped) {
1560         my $r = $_;
1561         printf "TESTINFO: \"%s\" %d times (", $r, $skipped{$_};
1562
1563         # now show all test case numbers that had this reason for being
1564         # skipped
1565         my $c=0;
1566         for(0 .. $lasttest) {
1567             my $t = $_;
1568             if($teststat[$_] eq $r) {
1569                 print ", " if($c);
1570                 print $_;
1571                 $c++;
1572             }
1573         }
1574         print ")\n";
1575     }
1576 }
1577 if($total && ($ok != $total)) {
1578     exit 1;
1579 }