1use strict; 2use vars qw( @requests ); 3use Socket; 4 5# here are all the requests the client will try 6BEGIN { 7 @requests = ( 8 9 # host, expected code, shouldn't resolve 10 [ 'http://www.mongueurs.net/', 200 ], 11 [ 'http://httpd.apache.org/docs', 301 ], 12 [ 'http://www.google.com/testing/', 404 ], 13 [ 'http://www.error.zzz/', '5..', 1 ], 14 ); 15} 16 17use Test::More tests => @requests + 1; 18use t::Utils; 19use LWP::UserAgent; 20use HTTP::Proxy; 21 22# we skip the tests if the network is not available 23 24SKIP: { 25 skip "Web does not seem to work", @requests + 1 unless web_ok(); 26 27 my $test = Test::Builder->new; 28 29 # this is to work around tests in forked processes 30 $test->use_numbers(0); 31 $test->no_ending(1); 32 33 my $proxy = HTTP::Proxy->new( 34 port => 0, 35 max_connections => scalar @requests, 36 ); 37 $proxy->init; # required to access the url later 38 39 # fork a HTTP proxy 40 my $pid = fork_proxy( 41 $proxy, 42 sub { 43 ok( $proxy->conn == @requests, 44 "Served the correct number of requests" ); 45 } 46 ); 47 48 # run a client 49 my $ua = LWP::UserAgent->new; 50 $ua->proxy( http => $proxy->url ); 51 52 for (@requests) { 53 my ( $uri, $code, $dns_fail ) = @$_; 54 $uri = URI->new($uri); 55 $dns_fail &&= defined +( gethostbyname $uri->host )[4]; 56 57 SKIP: { 58 if ($dns_fail) { 59 60 # contact the proxy anyway 61 $ua->simple_request( 62 HTTP::Request->new( GET => 'http://localhost/' ) ); 63 skip "Our DNS shouldn't resolve " . $uri->host, 1; 64 } 65 else { 66 67 # the real test 68 my $req = HTTP::Request->new( GET => $uri ); 69 my $rep = $ua->simple_request($req); 70 like( 71 $rep->code, qr/^$code$/, "Got an answer (@{[$rep->code]})" 72 ); 73 } 74 } 75 } 76 77 # make sure the kid is dead 78 wait; 79} 80