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
146
147
148
149
150
151
152
153
154
155
156
|
use strict;
use Test::More;
use LWP::UserAgent;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use t::Utils; # some helper functions for the server
if( $^O eq 'MSWin32' ) {
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
exit;
}
plan tests => 13;
my $test = Test::Builder->new;
my @pids;
# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);
# create a HTTP::Daemon (on an available port)
my $server = server_start();
# create and fork the proxy
my $proxy = HTTP::Proxy->new( port => 0, max_connections => 5 );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
push @pids, fork_proxy($proxy);
# fork the HTTP server
my $pid = fork;
die "Unable to fork web server" if not defined $pid;
if ( $pid == 0 ) {
my $res = HTTP::Response->new(
200, 'OK',
HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
"Here is some data."
);
# let's return some files when asked for them
server_next($server) for 1 .. 3;
server_next($server,
sub {
my $req = shift;
SKIP: {
skip 'FreeBSD jail does not treat localhost as 127.0.0.1', 1
if ($^O eq 'freebsd' && `sysctl -n security.jail.jailed` == 1);
# This assumes a client comes from localhost. Ideal test
# would check against a value smuggled from the client
# in the HTTP request.
like( $req->header("X-Forwarded-For"),
qr/^(?:127\.0\.0\.1|::1)$/,
"The daemon got X-Forwarded-For" );
}
return $res;
}
);
server_next( $server,
sub {
my $req = shift;
is( $req->header("X-Forwarded-For"), undef,
"The daemon didn't get X-Forwarded-For" );
return $res;
}
);
exit 0;
}
push @pids, $pid;
# run a client
my ( $req, $res );
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );
#
# check that we have single Date and Server headers
#
# for GET requests
$req = HTTP::Request->new( GET => $server->url . "headers" );
$res = $ua->simple_request($req);
my @date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for GET request" );
my @server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for GET request" );
# for HEAD requests
$req = HTTP::Request->new( HEAD => $server->url . "headers-head" );
$res = $ua->simple_request($req);
@date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for HEAD request" );
@server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for HEAD request" );
# for direct proxy responses
$ua->proxy( file => $proxy->url );
$req = HTTP::Request->new( GET => "file:///etc/passwd" );
$res = $ua->simple_request($req);
@date = $res->headers->header('Date');
is( scalar @date, 1, "A single Date: header for direct proxy response" );
@server = $res->headers->header('Server');
is( scalar @server, 1, "A single Server: header for direct proxy response" );
# check the Server: header
like( $server[0], qr!HTTP::Proxy/\d+\.\d+!, "Correct server name for direct proxy response" );
# we cannot use a LWP user-agent to check
# that the LWP Client-* headers are removed
use IO::Socket::IP ();
use URI ();
# connect directly to the proxy
my $sock = IO::Socket::IP->new(
PeerAddr => URI->new($proxy->url)->host,
PeerPort => URI->new($proxy->url)->port,
Proto => 'tcp'
) or diag "Can't connect to the proxy";
# send the request
my $url = $server->url;
$url =~ m!http://([^/]*)!;
print $sock "GET $url HTTP/1.0\015\012Host: $1\015\012\015\012";
# fetch and count the Client-* response headers
my @client = grep { /^Client-/ } <$sock>;
is( scalar @client, 0, "No Client-* headers sent by the proxy" );
# close the connection to the proxy
close $sock or diag "close: $!";
# X-Forwarded-For (test in the server)
$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" );
$res = $ua->simple_request($req);
is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" );
# yet another proxy
$proxy = HTTP::Proxy->new( port => 0, max_connections => 1, x_forwarded_for => 0 );
$proxy->init; # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
$proxy->push_filter( response => HTTP::Proxy::HeaderFilter::simple->new(
sub { is( $_[0]->proxy->client_headers->header("Client-Response-Num"), 1,
"Client headers" ); } ) );
push @pids, fork_proxy($proxy);
# X-Forwarded-For (test in the server)
$ua->proxy( http => $proxy->url );
$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" );
$res = $ua->simple_request($req);
is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" );
# make sure both kids are dead
wait for @pids;
|
