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
|
#! /usr/bin/perl
# vim: ts=2 sw=2 filetype=perl expandtab
# Test case for POE::Component::Client::HTTP failing to redirect HEAD
# requests.
use strict;
use warnings;
sub DEBUG () { 0 }
BEGIN {
my @proxies = grep /^http.*proxy$/i, keys %ENV;
delete @ENV{@proxies} if @proxies;
}
use Test::More tests => 2;
use Test::POE::Server::TCP;
use POE qw(Component::Client::HTTP);
use HTTP::Request::Common qw(HEAD);
POE::Component::Client::HTTP->spawn( Alias => 'no_redir' );
POE::Component::Client::HTTP->spawn( Alias => 'redir', FollowRedirects => 5 );
POE::Session->create(
inline_states => {
_start => \&start,
testd_registered => \&testd_start,
testd_client_input => \&testd_input,
manual => \&manual,
automatic => \&automatic,
}
);
sub start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
DEBUG and warn "client starting...\n";
$heap->{testd} = Test::POE::Server::TCP->spawn(
Filter => POE::Filter::Stream->new,
address => 'localhost',
);
}
sub testd_start {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $port = $heap->{testd}->port;
$kernel->post(
no_redir => request => manual => HEAD "http://localhost:$port/redir"
);
}
sub testd_input {
my ($kernel, $heap, $id, $input) = @_[KERNEL, HEAP, ARG0, ARG1];
my $port = $heap->{testd}->port;
my $data;
if ($input =~ /redir/) {
$data = <<"EOF";
HTTP/1.1 303 See Other
Location: http://localhost:$port/destination
EOF
} else {
$data = <<'EOF';
HTTP/1.1 200 Ok
Host:
EOF
}
$heap->{testd}->send_to_client($id, $data);
}
sub manual {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $response = $_[ARG1][0];
my $code = $response->code();
if ($code =~ /^3/) {
$kernel->post(
no_redir => request => manual => HEAD $response->header("location")
);
return;
}
$heap->{destination} = $_[ARG0][0]->header("host");
my $port = $heap->{testd}->port;
$kernel->post(
redir => request => automatic => HEAD "http://localhost:$port/redir"
);
}
sub automatic {
my ($kernel, $heap) = @_[KERNEL, HEAP];
my $rsp = $_[ARG1][0];
my $code = $rsp->code();
is($code, 200, "got correct response code");
my $rsp_host = $rsp->request->header("host");
my $exp_host = $heap->{destination};
is( $rsp_host, $exp_host, "automatic redirect host matches manual result");
$heap->{testd}->shutdown;
$kernel->post( no_redir => 'shutdown' );
$kernel->post( redir => 'shutdown' );
}
POE::Kernel->run();
exit;
|
