1use strict; 2use Test::More; 3use LWP::UserAgent; 4use HTTP::Proxy; 5use HTTP::Proxy::HeaderFilter::simple; 6use t::Utils; # some helper functions for the server 7 8if( $^O eq 'MSWin32' ) { 9 plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0"; 10 exit; 11} 12 13plan tests => 13; 14 15my $test = Test::Builder->new; 16my @pids; 17 18# this is to work around tests in forked processes 19$test->use_numbers(0); 20$test->no_ending(1); 21 22# create a HTTP::Daemon (on an available port) 23my $server = server_start(); 24 25# create and fork the proxy 26my $proxy = HTTP::Proxy->new( port => 0, max_connections => 5 ); 27$proxy->init; # required to access the url later 28$proxy->agent->no_proxy( URI->new( $server->url )->host ); 29push @pids, fork_proxy($proxy); 30 31# fork the HTTP server 32my $pid = fork; 33die "Unable to fork web server" if not defined $pid; 34 35if ( $pid == 0 ) { 36 my $res = HTTP::Response->new( 37 200, 'OK', 38 HTTP::Headers->new( 'Content-Type' => 'text/plain' ), 39 "Here is some data." 40 ); 41 42 # let's return some files when asked for them 43 server_next($server) for 1 .. 3; 44 server_next($server, 45 sub { 46 my $req = shift; 47 is( $req->header("X-Forwarded-For"), '127.0.0.1', 48 "The daemon got X-Forwarded-For" ); 49 return $res; 50 } 51 ); 52 server_next( $server, 53 sub { 54 my $req = shift; 55 is( $req->header("X-Forwarded-For"), undef, 56 "The daemon didn't get X-Forwarded-For" ); 57 return $res; 58 } 59 ); 60 61 exit 0; 62} 63 64push @pids, $pid; 65 66# run a client 67my ( $req, $res ); 68my $ua = LWP::UserAgent->new; 69$ua->proxy( http => $proxy->url ); 70 71# 72# check that we have single Date and Server headers 73# 74 75# for GET requests 76$req = HTTP::Request->new( GET => $server->url . "headers" ); 77$res = $ua->simple_request($req); 78my @date = $res->headers->header('Date'); 79is( scalar @date, 1, "A single Date: header for GET request" ); 80my @server = $res->headers->header('Server'); 81is( scalar @server, 1, "A single Server: header for GET request" ); 82 83# for HEAD requests 84$req = HTTP::Request->new( HEAD => $server->url . "headers-head" ); 85$res = $ua->simple_request($req); 86@date = $res->headers->header('Date'); 87is( scalar @date, 1, "A single Date: header for HEAD request" ); 88@server = $res->headers->header('Server'); 89is( scalar @server, 1, "A single Server: header for HEAD request" ); 90 91# for direct proxy responses 92$ua->proxy( file => $proxy->url ); 93$req = HTTP::Request->new( GET => "file:///etc/passwd" ); 94$res = $ua->simple_request($req); 95@date = $res->headers->header('Date'); 96is( scalar @date, 1, "A single Date: header for direct proxy response" ); 97@server = $res->headers->header('Server'); 98is( scalar @server, 1, "A single Server: header for direct proxy response" ); 99# check the Server: header 100like( $server[0], qr!HTTP::Proxy/\d+\.\d+!, "Correct server name for direct proxy response" ); 101 102# we cannot use a LWP user-agent to check 103# that the LWP Client-* headers are removed 104use IO::Socket::INET; 105 106# connect directly to the proxy 107$proxy->url() =~ /:(\d+)/; 108my $sock = IO::Socket::INET->new( 109 PeerAddr => 'localhost', 110 PeerPort => $1, 111 Proto => 'tcp' 112 ) or diag "Can't connect to the proxy"; 113 114# send the request 115my $url = $server->url; 116$url =~ m!http://([^:]*)!; 117print $sock "GET $url HTTP/1.0\015\012Host: $1\015\012\015\012"; 118 119# fetch and count the Client-* response headers 120my @client = grep { /^Client-/ } <$sock>; 121is( scalar @client, 0, "No Client-* headers sent by the proxy" ); 122 123# close the connection to the proxy 124close $sock or diag "close: $!"; 125 126# X-Forwarded-For (test in the server) 127$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" ); 128$res = $ua->simple_request($req); 129is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" ); 130 131# yet another proxy 132$proxy = HTTP::Proxy->new( port => 0, max_connections => 1, x_forwarded_for => 0 ); 133$proxy->init; # required to access the url later 134$proxy->agent->no_proxy( URI->new( $server->url )->host ); 135$proxy->push_filter( response => HTTP::Proxy::HeaderFilter::simple->new( 136 sub { is( $_[0]->proxy->client_headers->header("Client-Response-Num"), 1, 137 "Client headers" ); } ) ); 138push @pids, fork_proxy($proxy); 139 140# X-Forwarded-For (test in the server) 141$ua->proxy( http => $proxy->url ); 142$req = HTTP::Request->new( HEAD => $server->url . "x-forwarded-for" ); 143$res = $ua->simple_request($req); 144is( $res->header( 'X-Forwarded-For' ), undef, "No X-Forwarded-For sent back" ); 145 146# make sure both kids are dead 147wait for @pids; 148 149