File Coverage

lib/HTTP/Monkeywrench.pm

Criterion	Covered	Total	%
statement	141	174	81.0
branch	37	68	54.4
condition	6	28	21.4
subroutine	16	17	94.1
pod	5	8	62.5
total	205	295	69.4

# HTTP::Monkeywrench.pm
# ---------------------------------------------------------
# $Revision: 1.13 $
# $Date: 2000/09/12 00:14:54 $
# ---------------------------------------------------------

=head1 NAME

HTTP::Monkeywrench - Web testing application

=head1 SYNOPSIS

  use HTTP::Monkeywrench;
   $session = [
     {
     name  =E 'URL Name',
     url   =E 'http://url',
     }
   ];
   HTTP::Monkeywrench-Etest($session);

=head1 REQUIRES

 CGI
 Net::SMTP
 HTTP::Cookies
 LWP::UserAgent
 Time::HiRes
 Data::Dumper

=cut

=head1 EXPORTS

None

=head1 DESCRIPTION

HTTP::Monkeywrench is a test-harness application to test the integrity
of a user's path through a web site.

To run HTTP::Monkeywrench-Etest(), first set up a Perl script that contains
sessions (described below), settings if desired (also described below),
and a call to HTTP::Monkeywrench-Etest(), passing it the settings hashref first,
followed by the desired session hashrefs you want to test.
HTTP::Monkeywrench-Etest($settings, $session1,... $sessionN)

HTTP::Monkeywrench can also be used in an object-oriented fashion -- simply
take the result of HTTP::Monkeywrench-Enew (optionally passing the settings
hashref) and call the test() method against it as above (optionally omitting
the settings hashref.)

Each session arrayref contains one or more hashrefs, called clicks,
which contain descriptive elements of a specific web page to be tested.
The elements are described below under SESSION.

=head1 SESSION

=over 4

=item C<$session1> (ARRAYREF of HASHREFS)

A session is an arrayref of complex hashrefs that can be sent to the
Ctest> application to perform tests on a website
as a virtual user.

The following keys can be in each 'Click' hashref.
Fields with a "*" are required:

=back

=over 8

=item name (SCALAR)

A name to visually reference that 'click' in the reports

=item *url (SCALAR)

The url for Monkeywrench to test for that click.

=item params (HASHREF)

The params to send to dynamic pages and cgi's.
Params should be set up as such: { username => 'joe', password => 'blow' }

=item method (SCALAR)

'method' should be either 'POST' or 'GET'. If method is left
blank, method will default to 'GET'.

=item auth (ARRAYREF)

'auth' is the username and password if the site your are testing
is password protected. 'auth' params must be passed to each
element of a session that is accessing the same site.
Example: ['username','password']

=item success_res (ARRAYREF)

An arrayref of items for Monkeywrench to test for their existence.
Each element of the array can either be a text string or a regexp object.
If a string from success_res is not found in the page, Monkeywrench
will report an error.
EXAMPLE: ['string',qr/regexp_object/,'etc']

=item error_res (ARRAYREF)

The same as success_res, except that an error will only be reported
if strings in error_res ARE found on the page being tested.

=item cookies (ARRAYREF of ARRAYREFS)

A preset cookie can be sent to a page. In order to send a cookie to
a page the following elements should be included as an arrayref:

[$version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest]

An example cookie would look like:

[['0', 'sessnum', 'expires&2592000&type&consumer', '/','cookiemonster.org', '8014', '', '', '2000-09-11 16:15:15Z', '']],

=item acceptcookie (BIT)

A numeric flag set to 1 or 0 to tell Monkeywrench if it should accept and
save a cookie passed from a server.
Default is 0, cookies will not be accepted.

=item sendcookie (BIT)

A numeric flag set to 1 or 0 to tell Monkeywrench to send a saved or
pre made cookie back to the server. Default is 0, cookies will not be sent.

=item showhtml (BIT)

A numeric flag set to 1 or 0 to have the source html of a page displayed
within the report. When set to 1 the reports can get messy if the page
is heavy on html.

=back

=head1 SETTINGS HASH

=over 4

=item $settings (HASHREF)

The settings hash is optional as are each of the elements of $settings.
Elements that are not declared or set are defaulted to 0 (off).

=back

=over 8

=item match_detail (BIT)

A numeric flag set to 1 or 0. If set to 1 Match detail shows all of
the reports of success_res and error_res no matter if they pass or fail.

=item show_cookies (BIT)

A numeric flag set to 1 or 0. If set to 1 show_cookies will show all
the cookies in the report, either passed from the session or sent
from the server.

=item smtp_server (SCALAR)

The SMTP server to be used by Net::SMTP. Only required if user wants
output of Monkeywrench to be sent to an email address.

=item send_mail (ARRAYREF)

The send_mail arrayref is also only required if user plans on sending
output to one or more email addresses.

=item send_if_err (BIT)

The send_if_err bit is a flag that should be set to either 1 or 0 and
is only used if the user wants the Monkeywrench output sent via email.
If set to 1 the output will only be sent to the email address(es) in
the event of a failure in the success or error checking or any result
code other than 200.

=item print_results (BIT)

If set to 1, the results will be printed to the screen. If set to 0 nothing
will be printed to the screen. The default setting is 1.


=back

=cut

=head1 METHODS

=over 4

=cut

package HTTP::Monkeywrench;

use strict;
use vars qw($totaltime $totalerrs @sessiontime $debug $default_settings $content);

use CGI;
use Net::SMTP;
use HTTP::Cookies;
use LWP::UserAgent;
#use LWP::Debug qw(+); # spits out a lot of helpful LWP debugging

use Time::HiRes qw(gettimeofday tv_interval);
use Data::Dumper; # also used for debugging purposes

BEGIN {
	$HTTP::Monkeywrench::REVISION	= (qw$Revision: 1.13 $)[-1];
	$HTTP::Monkeywrench::VERSION	= '1.0';

	$CGI::NO_DEBUG	= 1; # again, debugging
	$debug			= undef; # set to 1 if you want to see debugging output
	$default_settings = {
			match_detail	=> 1,
			show_cookies	=> 1,
			smtp_server		=> undef,
			send_mail		=> undef,
			send_if_err		=> 0,
			print_results	=> 1
	};
}

$totalerrs = 0; # initialize the total errors string

=item C ( [ \%settings ] )

Returns a new Monkeywrench object.  Optionally takes a settings hash.

=cut
sub new {
	my $proto	= shift;
	my $class	= ref($proto) || $proto;
	my $self	= bless({}, $class);
	$self->settings(shift);
	$self->{'ua'} = new LWP::UserAgent;
	$self->{'ua'}->agent('Monkeywrench/'.$HTTP::Monkeywrench::VERSION . $self->{'ua'}->agent);
	$self->{'cookie_jar'} = HTTP::Cookies->new;
	$self->{'cgi'} = CGI->new('');
	return $self;
} # END method new

=item C ( $self, [ \%settings ] )

Returns settings hash.  Passing hashref will change settings in object.

=cut
sub settings {
	my $self = shift;
	return undef unless (ref $self);
	if (my $settings = shift) {
		warn "SETTINGS ==> " . Dumper($settings) if ($debug);
		unless (ref($settings) eq 'HASH') {
			carp('Settings must be called with hashref...\n');
			return undef;
		}

		$self->{'settings'} = {
			map { $_ => defined($settings->{$_}) ? $settings->{$_} : $default_settings->{$_} }
			keys %$default_settings };
	}

	return $self->{'settings'};
} # END method settings

sub ua			{ $_[0]->{'ua'}; }
sub cookie_jar 	{ $_[0]->{'cookie_jar'}; }
sub cgi			{ $_[0]->{'cgi'}; }

=item C ( [ \%settings ], \@session [ , \@session, ... ] )

Usable as both a static method and object method.
Runs a series Monkeywrench tests on a web server using the parameters set forth in the
sessions you pass.

=cut
sub test {
	my $self		= shift;
	unless (ref($self)) {
		$self = $self->new(ref($_[0]) eq 'HASH' ? shift : ());
	}
	#my $settings	= $self->settings((ref($_[0]) eq 'HASH') && shift);
	my @sessions	= @_;
	my $q			= $self->cgi();
	my $sessnum 	= 0;
	my $return		= {};
	my $res;

	$content .= sprintf("============================== Monkeywrench %.2f ==============================\n",($HTTP::Monkeywrench::REVISION));

	foreach my $session (@sessions) {
		$content .= "Session $sessnum\n";
		my $clicknum = 0;
		foreach (@$session) {
			my $click = { %$_ };	# Make a copy so we don't stomp on the original
			$click->{'params'}		= join('&', map{ $q->escape($_) . '=' . $q->escape($click->{'params'}{$_} )   } keys %{$click->{'params'}} );
			$click->{'method'}		= $click->{'method'} ? $click->{'method'} : 'GET';
			$click->{'showhtml'}	= $click->{'showhtml'} || 0;
			push(@{ $click->{'urls'} },$click->{'url'});

			if ($click->{'cookies'}) {
				foreach my $cookie (@{ $click->{'cookies'} }) {
					$self->cookie_jar->set_cookie(@$cookie);
				}
			}

			my $t1 = [ gettimeofday ];
			$res = $self->get_response($click);
			$return->{ session }[ $sessnum ][ $clicknum ]{ res } = $res->code;
			my $t2  = [ gettimeofday ];

			$content .= " Summary for: " . $click->{'name'} . "\n";
			my $r = 1;
			foreach my $url (@{ $click->{'urls'} }) {
				$content .= scalar (($r==1) ? '         URL: ' : '    Redirect: ') . "$url\n";
				$r++;
			}
			if (($click->{'sendcookie'}) && ($self->settings->{'show_cookies'})) {
				my $cookie_to_print = $self->cookie_jar->as_string;
				$~ = "COOKIES";
				write;
				format COOKIES =
      Cookie:
~~            ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
              $cookie_to_print
.
			}
			my $failed = 0;
			my $success = 0;

			$content .= '        Code: ' . $res->code . ' ' . $res->message . "\n";
			if ($res->is_redirect || $res->is_success) {
				$content .= "   Match Res:\n" if ($click->{'success_res'});
				foreach my $sr (@{ $click->{'success_res'} }) {
					my $result;
					if ($res->content =~ $sr) {
						$result = "PASS" if ($self->settings->{'match_detail'});
					} else {
						$result = "FAIL";
						$failed++;
						$totalerrs++;
					}
					pipe (RFH,WFH);
					format WFH =
              ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>
              $sr,                                                      $result
.
					write WFH if ($result);
					close WFH;
					local $/ = undef;
					$content .= ;
				}

				$content .= " Match Error:\n" if ($click->{'error_res'});
				foreach my $er (@{ $click->{'error_res'} }) {
					my $result;
					if ($res->content =~ $er) {
						$result = "FAIL";
						$failed++;
						$totalerrs++;
					} else {
						$result = "PASS" if ($self->settings->{'match_detail'});
					}
					pipe (ERR_RFH,ERR_WFH);
					format ERR_WFH =
              ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< @>>>>>>>>>>
              $er,                                                      $result
.
					write ERR_WFH if ($result);
					close ERR_WFH;
					local $/ = undef;
					$content .= ;
				}

			} else {
			    $content .= "              *** Request Failed ***\n"; #. $res->error_as_HTML;
			}

			$return->{ session }[ $sessnum ][ $clicknum ]{ clicktime } = my $clicktime = tv_interval($t1,$t2);
			$totaltime += $clicktime;
			$return->{ session }[ $sessnum ][ $clicknum ]{ sessiontime } = $sessiontime[$sessnum] += $clicktime;
			$content .= "\n   Pageclick: $clicktime second\n"; # must kill clicktime nazis
			$content .= "-------------------------------------------------------------------------------\n";
			$clicknum++;
		}

		$content .= "   Session $sessnum: $sessiontime[$sessnum]\n";
		$content .= "===============================================================================\n";
		$sessnum++;
	}

	$content .= "Total Errors: $totalerrs\n";
	$content .= "  Total Test: $totaltime seconds\n\n";
	$return->{ totaltime } = $totaltime;

	if ($self->settings->{'send_mail'}) {
		if (($self->settings->{'send_if_err'} == 0) ||
			(($self->settings->{'send_if_err'} == 1) && ((($res->code != 200) || ($totalerrs > 0))))) {
				$self->send_monkeymail($content,$self->settings->{'smtp_server'},$self->settings->{'send_mail'})
					|| warn "Unable to send monkeymail";
		}
	}
	print $content if $self->settings->{'print_results'};
	return $return;
} # end method test


=item C ($click)

get_response is a recursive method that loops through all
possible redirects until a final response is returned,
which is then returned to the caller.

=cut
sub get_response {
	my $self	= shift;
	my $click	= shift;
	my $method	= ($click->{'REDIRECT'} ? 'GET' : $click->{'method'});
	my $req 	= HTTP::Request->new($method => $click->{'urls'}->[-1] . (($method eq 'GET') ? '?'.$click->{'params'} : ''));

	$req->authorization_basic($click->{'auth'}->[0], $click->{'auth'}->[1]) if ($click->{'auth'});
	$req->content($click->{'params'}) unless ($click->{'REDIRECT'});
    $self->cookie_jar->add_cookie_header($req) if ($click->{'sendcookie'});

	$content .= "\$req ==> " . Dumper($req) if ($debug);

	my $res = $self->ua->request($req);

	$content .= "\$res ==> " . Dumper($res) if ($debug);
	$content .= "RESPONSE ==> " . $res->content . "\n" if ($click->{'showhtml'});

	$self->cookie_jar->extract_cookies($res) if ($click->{'acceptcookie'});

	if ($res->is_redirect) {
		$click->{'REDIRECT'} = 1;
		push(@{ $click->{'urls'} },$res->header('Location'));
		return $self->get_response($click)
	} else {
		return $res;
	}
} # end method get_response


=item C ( $content, \$smtp_server \@address )

send_monkeymail is called if the config script has an
email address and depending on how send_if_err is setup.
$content is the output of the session(s) called by the
config script and the \@address arrayref contains the
address(es) that the output will be sent to. $smtp_server
is the smtp server for Net::SMTP to connect to and is also
required in order for send_monkeymail to be called.

=cut
sub send_monkeymail {
	my $self = shift;
	my $content = shift || 'ERROR: NO OUTPUT';
	my $smtp_server = shift || return undef;
	my $address = shift || return undef;

	my $smtp = Net::SMTP->new($smtp_server) || return undef;
	$smtp->mail($ENV{'USER'});
	$smtp->to(@{$address});

	$smtp->data();
	$smtp->datasend("From: " . $ENV{'USER'} . "\n");
	$smtp->datasend("To: @{$address}\n");
	$smtp->datasend("Subject: Monkeywrench Output\n");
	$smtp->datasend( "\n" . $content );
	$smtp->dataend();

	$smtp->quit;
}


1;

__END__