runtests.pl

harvest是一个下载html网页得机器人

#!/usr/bin/env perl
# $Id: runtests.pl,v 1.100 2003/10/31 21:34:39 bagder Exp $
#
# Main curl test script, in perl to run on more platforms
#
#######################################################################
# These should be the only variables that might be needed to get edited:

use strict;
#use warnings;

@INC=(@INC, $ENV{'srcdir'}, ".");

require "getpart.pm"; # array functions

my $srcdir = $ENV{'srcdir'} || '.';
my $HOSTIP="127.0.0.1";
my $HOSTPORT=8999; # bad name, but this is the HTTP server port
my $HTTPSPORT=8433; # this is the HTTPS server port
my $FTPPORT=8921;  # this is the FTP server port
my $FTPSPORT=8821;  # this is the FTPS server port
my $CURL="../src/curl"; # what curl executable to run on the tests
my $DBGCURL=$CURL; #"../src/.libs/curl";  # alternative for debugging
my $LOGDIR="log";
my $TESTDIR="data";
my $LIBDIR="./libtest";
my $SERVERIN="$LOGDIR/server.input"; # what curl sent the server
my $CURLLOG="$LOGDIR/curl.log"; # all command lines run
my $FTPDCMD="$LOGDIR/ftpserver.cmd"; # copy ftp server instructions here

# Normally, all test cases should be run, but at times it is handy to
# simply run a particular one:
my $TESTCASES="all";

# To run specific test cases, set them like:
# $TESTCASES="1 2 3 7 8";

#######################################################################
# No variables below this point should need to be modified
#

my $HTTPPIDFILE=".http.pid";
my $HTTPSPIDFILE=".https.pid";
my $FTPPIDFILE=".ftp.pid";
my $FTPSPIDFILE=".ftps.pid";

# invoke perl like this:
my $perl="perl -I$srcdir";

# this gets set if curl is compiled with debugging:
my $curl_debug=0;

# name of the file that the memory debugging creates:
my $memdump="memdump";

# the path to the script that analyzes the memory debug output file:
my $memanalyze="./memanalyze.pl";

my $stunnel = checkcmd("stunnel");
my $valgrind = checkcmd("valgrind");

my $ssl_version; # set if libcurl is built with SSL support

my $skipped=0;  # number of tests skipped; reported in main loop
my %skipped;    # skipped{reason}=counter, reasons for skip
my @teststat;   # teststat[testnum]=reason, reasons for skip

if($valgrind) {
    # we have found valgrind on the host, use it

    # verify that we can invoke it fine
    my $code = system("valgrind >/dev/null 2>&1");

    if(($code>>8) != 1) {
        #print "Valgrind failure, disable it\n";
        undef $valgrind;
    }
    else {
        $CURL="valgrind --leak-check=yes --logfile-fd=3 -q $CURL";
    }
}
#######################################################################
# variables the command line options may set
#

my $short;
my $verbose;
my $debugprotocol;
my $anyway;
my $gdbthis;      # run test case with gdb debugger
my $keepoutfiles; # keep stdout and stderr files after tests
my $listonly;     # only list the tests

my $pwd;          # current working directory

my %run;	  # running server

# torture test variables
my $torture;
my $tortnum;
my $tortalloc;

chomp($pwd = `pwd`);

# enable memory debugging if curl is compiled with it
$ENV{'CURL_MEMDEBUG'} = 1;
$ENV{'HOME'}=$pwd;

##########################################################################
# Clear all possible '*_proxy' environment variables for various protocols
# to prevent them to interfere with our testing!

my $protocol;
foreach $protocol (('ftp', 'http', 'ftps', 'https', 'gopher', 'no')) {
    my $proxy = "${protocol}_proxy";
    # clear lowercase version
    $ENV{$proxy}=undef;
    # clear uppercase version
    $ENV{uc($proxy)}=undef;
}

#######################################################################
# Check for a command in the PATH.
#
sub checkcmd {
    my ($cmd)=@_;
    my @paths=("/usr/sbin", "/usr/local/sbin", "/sbin", "/usr/bin",
               "/usr/local/bin", split(":", $ENV{'PATH'}));
    for(@paths) {
        if( -x "$_/$cmd") {
            return "$_/$cmd";
        }
    }
}

#######################################################################
# Return the pid of the server as found in the given pid file
#
sub serverpid {
    my $PIDFILE = $_[0];
    open(PFILE, "<$PIDFILE");
    my $PID=0+<PFILE>;
    close(PFILE);
    return $PID;
}

#######################################################################
# Memory allocation test and failure torture testing.
#
sub torture {
    # start all test servers (http, https, ftp, ftps)
    &startservers(("http", "https", "ftp", "ftps"));
    my $c;

    my @test=('http://%HOSTIP:%HOSTPORT/1',
              'ftp://%HOSTIP:%FTPPORT/');
    
    # loop over the different tests commands
    for(@test) {
        my $cmdargs = "$_";

        $c++;

        if($tortnum && ($tortnum != $c)) {
            next;
        }
        print "We want test $c\n";

        my $redir=">log/torture.stdout 2>log/torture.stderr";

        subVariables(\$cmdargs);

        my $testcmd = "$CURL $cmdargs $redir";

        # First get URL from test server, ignore the output/result
        system($testcmd);

        # Set up gdb-stuff if desired
        if($gdbthis) {
            open(GDBCMD, ">log/gdbcmd");
            print GDBCMD "set args $cmdargs\n";
            print GDBCMD "show args\n";
            close(GDBCMD);
            $testcmd = "gdb $CURL -x log/gdbcmd";
        }

        print "Torture test $c:\n";
        print " CMD: $testcmd\n" if($verbose);
        
        # memanalyze -v is our friend, get the number of allocations made
        my $count;
        my @out = `$memanalyze -v $memdump`;
        for(@out) {
            if(/^Allocations: (\d+)/) {
                $count = $1;
                last;
            }
        }
        if(!$count) {
            # hm, no allocations in this fetch, ignore and get next
            print "BEEEP, no allocs found for test $c!!!\n";
            next;
        }
        print " $count allocations to excersize\n";

        for ( 1 .. $count ) {
            my $limit = $_;
            my $fail;

            if($tortalloc && ($tortalloc != $limit)) {
                next;
            }

            print "Alloc no: $limit\r" if(!$gdbthis);
            
            # make the memory allocation function number $limit return failure
            $ENV{'CURL_MEMLIMIT'} = $limit;

            # remove memdump first to be sure we get a new nice and clean one
            unlink($memdump);
            
            print "**> Alloc number $limit is now set to fail <**\n" if($gdbthis);

            my $ret = system($testcmd);

            # verify that it returns a proper error code, doesn't leak memory
            # and doesn't core dump
            if($ret & 255) {
                print " system() returned $ret\n";
                $fail=1;
            }
            else {
                my @memdata=`$memanalyze $memdump`;
                my $leak=0;
                for(@memdata) {
                    if($_ ne "") {
                        # well it could be other memory problems as well, but
                        # we call it leak for short here
                        $leak=1;
                    }
                }
                if($leak) {
                    print "** MEMORY FAILURE\n";
                    print @memdata;
                    print `$memanalyze -l $memdump`;
                    $fail = 1;
                }
            }
            if($fail) {
                print " Failed on alloc number $limit in test $c.\n",
                " invoke with -t$c,$limit to repeat this single case.\n";
                stopservers();
                exit 1;
            }
        }
        print "\n torture test $c did GOOD\n";

        # all is well, now test a different kind of URL
    }
    stopservers();
    exit; # for now, we stop after these tests
}

#######################################################################
# stop the given test server
#
sub stopserver {
    my $pid = $_[0];
    # check for pidfile
    if ( -f $pid ) {
        my $PIDFILE = $pid;
        $pid = serverpid($PIDFILE);
        unlink $PIDFILE; # server is killed
    }
    elsif($pid <= 0) {
        return; # this is not a good pid
    }

    my $res = kill (9, $pid); # die!

    if($res && $verbose) {
        print "RUN: Test server pid $pid signalled to die\n";
    }
    elsif($verbose) {
        print "RUN: Test server pid $pid didn't exist\n";
    }
}

#######################################################################
# check the given test server if it is still alive
#
sub checkserver {
    my ($pidfile)=@_;
    my $pid=0;

    # check for pidfile
    if ( -f $pidfile ) {
        $pid=serverpid($pidfile);
        if ($pid ne "" && kill(0, $pid)) {
            return $pid;
        }
        else {
            return -$pid; # negative means dead process
        }
    }
    return 0;
}

#######################################################################
# start the http server, or if it already runs, verify that it is our
# test server on the test-port!
#
sub runhttpserver {
    my $verbose = $_[0];
    my $RUNNING;
    my $pid;

    $pid = checkserver ($HTTPPIDFILE);

    # verify if our/any server is running on this port
    my $cmd = "$CURL -o log/verifiedserver --silent -i $HOSTIP:$HOSTPORT/verifiedserver 2>/dev/null";
    print "CMD; $cmd\n" if ($verbose);
    my $res = system($cmd);

    $res >>= 8; # rotate the result
    my $data;

    print "RUN: curl command returned $res\n" if ($verbose);

    open(FILE, "<log/verifiedserver");
    my @file=<FILE>;
    close(FILE);
    $data=$file[0]; # first line

    if ( $data =~ /WE ROOLZ: (\d+)/ ) {
        $pid = 0+$1;
    }
    elsif($data) {
        print "RUN: Unknown HTTP server is running on port $HOSTPORT\n";
        return -2;
    }

    if($pid > 0) {
        my $res = kill (9, $pid); # die!
        if(!$res) {
            print "RUN: Failed to kill test HTTP server, do it manually and",
            " restart the tests.\n";
            exit;
        }
        sleep(1);
    }

    my $flag=$debugprotocol?"-v ":"";
    $cmd="$perl $srcdir/httpserver.pl $flag $HOSTPORT &";
    system($cmd);
    if($verbose) {
        print "CMD: $cmd\n";
    }

    my $verified;
    for(1 .. 5) {
        # verify that our server is up and running:
        my $data=`$CURL --silent -i $HOSTIP:$HOSTPORT/verifiedserver 2>/dev/null`;

        if ( $data =~ /WE ROOLZ: (\d+)/ ) {
            $pid = 0+$1;
            $verified = 1;
            last;
        }
        else {
            sleep(1);
            next;
        }
    }
    if(!$verified) {
        print STDERR "RUN: failed to start our HTTP server\n";
        return -1;
    }

    if($verbose) {
        print "RUN: HTTP server is now verified to be our server\n";
    }

    return $pid;
}

#######################################################################
# start the https server (or rather, tunnel) if needed
#
sub runhttpsserver {
    my $verbose = $_[0];
    my $STATUS;
    my $RUNNING;
    my $pid=checkserver($HTTPSPIDFILE );

    if(!$stunnel) {
        return 0;
    }

    if($pid > 0) {
        # kill previous stunnel!
        if($verbose) {
            print "RUN: kills off running stunnel at $pid\n";
        }
        stopserver($HTTPSPIDFILE);
    }

    my $flag=$debugprotocol?"-v ":"";
    my $cmd="$perl $srcdir/httpsserver.pl $flag -s \"$stunnel\" -d $srcdir -r $HOSTPORT $HTTPSPORT &";
    system($cmd);
    if($verbose) {
        print "CMD: $cmd\n";
    }
    sleep(1);
    $pid=checkserver($HTTPSPIDFILE);

    return $pid;
}

#######################################################################
# start the ftp server if needed
#
sub runftpserver {
    my $verbose = $_[0];
    my $STATUS;
    my $RUNNING;
    # check for pidfile
    my $pid = checkserver ($FTPPIDFILE );

    if ($pid <= 0) {
        print "RUN: Check port $FTPPORT for our own FTP server\n"
            if ($verbose);


        my $time=time();
        # check if this is our server running on this port:
        my $data=`$CURL -m4 --silent -i ftp://$HOSTIP:$FTPPORT/verifiedserver 2>/dev/null`;

        # if this took more than 2 secs, we assume it "hung" on a weird server
        my $took = time()-$time;
        
        if ( $data =~ /WE ROOLZ: (\d+)/ ) {
            # this is our test server with a known pid!
            $pid = 0+$1;
        }
        else {
            if($data || ($took > 2)) {
                # this is not a known server
                print "RUN: Unknown server on our favourite port: $FTPPORT\n";
                return -1;
            }
        }
    }

    if($pid > 0) {
        print "RUN: Killing a previous server using pid $pid\n" if($verbose);
        my $res = kill (9, $pid); # die!
        if(!$res) {
            print "RUN: Failed to kill our FTP test server, do it manually and",
            " restart the tests.\n";
            return -1;
        }
        sleep(1);
    }
    
    # now (re-)start our server:
    my $flag=$debugprotocol?"-v ":"";
    my $cmd="$perl $srcdir/ftpserver.pl $flag $FTPPORT &";
    if($verbose) {
        print "CMD: $cmd\n";
    }
    system($cmd);

    my $verified;
    for(1 .. 5) {
        # verify that our server is up and running:
        my $data=`$CURL --silent -i ftp://$HOSTIP:$FTPPORT/verifiedserver 2>/dev/null`;

        if ( $data =~ /WE ROOLZ: (\d+)/ ) {
            $pid = 0+$1;
            $verified = 1;
            last;
        }
        else {
            if($verbose) {
                print STDERR "RUN: Retrying FTP server existance in 1 sec\n";
            }
            sleep(1);
            next;
        }
    }
    if(!$verified) {
        warn "RUN: failed to start our FTP server\n";
        return -2;
    }

    if($verbose) {
        print "RUN: FTP server is now verified to be our server\n";
    }

    return $pid;