#!/usr/bin/perl

# file: torture.pl
# Torture test Web servers and scripts by sending them large arbitrary URLs
# and record the outcome.

# See "Web Security, A Step-by-Step Reference Guide" by Lincoln Stein, pages 337-339
# This is a slight improvement on the original script given in the text.

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;
# seed the random number generator (not necessary in perl 5.004)
srand();

# 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);
}