Reverse-Proxy

 view release on metacpan or  search on metacpan

Proxy.xs  view on Meta::CPAN

    /* Content-Type (Content-Length is added by Fetch from the body) */
    p = rp_env(aTHX_ env, "CONTENT_TYPE", 12, &l);
    if (p) rp_push(aTHX_ hav, "Content-Type", 12, p, l);

    /* Host, only when preserving it */
    if (preserve_host) {
        p = rp_env(aTHX_ env, "HTTP_HOST", 9, &l);
        if (p) rp_push(aTHX_ hav, "Host", 4, p, l);
    }

    /* X-Forwarded-For: chain REMOTE_ADDR onto any existing value */
    {
        STRLEN cl; const char *client = rp_env(aTHX_ env, "REMOTE_ADDR", 11, &cl);
        if (client) {
            STRLEN xl; const char *xff = rp_env(aTHX_ env, "HTTP_X_FORWARDED_FOR", 20, &xl);
            SV *v = newSVpvs("");
            if (xff) { sv_catpvn(v, xff, xl); sv_catpvs(v, ", "); }
            sv_catpvn(v, client, cl);
            av_push(hav, newSVpvs("X-Forwarded-For"));
            av_push(hav, v);
        }
    }

    /* X-Forwarded-Proto: existing, else psgi.url_scheme, else http */
    {
        STRLEN pl; const char *proto = rp_env(aTHX_ env, "HTTP_X_FORWARDED_PROTO", 22, &pl);
        if (!proto) proto = rp_env(aTHX_ env, "psgi.url_scheme", 15, &pl);
        av_push(hav, newSVpvs("X-Forwarded-Proto"));
        av_push(hav, proto ? newSVpvn(proto, pl) : newSVpvs("http"));

Proxy.xs  view on Meta::CPAN

            { STRLEN vl; const char *vp = SvPV_const(val, vl);
              sv_catpvn(req, name, nl); sv_catpvs(req, ": "); sv_catpvn(req, vp, vl);
              sv_catpvs(req, "\r\n"); }
        }
        if (name != nb) { Safefree(name); Safefree(lc); }
    }
    {
        STRLEN cl; const char *client = rp_env(aTHX_ env, "REMOTE_ADDR", 11, &cl);
        if (client) {
            STRLEN xl; const char *xff = rp_env(aTHX_ env, "HTTP_X_FORWARDED_FOR", 20, &xl);
            sv_catpvs(req, "X-Forwarded-For: ");
            if (xff) { sv_catpvn(req, xff, xl); sv_catpvs(req, ", "); }
            sv_catpvn(req, client, cl); sv_catpvs(req, "\r\n");
        }
    }
    {
        STRLEN pl2; const char *proto = rp_env(aTHX_ env, "HTTP_X_FORWARDED_PROTO", 22, &pl2);
        if (!proto) proto = rp_env(aTHX_ env, "psgi.url_scheme", 15, &pl2);
        sv_catpvs(req, "X-Forwarded-Proto: ");
        if (proto) sv_catpvn(req, proto, pl2); else sv_catpvs(req, "http");
        sv_catpvs(req, "\r\n");

lib/Reverse/Proxy.pm  view on Meta::CPAN

It runs on any PSGI server. On L<Hyperman> - which advertises C<psgix.loop> and
C<psgi.nonblocking> - it forwards with Fetch running on the worker's own event
loop and hands the server back a L<Fetch::Future>, so a single worker proxies
many concurrent requests without a thread or process each. On other servers it
makes a blocking Fetch call per request. Either way it reuses one keep-alive
connection pool to the upstream per worker.

Standard proxy behaviour is handled for you: hop-by-hop headers (C<Connection>,
C<Keep-Alive>, C<TE>, C<Trailer>, C<Transfer-Encoding>, C<Upgrade>,
C<Proxy-Authenticate>, C<Proxy-Authorization>, and anything the client's
C<Connection> header names) are stripped in both directions; C<X-Forwarded-For>,
C<X-Forwarded-Proto> and C<X-Forwarded-Host> are appended; multi-valued response
headers such as C<Set-Cookie> are preserved; and an unreachable or failing
upstream yields a C<502>.

=head2 The forwarded request target

C<PATH_INFO> reaches a PSGI application percent-B<decoded>, and the request
target is written into a request line that terminates at the first space or
CRLF. So the path is re-encoded on the way out: any byte at or below C<0x20>,
C<0x7f> and above, and C<%>, C<#> and C<?> go back to C<%XX>.

t/01-basic.t  view on Meta::CPAN

my $app = Reverse::Proxy->new(upstream => "http://127.0.0.1:$port")->to_app;

# ---- GET with query + a custom header ------------------------------------
{
	my $res = $app->(make_env(GET => '/foo/bar', 'baz=1', { 'X-Custom' => 'hi' }));
	is($res->[0], 200, 'GET proxied, 200');
	my $body = $res->[2][0];
	like($body, qr/\bM=GET\b/,            'method forwarded');
	like($body, qr{\bU=/foo/bar\?baz=1\b}, 'path + query forwarded');
	like($body, qr/\bXC=hi\b/,            'custom request header forwarded');
	like($body, qr/\bXFF=203\.0\.113\.7\b/, 'X-Forwarded-For added from REMOTE_ADDR');
	like($body, qr/\bXFP=http\b/,         'X-Forwarded-Proto added');
	like($body, qr/\bHOST=127\.0\.0\.1:$port\b/, 'Host set from upstream (no preserve_host)');

	is(header_val($res->[1], 'Content-Type'), 'text/plain', 'response Content-Type passed through');
	is(header_val($res->[1], 'Keep-Alive'), undef, 'hop-by-hop Keep-Alive stripped from response');
	is(header_val($res->[1], 'Connection'), undef, 'hop-by-hop Connection stripped from response');
	is_deeply([ header_all($res->[1], 'Set-Cookie') ], [ 'a=1', 'b=2' ],
		'multi-value Set-Cookie preserved in order');
}

t/07-headers.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More;
use IO::Socket::INET;
use Reverse::Proxy;

# Request-side header handling: hop-by-hop stripping (including names listed in
# the client's own Connection header), X-Forwarded-For chaining, X-Forwarded-Host,
# a pre-existing X-Forwarded-Proto, and the Via header (default and omitted).
#
# The backend echoes every request header it received back in the body, one
# "name: value" per line, so the test can assert exactly what was forwarded.

sub spawn_backend {
	my $srv = IO::Socket::INET->new(
		LocalHost => '127.0.0.1', LocalPort => 0, Listen => 16, ReuseAddr => 1,
	) or die "listen: $!";
	my $port = $srv->sockport;

t/07-headers.t  view on Meta::CPAN

	}));
	is($res->[0], 200, 'request with hop-by-hop headers proxied 200');
	my $h = seen_headers($res->[2][0]);
	is($h->{'connection'},   undef, 'Connection stripped from forwarded request');
	is($h->{'x-custom-hop'}, undef, 'header named in client Connection is stripped');
	is($h->{'upgrade'},      undef, 'Upgrade stripped from forwarded request');
	is($h->{'te'},           undef, 'TE stripped from forwarded request');
	is($h->{'x-keep'},       'yes', 'ordinary header forwarded through');
}

# ---- X-Forwarded-For chaining --------------------------------------------
{
	my $res = $app->(make_env({ 'X-Forwarded-For' => '10.0.0.1' }));
	my $h = seen_headers($res->[2][0]);
	is($h->{'x-forwarded-for'}, '10.0.0.1, 203.0.113.7',
		'existing X-Forwarded-For chained with REMOTE_ADDR');
}

# ---- X-Forwarded-Host from client Host -----------------------------------
{
	my $res = $app->(make_env({ Host => 'client.example' }));
	my $h = seen_headers($res->[2][0]);
	is($h->{'x-forwarded-host'}, 'client.example',
		'X-Forwarded-Host derived from client Host');
}