1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
#!/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:$_<br>/)
{
print "Cookie $_ not found\n";
exit(1);
}
}
}
sub check_url
{
my ($c,$url) = @_;
unless($c =~ m~URI:</b> (.+?)</p>~)
{
print "URI not found\n";
exit(1);
}
if($url ne $1)
{
print "Wrong URI in content\n";
exit(1);
}
}
sub check_params
{
my ($c,%params) = @_;
while($c =~ m/^PARAM:(.+)=(.+?)<br>/mg)
{
if($params{$1} ne $2)
{
print "$1=$2 not found in response\n";
exit(1);
}
delete $params{$1}
}
my @k = keys %params;
if($#k != -1)
{
print "Didn't find all params\n";
exit(1);
}
}
|
