Listing 1: The main body of torture.pl

#!/usr/local/bin/perl
 
# file: torture.pl
# Torture test Web servers and scripts.
 
use Time::HiRes 'time','sleep';
use IO::Socket;
use IO::Pipe;
use POSIX 'WNOHANG';
use Getopt::Std;

$USAGE = <<USAGE;
 Usage: $0 -[options] URL
    Torture-test Web servers and CGI scripts
    
  Options:
    -l <integer>  Max length of random URL to send       [0 bytes]
    -t <integer>  Number of times to run the test        [1]
    -c <integer>  Number of copies of program to run     [1]
    -d <float>    Mean delay between serial accesses     [0 sec]
    -P            Use POST method rather than GET method
    -p            Attach random data to path rather than query string
    -r            Send raw (non-escaped) data
USAGE
    ;
$VERSION = '1.05';
 
# process command line
getopts('l:t:c:d:Pprx') || die $USAGE;
 
# get parameters
$URL    = shift  || die $USAGE;
$MAXLEN = $opt_l || 0;
$TIMES  = $opt_t || 1;
$COPIES = $opt_c || 1;
$DELAY  = $opt_d || 0;
$POST   = $opt_P || 0;
$PATH   = $opt_p || 0;
$RAW    = $opt_r || 0;
 
# cannot do both a post and a path at the same time
$POST = 0 if $PATH;

# the %ESCAPES global is used by the escape() function
for (0..255) { $ESCAPES{chr($_)} = sprintf("%%%02X", $_) }

# get the time
my $localtime = localtime();

print "** torture.pl version $VERSION starting at $localtime\n";

# first we run the dummy test, then we run it for real
my $dummy = do_stats(0);
my $real  = do_stats(1);

# adjust elapsed and transaction time to reflect overhead from test
$real->{elapsed}    -= $dummy->{elapsed};
$real->{trans_time} -= $dummy->{trans_time};

print_results($real);
print "** torture.pl version $VERSION ending at ",scalar localtime,"\n";

exit 0;