1use Test::More; 2use strict; 3 4# here are all the requests the client will try 5my @requests = qw( 6 file1.txt 7 directory/file2.txt 8 ooh.cgi?q=query 9); 10 11if( $^O eq 'MSWin32' ) { 12 plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0"; 13 exit; 14} 15 16plan tests => 3 * @requests + 1; 17 18use LWP::UserAgent; 19use HTTP::Proxy; 20use t::Utils; # some helper functions for the server 21 22my $test = Test::Builder->new; 23 24# this is to work around tests in forked processes 25$test->use_numbers(0); 26$test->no_ending(1); 27 28# create a HTTP::Daemon (on an available port) 29my $server = server_start(); 30my $serverurl = $server->url; 31 32my $proxy = HTTP::Proxy->new( port => 0, max_connections => scalar @requests ); 33$proxy->init; # required to access the url later 34$proxy->agent->no_proxy( URI->new( $server->url )->host ); 35my $proxyurl = $proxy->url; 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( 51 200, 'OK', 52 HTTP::Headers->new( 'Content-Type' => 'text/plain' ), 53 "Here is $data." 54 ); 55 }; 56 57 # let's return some files when asked for them 58 server_next( $server, $answer, $_ ) for @requests; 59 60 exit 0; 61} 62 63# back in the parent 64push @pids, $pid; # remember the kid 65 66# fork a HTTP proxy 67$pid = fork_proxy( 68 $proxy, 69 sub { 70 is( $proxy->conn, scalar @requests, 71 "The proxy served the correct number of connections" ); 72 } 73); 74 75# back in the parent 76push @pids, $pid; # remember the kid 77 78# run a client 79my $ua = LWP::UserAgent->new; 80$ua->proxy( http => $proxyurl ); 81 82for (@requests) { 83 my $req = HTTP::Request->new( GET => $serverurl . $_ ); 84 my $rep = $ua->simple_request($req); 85 ok( $rep->is_success, "Got an answer (@{[$rep->status_line]})" ); 86 my $re = quotemeta; 87 like( $rep->content, qr/$re/, "The client got what it expected" ); 88} 89 90# make sure both kids are dead 91wait for @pids; 92