golemwashere has asked for the wisdom of the Perl Monks concerning the following question:

Hello wise ones, I'm having troubles using cookies with LWP::Parallel. I want to be able to test concurrent pages requests keeping the first cookie I get (in this peculiar case the ASPSESSIONID of ASP pages ie: the session). I also (and succeeded to) manage to POST params to the different pages. I set up a couple of test pages:

http://212.31.252.200/test/benchmark/1.asp (here I setup an ASP session variable and collect a post param)

http://212.31.252.200/test/benchmark/2.asp (here I should print the session variable ,if the cookie was successfully resent and the POSTed param)

Could you suggest me some fine excape?

many thanks yours
G.

P.S. obviuosly the code skeletorn is not mine, I just lost the reference to the author, I'll postit as soon I find it back. 8)

-----------

#!/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_HTM +L; 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_to +tal), "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 }

Edit Masem 2001-09-17 - Code Tags and other formatting

Replies are listed 'Best First'.
Re: Use of cookies in LWP::Parallel
by perrin (Chancellor) on Sep 17, 2001 at 19:11 UTC
    If your goal is to pound on some URLs and check the results, you'd be better off using a forking model or something like HTTPD::Bench::ApacheBench.
Re: Cookie blues with LWP
by golemwashere (Acolyte) on Sep 17, 2001 at 14:45 UTC
    Hi,
    just in case anyone is still reading I did it on
    win32 using fork and win32::pipe (the hard way)
    here is the code:
    (which is also compilable as an .exe with activestate perlapp
    g.
    #!/usr/bin/perl ## forkin pipin stresser ## requires conf file url.txt ## creates output file out.txt use strict; use Win32::Pipe; use LWP::UserAgent; use Sys::Hostname; use Time::HiRes qw(gettimeofday tv_interval); use HTTP::Cookies; use CGI; ## these modules are required for compiling: use warnings; use File::Spec::Win32; ###### debug LWP #use LWP::Debug qw(+); ###### vars declarations my $host = hostname; my $PipeName = "\\\\$host\\pipe\\My Named Pipe"; ############### my ($totsuc,$succeeded,$quantifigli,$DEBUG,@parametro,$totaltime,$ct,$ +ct2,,$ctritorni,$idauth,$DEBUGOUT,$pwdauth,$AUTH,@urls,@params,@varia +b,$Pipe,$data,$User,$pidserver,@pid,$total_time,%errors,$nof_requests +_total); my $cookies = HTTP::Cookies->new; $totsuc=0; $ct=0; $ct2=0; ########## reads conf.txt for urls and params # overrides some vars predefined vars open CONF, "url.txt" or die "Cannot open url.txt for read :$!"; while (<CONF>) { chomp; # no newline s/#.*//; # no comments s/^\s+//; # no leading white s/\s+$//; # no trailing white if ($_=~/nof_requests_total=(.*)$/) { $nof_requests_total=$1;next ;} if ($_=~/AUTH=(.*)$/) { $AUTH=$1;next; } if ($_=~/idauth=(.*)$/) { $idauth=$1;next; } if ($_=~/pwdauth=(.*)$/) { $pwdauth=$1;next; } if ($_=~/DEBUGOUT=(.*)$/) { $DEBUGOUT=$1;next; } if ($_=~/DEBUG=(.*)$/) { $DEBUG=$1;next; } if ($_=~/quantifigli=(.*)$/) { $quantifigli=$1;next; } next unless length; # anything left? @variab=split /\t/, $_; push (@urls,$variab[0]); ## populates params array # params are <tab>name1=value1&name2=value2.... my @riga=split /&/, $variab[1]; foreach(@riga) { my @parametro=split /=/, $_; $parametro[1]="=".&URL_Encode($parametro[1])."&"; $params[$ct]=$params[$ct].$parametro[0].$parametro[1] } $ct++; } close CONF; ############# print "Golem's own FPS (Forkin Pipin Stresser)\n"; # flush STOUT $| = 1; if ($DEBUG) {print "padre: io sono pid $$ \n";} ## time before begin my $before=gettimeofday; ### forks the named pipe server######## if ( $pidserver = fork() ) { if ($DEBUG) {print "padre: $$ mio figlio pid: $pidserver \n";} } # The Child portion of the named pipe server Fork # elsif ( defined( $pidserver ) ) { # here child code (namedpipeserver) if ($DEBUG) { print "server con pid: $$ \n";} namedpipeserver("My Named Pipe"); exit(); } #################end named pipe server fork########## ###### forks the client agents foreach (1..$quantifigli) { if ( $pid[$ct] = fork() ) { if ($DEBUG) {print "padre: $$ mio figlio pid: $pid[$ct] \n";} } # The Child portion of the Fork elsif ( defined( $pid[$ct] ) ) { # child code here: if ($DEBUG) { print "figlio con pid: $$ \n";} # requests URL for data &richieste; $|=1; if ($DEBUG) {$data = $data."Server=" . Win32::NodeName() . "\nTime=" . + localtime() . "\n";} $data.="pid=$$\&succeded=$succeeded\&errors="; ### # sends this data to named pipe server connpipe($PipeName,$data); exit(); } else { die( "Could not Fork" ); } ########fine for: } #################### end clients fork########## exit; #####################end############################################## +####################### ## sub: write on named pipe ## input params: pipe name and data to write sub connpipe { my ($Pipename,$Data)=@_; if ($DEBUG) {print "Connecting to $PipeName\n";} if( $Pipe = new Win32::Pipe( $PipeName ) ) { if ($DEBUG) { print "\nPipe has been opened, writing data to it...\n" +;} $Pipe->Write( $Data ); $Pipe->Close(); } else { print "Error connecting: " . Win32::FormatMessage( $Win32::Pipe::Err +or ) . "\n"; } } ############################################## #########sub download a cicle of URLs sub download { my $ua = new LWP::UserAgent; $ua->agent("Mozilla/4.76 [en] (Windows NT 5.0; U)"); ## cookies my $cookies = HTTP::Cookies->new; $ua->cookie_jar($cookies); # url 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]); $ct++; # basic auth if ($AUTH) { $request->authorization_basic($idauth, $pwdauth); } my $response = $ua->request($request); if ($response->is_success) { # successo $succeeded++; # debug output if ($DEBUGOUT) { print $response->content; } } else { ## failure print "Download of $url failed\n"; $response->message("TIMEOUT") unless $response->code(); $errors{$response->message}++; } } } # 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 } ### sub requests # loops al URL requests # for each clients the given times sub richieste { foreach (1..$nof_requests_total) { &download; } } ############### ### sub create a named pipe server # param : named pipe name sub namedpipeserver { my $PipeName=shift(@_); $| = 1; my $bServerContinue = 1; if ($DEBUG) {print "Creating pipe \"$PipeName\".\n";} if( my $Pipe = new Win32::Pipe( $PipeName ) ) { while( $bServerContinue ) { if ($DEBUG) { print "Waiting for a client to connect...\n";} if( $Pipe->Connect() ) { my $In; $User = ( $Pipe->GetInfo() )[2]; if ($DEBUG) { print "Pipe opened by $User.\n";} $In = $Pipe->Read(); if ($DEBUG) {print "************Client sent us: \n$In\n************\n" +;} ####### collects data in $In parsaIn($In); ###################################################################### +###### if ($DEBUG) { print "Disconnecting...\n";} $Pipe->Disconnect(); ### controllo di uscita $ctritorni++; if ($DEBUG) { print "\n******* $ctritorni $quantifigli\n";} if ($ctritorni eq $quantifigli) { if ($DEBUG) {print "\n tornati tutti i figli\n";} $bServerContinue=0; ## stampa risultati results(); } ### } } $Pipe->Close(); } else { print "\nCould not create pipe\n"; print "Error: " . Win32::FormatMessage( $Win32::Pipe::Error ) . "\n" +; } } ####################sub print out results sub results { # total time for requests $totaltime = gettimeofday-$before; ## errors collecting (needs to be fixed) my $errors = join(',', map "$_ ($errors{$_})", keys %errors); $errors = "NONE" unless $errors; #### my @P = ( "URL(s)" => join("\n", @urls), "Total Requests Loops per agent" => "$nof_requests_total", "Number of Parallel Agents" => $quantifigli, "Total succeeded reqs" => $totsuc, "% Succeeded" => ((100*$totsuc / ($nof_requests_total*$ +quantifigli*scalar(@urls)))), "Errors" => $errors, "Total Time" => sprintf("%.2f secs\n", $totaltime), "Throughput" => sprintf("%.2f Requests/sec\n", $nof_requests_total / $totaltime), # "Latency" => sprintf("%.2f secs/Request", # ($ua->get_latency_total() || 0) / # $nof_requests_total), ); ### # Print out statistics ### if ($DEBUG) { print "\n#################### results #################\n"; foreach (@P) { print "$_ \n"; } } ### open OUT, ">out.txt" or die "Cannot open out.txt for write :$!"; foreach (@P) { print OUT "$_ \n"; } close OUT; ## } ########sub parsaIN: ## reads params passed to named pipe server and # sets global results vars sub parsaIn { my $In=shift(@_); my @riga=split /&/, $In; foreach(@riga) { if ($_=~/succeded=(.*)$/) { $totsuc=$totsuc+$1; next; } } }