1use strict; 2use Test::More; 3 4# here are all the requests the client will try 5my @requests = ( 6 'single.txt', ( 'file1.txt', 'directory/file2.txt', 'ooh.cgi?q=query' ) x 2 7); 8 9if( $^O eq 'MSWin32' ) { 10 plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0"; 11 exit; 12} 13plan tests => 3 * @requests + 1; 14 15use LWP::UserAgent; 16use HTTP::Proxy; 17use t::Utils; # some helper functions for the server 18 19my $test = Test::Builder->new; 20 21# this is to work around tests in forked processes 22$test->use_numbers(0); 23$test->no_ending(1); 24 25# create a HTTP::Daemon (on an available port) 26my $server = server_start(); 27 28# create a HTTP::Proxy 29my $proxy = HTTP::Proxy->new( 30 port => 0, 31 max_keep_alive_requests => 3, # no more than 3 requests per connection 32 max_connections => 3, # no more than 3 connections 33); 34$proxy->init; # required to access the url later 35$proxy->agent->no_proxy( URI->new( $server->url )->host ); 36 37# fork the HTTP server 38my @pids; 39my $pid = fork; 40die "Unable to fork web server" if not defined $pid; 41 42if ( $pid == 0 ) { 43 44 # the answer method 45 my $answer = sub { 46 my $req = shift; 47 my $data = shift; 48 my $re = quotemeta $data; 49 like( $req->uri, qr/$re/, "The daemon got what it expected" ); 50 return HTTP::Response->new( 200, 'OK', 51 HTTP::Headers->new( 'Content-Type' => 'text/plain' ), 52 "Here is $data." ); 53 }; 54 55 # let's return some files when asked for them 56 server_next( $server, $answer, $_ ) for @requests; 57 58 exit 0; 59} 60 61# back in the parent 62push @pids, $pid; # remember the kid 63 64# fork a HTTP proxy 65fork_proxy( 66 $proxy, sub { 67 is( $proxy->conn, 3, 68 "The proxy served the correct number of connections" ); 69 } 70); 71 72# back in the parent 73push @pids, $pid; # remember the kid 74 75# some variables 76my ( $ua, $res, $re ); 77 78# the first connection will be closed by the client 79$ua = LWP::UserAgent->new; 80$ua->proxy( http => $proxy->url ); 81 82my $req = shift @requests; 83$res = 84 $ua->simple_request( 85 HTTP::Request->new( GET => $server->url . $req ) ); 86ok( $res->is_success, "Got an answer (@{[$res->status_line]})" ); 87$re = quotemeta $req; 88like( $res->content, qr/$re/, "The client got what it expected" ); 89 90# the other connections (keep-alive) 91$ua = LWP::UserAgent->new( keep_alive => 1 ); 92$ua->proxy( http => $proxy->url ); 93for (@requests) { 94 $res = 95 $ua->simple_request( HTTP::Request->new( GET => $server->url . $_ ) ); 96 ok( $res->is_success, "Got an answer (@{[$res->status_line]})" ); 97 $re = quotemeta; 98 like( $res->content, qr/$re/, "The client got what it expected" ); 99} 100 101# make sure both kids are dead 102wait for @pids; 103