runtests.pl

#!/usr/bin/env perl
# $Id$
#
# 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 "stunnel.pm"; # stunnel functions
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 memory debugging:
my $memory_debug=0;

# this gets set if curl is compiled with netrc debugging:
# It has to be in the global symbol table because of the way 'requires' works
$main::netrc_debug=0;
my $netrc_debug = \$main::netrc_debug;

# 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 $checkstunnel = &checkstunnel;

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

my $skipped=0; # number of tests skipped; reported in main loop

#######################################################################
# 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

chomp($pwd = `pwd`);

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

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

#######################################################################
# stop the given test server
#
sub stopserver {
    my $PIDFILE = $_[0];
    # check for pidfile
    if ( -f $PIDFILE ) {
        my $PID = serverpid($PIDFILE);

        my $res = kill (9, $PID); # die!
        unlink $PIDFILE; # server is killed

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

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

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

#######################################################################
# 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 $data=`$CURL --silent -i $HOSTIP:$HOSTPORT/verifiedserver 2>/dev/null`;

    if ( $data =~ /WE ROOLZ(: |)(\d*)/ ) {
        if($2) {
            $pid = 0+$2;
        }

        if(!$pid) {
            print "Test server already running with unknown pid! Use it...\n";
            return;
        }

        if($verbose) {
            print "Test server already running with pid $pid, killing it...\n";
        }
    }
    elsif($data ne "") {
        print "GOT: $data\n";
        print "An alien HTTP server is running on port $HOSTPORT\n",
        "Edit runtests.pl to use another port and rerun the test script\n";
        exit;
    }
    else {
        if($verbose) {
            print "No server running, start it\n";
        }
    }

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

    my $flag=$debugprotocol?"-v ":"";
    my $cmd="$perl $srcdir/httpserver.pl $flag $HOSTPORT &";
    system($cmd);