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
|
# This test requires a locally deployed httpbin
#
# $ docker pull kennethreitz/httpbin
# $ docker run -p 31234:80 kennethreitz/httpbin
BEGIN {
if ( $ENV{NO_NETWORK_TESTING} ) {
print "1..0 # SKIP Live tests disabled due to NO_NETWORK_TESTING\n";
exit;
}
eval {
require IO::Socket::INET;
my $s = IO::Socket::INET->new(
PeerHost => "localhost:31234",
Timeout => 5,
);
die "Can't connect: $@" unless $s;
};
if ($@) {
print "1..0 # SKIP Can't connect to localhost\n";
print $@;
exit;
}
}
use strict;
use warnings;
use Test::More;
use Net::HTTP;
# Attempt to verify that RT#112313 (Hang in my_readline() when keep-alive => 1 and $response_size % 1024 == 0) is fixed
# To do that, we need responses (headers + body) that are even multiples of 1024 bytes. So we
# iterate over the same URL, trying to grow the response size incrementally...
# There's a chance this test won't work if, for example, the response body grows by one byte while
# the Content-Length also rolls over to one more digit, thus increasing the total response by two
# bytes.
# So, we check that the response growth is only one byte after each iteration and also test multiple
# times across the 1024, 2048 and 3072 boundaries...
sub try
{
my $n = shift;
# Need a new socket every time because we're testing with Keep-Alive...
my $s = Net::HTTP->new(
Host => "localhost:31234",
KeepAlive => 1,
PeerHTTPVersion => "1.1",
) or die "$@";
$s->write_request(GET => '/headers',
'User-Agent' => "Net::HTTP - $0",
'X-Foo' => ('x' x $n),
);
# Wait until all data is probably available on the socket...
sleep 1;
my ($code, $mess, @headers) = $s->read_response_headers();
# XXX remove X-Processed-Time header
for my $i (0..$#headers) {
if ($headers[$i] eq 'X-Processed-Time') {
splice @headers, $i, 2;
last;
}
}
my $body = '';
while ($s->read_entity_body(my $buf, 1024))
{
$body .= $buf;
}
# Compute what is probably the total response length...
my $total_len = length(join "\r\n", 'HTTP/1.1', "$code $mess", @headers, '', $body) - 1;
# diag("$n - $code $mess => $total_len");
# diag(join "\r\n", 'HTTP/1.1', "$code $mess", @headers, '', $body);
$code == 200
or die "$code $mess";
return $total_len;
}
my $timeout = 15;
my $wiggle_room = 3;
local $SIG{ALRM} = sub { die 'timeout' };
my $base_len = try(1);
ok($base_len < 1024, "base response length is less than 1024: $base_len");
for my $kb (1024, 2048, 3072)
{
my $last;
# Calculate range that will take us across the 1024 boundary...
for my $n (($kb - $base_len - $wiggle_room) .. ($kb - $base_len + $wiggle_room))
{
my $len = -1;
eval {
alarm $timeout;
$len = try($n);
};
ok(!$@, "ok for n $n -> response length $len")
or diag("error: $@");
# Verify that response length only increased by one since the whole test rests on that assumption...
is($len - $last, 1, 'response length increased by 1') if $last;
$last = $len;
}
}
done_testing();
|
