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