view release on metacpan or  search on metacpan

t/1211-proxy.t  view on Meta::CPAN

    $d = body_of($call->(xff => '9.9.9.9, 1.2.3.4'));
    is $d->{remote_addr}, '1.2.3.4',
       'a client-forged leading entry does not become REMOTE_ADDR';

    $d = body_of($call->());
    is $d->{remote_addr}, '10.0.0.1', 'no header: the peer, unchanged';
    is $d->{remote_port}, 54321, 'and the port survives when nothing moved';
    is $d->{peer_addr}, '10.0.0.1', 'punk.peer_addr is set regardless';
}

# ---- scheme, host and port -------------------------------------------------

{
    package Fwd;
    use Punk;
    proxy;
    get '/env' => \&main::echo;
}
{
    my $call = caller_for(Fwd->to_app);

    my $d = body_of($call->(proto => 'https'));
    is $d->{scheme}, 'https',
       'X-Forwarded-Proto sets psgi.url_scheme behind terminated TLS';
    is $d->{https}, 'on', 'and HTTPS=on, which is the key other code reads';

    $d = body_of($call->(proto => 'HTTPS'));
    is $d->{scheme}, 'https', 'the scheme compare is case-insensitive';

    $d = body_of($call->(proto => 'https, http'));
    is $d->{scheme}, 'https',
       'a comma-joined proto list takes the client-facing (leftmost) hop';

    $d = body_of($call->(proto => 'gopher'));
    is $d->{scheme}, 'http', 'an unknown scheme changes nothing';

    $d = body_of($call->(host => 'app.example.com'));
    is $d->{host}, 'app.example.com', 'X-Forwarded-Host sets HTTP_HOST';

    $d = body_of($call->(port => '443'));
    is $d->{port}, '443', 'X-Forwarded-Port sets SERVER_PORT';

    $d = body_of($call->(port => '44a3'));
    is $d->{port}, 80, 'a non-numeric forwarded port is ignored';
}

# ---- custom header names ---------------------------------------------------

{
    package Custom;
    use Punk;
    proxy trust => 1, for_header => 'CF-Connecting-IP';
    get '/env' => \&main::echo;
}
{
    my $call = caller_for(Custom->to_app);
    my $d = body_of($call->(hdr => 'CF_CONNECTING_IP', hval => '1.2.3.4',
                            xff => '9.9.9.9'));
    is $d->{remote_addr}, '1.2.3.4', 'for_header names a different header';
    isnt $d->{remote_addr}, '9.9.9.9',
       'and the standard X-Forwarded-For is not consulted once it is renamed';
}

# ---- CIDR trust ------------------------------------------------------------

{
    package Cidr;
    use Punk;
    proxy trust => ['10.0.0.0/8'];
    get '/env' => \&main::echo;
}
{
    my $call = caller_for(Cidr->to_app);
    my $d = body_of($call->(xff => '1.2.3.4, 10.0.0.7', peer => '10.0.0.1'));
    is $d->{remote_addr}, '1.2.3.4', 'CIDR trust walks to the first outsider';

    $d = body_of($call->(xff => '1.2.3.4, 10.0.0.7', peer => '8.8.8.8'));
    is $d->{remote_addr}, '8.8.8.8',
       'an untrusted socket peer means the header is not believed';
}

# ---- what block_ip does behind a proxy -------------------------------------

# Banning the address the socket came from bans the load balancer. Boot config
# cannot catch it, and a silent no-op would leave an operator believing they
# had banned someone.
{
    package Ban;
    use Punk;
    proxy;
    get '/ban-peer'   => sub {
        my ($c) = @_;
        $c->block_ip($c->env->{'punk.peer_addr'});
        $c->text('banned');
    };
    get '/ban-client' => sub {
        my ($c) = @_;
        $c->block_ip($c->req->address);
        $c->text('banned');
    };
    get '/env' => \&main::echo;
}
{
    my $call = caller_for(Ban->to_app);

    my $res = $call->(path => '/ban-peer', xff => '1.2.3.4');
    is $res->[0], 500, 'block_ip on the proxy address is refused';
    like join('', @{ $res->[2] }), qr/reverse proxy|took the site down|would take/i,
        'and says why rather than failing silently';

    $res = $call->(path => '/ban-client', xff => '1.2.3.4');
    is $res->[0], 200, 'banning the real client is fine';
}

# ---- boot-time refusals ----------------------------------------------------

sub boot_fails {
    my ($body, $like, $what) = @_;
    my $pkg = 'Boot' . int(rand 1e9);
    eval "package $pkg; use Punk; $body; ${pkg}->to_app; 1";
    my $err = $@ || '';