1use Test::More; 2use strict; 3use t::Utils; use HTTP::Proxy; 4use LWP::UserAgent; 5use IO::Socket::INET; 6 7plan skip_all => "Unable to make this test work correctly"; 8plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0" 9 if $^O eq 'MSWin32'; 10 11# make sure we inherit no upstream proxy 12delete $ENV{$_} for qw( http_proxy HTTP_PROXY https_proxy HTTPS_PROXY ); 13 14# test CONNECT 15my $test = Test::Builder->new; 16 17# this is to work around tests in forked processes 18$test->use_numbers(0); 19$test->no_ending(1); 20 21# fork a local server that'll print a banner on connection 22my $host; 23my $banner = "President_of_Earth Barbarella Professor_Ping Stomoxys Dildano\n"; 24{ 25 26 my $server = IO::Socket::INET->new( Listen => 1 ); 27 plan 'skip_all', "Couldn't create local server" if !defined $server; 28 29 $host = 'localhost:' . $server->sockport; 30 my $pid = fork; 31 plan 'skip_all', "Couldn't fork" if !defined $pid; 32 if ( !$pid ) { 33 my $sock = $server->accept; 34 $sock->print($banner); 35 sleep 2; 36 $sock->close; 37 exit; 38 } 39 40} 41 42plan tests => 4; 43 44{ 45 my $proxy = HTTP::Proxy->new( port => 0, max_connections => 1 ); 46 $proxy->init; # required to access the url later 47 48 # fork a HTTP proxy 49 my $pid = fork_proxy( 50 $proxy, 51 sub { 52 ok( $proxy->conn == 1, "Served the correct number of requests" ); 53 } 54 ); 55 56 # wait for the server and proxy to be ready 57 sleep 2; 58 59 # run a client 60 my $ua = LWP::UserAgent->new; 61 $ua->proxy( https => $proxy->url ); 62 63 my $req = HTTP::Request->new( CONNECT => "https://$host/" ); 64 my $res = $ua->request($req); 65 my $sock = $res->{client_socket}; 66 67 68 # what does the proxy say? 69 is( $res->code, 200, "The proxy accepts CONNECT requests" ); 70 71 # read a line 72 my $read; 73 eval { 74 local $SIG{ALRM} = sub { die 'timeout' }; 75 alarm 30; 76 $read = <$sock>; 77 }; 78 79 ok( $read, "Read some data from the socket" ); 80 is( $read, $banner, "CONNECTed to the TCP server and got the banner" ); 81 close $sock; 82 83 # make sure the kids are dead 84 wait for 1 .. 2; 85} 86