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