#!/usr/local/bin/perl
# file: torture.pl
# Torture test Web servers and scripts by sending them large arbitrary URLs
# and record the outcome.
use LWP::UserAgent;
use URI::Escape 'uri_escape';
require "getopts.pl";
$USAGE = <<USAGE;
Usage: $0 -[options] URL
Torture-test Web servers and CGI scripts
Options:
-l <integer> Max length of random URL to send [1024 bytes]
-t <integer> Number of times to run the test [1]
-P Use POST method rather than GET method
-p Attach random data to path rather than query string
-e Escape the query string before sending it
USAGE
;
$VERSION = '1.0';
# process command line
&Getopts('l:t:Ppe') || die $USAGE;
# get parameters
$URL = shift || die $USAGE;
$MAXLEN = $opt_l ne '' ? $opt_l : 1024;
$TIMES = $opt_t || 1;
$POST = $opt_P || 0;
$PATH = $opt_p || 0;
$ESCAPE = $opt_e || 0;
# cannot do both a post and a path at the same time
$POST = 0 if $PATH;
# create an LWP agent
my $agent = new LWP::UserAgent;
print <<EOF;
torture.pl version $VERSION starting
Base URL: $URL
Max random data length: $MAXLEN
Repetitions: $TIMES
Post: $POST
Append to path: $PATH
Escape URLs: $ESCAPE
EOF
;
# Do the test $TIMES times
while ($TIMES) {
# create a string of random stuff
my $garbage = random_string(rand($MAXLEN));
$garbage = uri_escape($garbage) if $ESCAPE;
my $url = $URL;
my $request;
if (length($garbage) == 0) { # if no garbage to add, just fetch URL
$request = new HTTP::Request ('GET',$url);
}
elsif ($POST) { # handle POST request
my $header = new HTTP::Headers (
Content_Type => 'application/x-www-form-urlencoded',
Content_Length => length($garbage)
);
# garbage becomes the POST content
$request = new HTTP::Request ('POST',$url,$header,$garbage);
} else { # handle GET request
if ($PATH) { # append garbage to the base URL
chop($url) if substr($url,-1,1) eq '/';
$url .= "/$garbage";
} else { # append garbage to the query string
$url .= "?$garbage";
}
$request = new HTTP::Request ('GET',$url);
}
# do the request and fetch the response
my $response = $agent->request($request);
# print the numeric response code and the message
print $response->code,' ',$response->message,"\n";
} continue { $TIMES-- }
# return some random data of the requested length
sub random_string {
my $length = shift;
return undef unless $length >= 1;
return join('',map chr(rand(255)),0..$length-1);
}
|
Previous
