#!/usr/bin/perl -w use LWP::Parallel::UserAgent; use Time::HiRes qw(gettimeofday tv_interval); use strict; use HTTP::Cookies; use CGI; ###### debug LWP #use LWP::Debug qw(+); ############################################################################## ### # Configuration ### my $nof_parallel_connections = 1; # reqs per session my $nof_requests_total = 1; ## timeout (seconds) my $timeout = 10; ## array of urls to call my @urls = ( 'http://212.31.252.200/test/benchmark/1.asp', 'http://212.31.252.200/test/benchmark/2.asp', ); ## params to POST to the preceeding URLs # encoded # I know this ain't nice but will fix it later my $param1="text1=".&URL_Encode("5 dd"); my @params = ( '', $param1, ); ## use Cookies my $COOKIES=1; # use basic auth my $AUTH=0; my $idauth="golem"; my $pwdauth="washere"; #debug : print pages received my $OUTPUTDEBUG=1; # debug : save errors in out.txt my $ERRDEBUG=0; # debug : print http requests my $REQUEST=0; # cookies variables my $SEENCOOKIE=0; my $cookies = HTTP::Cookies->new; my $savedcookies=""; ################################################################################## ################################################## # Derived Class for latency timing ################################################## package MyParallelAgent; @MyParallelAgent::ISA = qw(LWP::Parallel::UserAgent); use strict; ### # This Is called when connection is opened ### sub on_connect { my ($self, $request, $response, $entry) = @_; # cookies ######## if ($SEENCOOKIE) { print "***********I have seen cookies and I'm using them*********\n"; # tried all these: #print $savedcookies; $cookies->revert; #$cookies>set_cookie($savedcookies); #$cookies->load(); } $self->{__start_times}->{$entry} = [Time::HiRes::gettimeofday]; } ### # This is called when connection is closed ### sub on_return { my ($self, $request, $response, $entry) = @_; my $start = $self->{__start_times}->{$entry}; $self->{__latency_total} += Time::HiRes::tv_interval($start); # cookies seen for first time if (!($SEENCOOKIE)) { $cookies->extract_cookies($response); $savedcookies=$cookies->as_string(); print "I received this cookie string:\n"; print $savedcookies; $SEENCOOKIE=1; } if ($OUTPUTDEBUG) { print "\n pagina ".$request->url; print "\n****** :\n".$response->content; } ## debug : print errors # if ($ERRDEBUG) { if (!($response->is_success)) { open OUT, ">>out.txt" or die "Cannot open out.txt for write :$!"; print OUT "\n*************** error on: ".$request->url; print OUT "\n*************** error type: ".$response->error_as_HTML; print OUT "\n*************** error page from server: ".$response->content; close OUT; } } #######################à } sub on_failure { on_return(@_); # Same procedure } ### # Access function for new instance var ### sub get_latency_total { return shift->{__latency_total}; } ################################################## package main; ################################################## ### # Init parallel user agent ### my $ua = MyParallelAgent->new(); $ua->agent("Mozilla/4.76 [en] (Windows NT 5.0; U)"); $ua->max_req($nof_parallel_connections); $ua->redirect(1); # follow redirects #$ua->in_order (1); # segui nell'ordine di registrazione ### # Register all requests ### foreach (1..$nof_requests_total) { # POST params counter my $ct=0; foreach my $url (@urls) { my $request = HTTP::Request->new('POST', $url); $request->content_type('application/x-www-form-urlencoded'); $request->content($params[$ct]); # basic auth if ($AUTH) { $request->authorization_basic($idauth, $pwdauth); } ### debug : print http request if ($REQUEST) { print $request->as_string(); } $ct++; $ua->register($request); } } ### # Launch processes and check time ### my $start_time = [gettimeofday]; my $results = $ua->wait($timeout); my $total_time = tv_interval($start_time); ### # Requests all done, check results ### my $succeeded = 0; my %errors = (); foreach my $entry (values %$results) { my $response = $entry->response(); if($response->is_success()) { $succeeded++; # Another satisfied customer ###### } else { # Error, save the message $response->message("TIMEOUT") unless $response->code(); $errors{$response->message}++; } } ### # Format errors if any from %errors ### my $errors = join(',', map "$_ ($errors{$_})", keys %errors); $errors = "NONE" unless $errors; ### # Format results ### #@urls = map {($_,".")} @urls; my @P = ( "URL(s)" => join("\n", @urls), "Total Requests" => "$nof_requests_total", "Parallel Agents" => $nof_parallel_connections, "Succeeded" => sprintf("$succeeded (%.2f%%)\n", $succeeded * 100 / $nof_requests_total), "Errors" => $errors, "Total Time" => sprintf("%.2f secs\n", $total_time), "Throughput" => sprintf("%.2f Requests/sec\n", $nof_requests_total / $total_time), "Latency" => sprintf("%.2f secs/Request", ($ua->get_latency_total() || 0) / $nof_requests_total), ); my ($left, $right); ### # Print out statistics ### print "\n#################### results #################\n"; foreach (@P) { print "$_ \n"; } exit; # Usage : $URL_encoded = &URL_Encode("$plaintext"); sub URL_Encode { my($text) = $_[0]; # text to URL encode $text=CGI::escape($text); return $text; # return URL encoded text }