#!/usr/bin/perl
use strict;
use LWP::UserAgent;
# Use 127.0.0.1 instead of localhost to force use of IPv4, as that is what the server
# binds to. Windows tends to use IPv6 instead if possible, breaking the test.
my $url_base = 'http://127.0.0.1:1080';
my $ua = LWP::UserAgent->new(env_proxy => 0, keep_alive => 1, timeout => 30);
print "GET request...\n";
my $response1 = $ua->get("$url_base/test-one/34/341s/234?p1=vOne&p2=vTwo");
die $response1->content unless $response1->is_success();
my $content = $response1->content();
check_url($content, '/test-one/34/341s/234');
check_params($content, 'p1'=>'vOne','p2'=>'vTwo');
print "POST request...\n";
my %post = ('sdfgksjhdfsd'=>'dfvsiufy2e3434','sxciuhwf8723e4'=>'238947829334',
'&sfsfsfskfhs'=>'?hdkfjhsjfds','fdsf=sdf2342'=>'3984sajhksda');
my $response2 = $ua->post("$url_base/tdskjhfsjdkhf2943734?p1=vOne&p2=vTwo", \%post);
my $content2 = $response2->content();
check_url($content2, '/tdskjhfsjdkhf2943734');
check_params($content2, %post);
print "HEAD request...\n";
my $response3 = $ua->head("$url_base/tdskjhfsdfkjhs");
if($response3->content() ne '')
{
print "Content not zero length\n";
exit(1);
}
if($response3->code() != 200)
{
print "Wrong response code\n";
exit(1);
}
print "Redirected GET request...\n";
my $response4 = $ua->get("$url_base/redirect?key=value");
exit 4 unless $response4->is_success();
my $content4 = $response4->content();
check_url($content4, '/redirected');
check_params($content4);
print "Cookie tests...\n";
# from examples in specs
test_cookies('CUSTOMER=WILE_E_COYOTE', 'CUSTOMER=WILE_E_COYOTE');
test_cookies('CUSTOMER="WILE_E_COYOTE"; C2="pants"', 'CUSTOMER=WILE_E_COYOTE', 'C2=pants');
test_cookies('CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001', 'CUSTOMER=WILE_E_COYOTE', 'PART_NUMBER=ROCKET_LAUNCHER_0001');
test_cookies('CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001; SHIPPING=FEDEX', 'CUSTOMER=WILE_E_COYOTE', 'PART_NUMBER=ROCKET_LAUNCHER_0001', 'SHIPPING=FEDEX');
test_cookies('$Version="1"; Customer="WILE_E_COYOTE"; $Path="/acme"', 'Customer=WILE_E_COYOTE');
test_cookies('$Version="1"; Customer="WILE_E_COYOTE"; $Path="/acme"; Part_Number="Rocket_Launcher_0001"; $Path="/acme" ',
'Customer=WILE_E_COYOTE', 'Part_Number=Rocket_Launcher_0001');
test_cookies(qq!\$Version="1"; Customer="WILE_E_COYOTE"; \$Path="/acme"; Part_Number="Rocket_Launcher_0001"; \$Path="/acme"; Shipping="FedEx"; \t \$Path="/acme"!,
'Customer=WILE_E_COYOTE', 'Part_Number=Rocket_Launcher_0001', 'Shipping=FedEx');
# test the server setting cookies in the UA
require HTTP::Cookies;
$ua->cookie_jar(HTTP::Cookies->new());
$ua->get("$url_base/set-cookie");
test_cookies('', 'SetByServer=Value1');
sub test_cookies
{
my ($c_str, @cookies) = @_;
test_cookies2($c_str, @cookies);
$c_str =~ s/;/,/g;
test_cookies2($c_str, @cookies);
}
sub test_cookies2
{
my ($c_str, @cookies) = @_;
my $r;
if($c_str ne '')
{
$r = $ua->get("$url_base/cookie", 'Cookie' => $c_str);
}
else
{
$r = $ua->get("$url_base/cookie");
}
my $c = $r->content();
for(@cookies)
{
unless($c =~ m/COOKIE:$_
/)
{
print "Cookie $_ not found\n";
exit(1);
}
}
}
sub check_url
{
my ($c,$url) = @_;
unless($c =~ m~URI: (.+?)