LWP: Test Posting Form Data

LWP::UserAgent is perl's web browser. If you need to GET,POST or PUT, LWP is your friend. It's very simple to use and very powerful. My script example today will use LWP::Parallel::UserAgent to POST form data ( in my case, login to ) a bunch of sites in parallel. Then it will grep the response data from each site looking for data we expect to see in the repsonse frmo the POST ( after we log in ).

#!/usr/bin/perl
############################################################
# http://greg-techblog.blogspot.com
# Post data to a bunch of sites in parallel and test the responses for a string
############################################################
use strict;
use warnings;
use Getopt::Long;
use LWP::Parallel::UserAgent;
use HTTP::Request::Common;
use HTTP::Cookies;

# --debug or -d as arg will turn on debugging
my $debug;
GetOptions( 'debug|d' => \$debug );


# Regex to check for in response content from post
my $regex = q{logout};

# List of sites we want to Connect to
my @sites = ( www.siteOne.com, www.siteTwo.com, www.siteThree.com );
# Define your form fields and values for Post requests
my %form = (
'login_username' => 'admin',
'login_password' => 'password',
'hidden_form_field1' => '1',
);
# Url encode form
my $form_encoded = join '&', map { "$_=$form{$_}"; } keys %form;
# Replace spaces for url encoding
$form_encoded =~ s/\s/%20/g;

# Header object for request
my $header = HTTP::Headers->new('Content-Type' => 'application/x-www-form-urlencoded');

# Create request objects for each site
my $reqs = [];
map {
my $req = HTTP::Request->new( 'POST', qq{$_/},$header, $form_encoded);
push(@$reqs,$req);
} @sites;


# Execute request
my %stdout = parallel_reqs($reqs,$regex);

map { print "Failed to login to $_\n" unless $stdout{$_}; } keys %stdout;

######################################################
# Post form data to a bunch of sites and grep the
# response data for a string
# Pass:
# ref array of HTTP::Request objects
# regex to check response for
# Return:
# A hash keyed by urls with boolean success/fail values
######################################################
sub parallel_reqs {
my ($reqs,$regex) = @_;
my $pua = LWP::Parallel::UserAgent->new();
# $pua->in_order (1); # handle requests in order of registration
$pua->duplicates(1); # do not ignore duplicates
$pua->timeout (60); # in seconds
$pua->redirect (1); # follow redirects
$pua->nonblock (0); # disable nonblocking
$pua->max_hosts (8); # number of hosts to connect to at once
$pua->max_req (20); # number of request per host

# Allow POSTS to be redirected
push @{ $pua->requests_redirectable }, 'POST';

# Enable Cookies
my $cookie = HTTP::Cookies->new({});
$pua->cookie_jar($cookie);

# Start our requests
foreach my $req (@$reqs) {
if ( my $res = $pua->register($req) ) {
print STDERR $res->error_as_HTML if $debug;
}
}
my $entries = $pua->wait(10);

# Loop through the response content looking for our regex
my %return;
foreach (keys %$entries) {
my $response = $entries->{$_}->response;
print $response->request->url."\t\t".$response->message."\t".$response->code."\n" if $debug;
$return{$response->request->url} = $response->content =~ /$regex/ ? 1 : 0;
}
return %return;
}