The Labs.Com Issue_08_CGI

TPJ: Issue_08_CGI

This is a collection of programs published by The Perl Journal. You can download all source-code also from TPJ: Programs.

Download torture.pl

#!/usr/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 byte\

s]

-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 stri\

ng

-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 UR\

L

$request = new HTTP::Request ('GET',$url);

}

elsif ($POST) {                # handle POST request

my $header = new HTTP::Headers (

Content_Type => 'application/x-www-form-urlenc\

oded',

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 U\

RL

chop($url) if substr($url,-1,1) eq '/';

$url .= "/$garbage";

} else {                # append garbage to the query stri\

ng

$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);

}

Issue_08_CGI 2. More Samples on CGI

• Issue_01_CGI
• Issue_02_CGI
• Issue_03_CGI
• Issue_04_CGI
• Issue_05_CGI
• Issue_06_CGI
• Issue_08_CGI
• Issue_10_CGI