File: 50via.t

package info (click to toggle)
libhttp-proxy-perl 0.304-5
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, sid, trixie
  • size: 720 kB
  • sloc: perl: 2,576; makefile: 4
file content (88 lines) | stat: -rw-r--r-- 2,332 bytes parent folder | download | duplicates (9)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
use strict;
use Test::More;
use LWP::UserAgent;
use HTTP::Proxy;
use t::Utils;    # some helper functions for the server

if( $^O eq 'MSWin32' ) {
    plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0";
    exit;
}

plan tests => 4;

my $test = Test::Builder->new;
my @pids;

# this is a rather long test suite just to test that
# $proxy->via() works ok

# this is to work around tests in forked processes
$test->use_numbers(0);
$test->no_ending(1);

# create a HTTP::Daemon (on an available port)
my $server = server_start();

# create and fork the proxy
# the proxy itself will not fork
my $proxy = HTTP::Proxy->new( port => 0, max_connections => 1, max_clients => 0 );
$proxy->init;    # required to access the url later
$proxy->agent->no_proxy( URI->new( $server->url )->host );
push @pids, fork_proxy($proxy);

# fork the HTTP server
my $pid = fork;
die "Unable to fork web server" if not defined $pid;

if ( $pid == 0 ) {

    # the answer method
    my $answer1 = sub {
        my ( $req, $data ) = @_;
        isnt( $req->headers->header('Via'), undef, "Server says Via: header added" );
        return HTTP::Response->new(
            200, 'OK',
            HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
            "Headers checked."
        );
    };
    my $answer2 = sub {
        my ( $req, $data ) = @_;
        is( $req->headers->header('Via'), undef, "Server says no Via: header added" );
        return HTTP::Response->new(
            200, 'OK',
            HTTP::Headers->new( 'Content-Type' => 'text/plain' ),
            "Headers checked."
        );
    };

    # let's return some files when asked for them
    server_next( $server, $answer1 );
    server_next( $server, $answer2 );

    exit 0;
}

push @pids, $pid;

# run a client
my ( $req, $res );
my $ua = LWP::UserAgent->new;
$ua->proxy( http => $proxy->url );

# send a Proxy-Connection header
$req = HTTP::Request->new( GET => $server->url );
$res = $ua->simple_request($req);
isnt( $res->headers->header('Via'), undef, "Client says Via: header added" );

# create and fork the proxy
$proxy->via('');
push @pids, fork_proxy($proxy);
$res = $ua->simple_request($req);
is( $res->headers->header('Via'), undef, "Client says no Via: header added" );


# make sure both kids are dead
wait for @pids;