AnyEvent HTTP Proxy

anyevent-proxy.pl

#!/usr/bin/perl

# This is HTTP proxy built atop AnyEvent::HTTPD and AnyEvent::HTTP modules.
# I used it to solve some problem but after testing realised that it doesn't solve it entirely.
# So I removed special logic and leave almost plain proxy. With referer forging however :)
#
# Test thoroughly before use!

use strict;
use warnings;

use AnyEvent::HTTPD;
use AnyEvent::HTTP;
use File::Pid;
#use Data::Dumper;

my $pid;
my $httpd;

$SIG{TERM} = sub {
    warn 'Stopping';
    pid_remove($pid);
    $httpd->stop if ($httpd);
    exit;
};

my $pidfile = '/var/run/proxy.pid';
sub pid_write {

    my $pid = File::Pid->new({
        'file' => $pidfile,
        'pid'  => $$,
    });
    if ( -f -s $pidfile ) {
        if ( my $num = $pid->running ) {
            die "Already running: $num\n";
        }
    }
    
    $pid->write or die "Couldn't write pid $pidfile";

    return $pid;
}

sub pid_remove {
    my $pid = shift;
    return unless ($pid);
    return $pid->remove;
}

###############################################################################

my $timeout = 30;

$httpd = AnyEvent::HTTPD->new(
    host => '127.0.0.1', port => 9090,
    request_timeout => 5,
);

$httpd->reg_cb(
    '/proxy.pac' => sub {
        my ($httpd, $req) = @_;
        $httpd->stop_request;

        # proxy autoconfig file; see http://en.wikipedia.org/wiki/Proxy_auto-config
        # by default set to proxy all requests

        $req->respond({ content => ['application/x-ns-proxy-autoconfig', <<EOF
function FindProxyForURL(url, host) {
    if (shExpMatch(url, "*")) {
        return "PROXY 127.0.0.1:9090; DIRECT";
    }

    return "DIRECT";
}
EOF
        ] });
    },
    '' => sub {
        my ($httpd, $req) = @_;
        my $url = $req->url;
warn "DEBUG: proxying $url";

        my ($buffer, $headers);
        my ($data_cb, $respond_set);
        my $cookie_jar = {};

        my $req_url = $url->as_string;
        # you can substitute referers for example
        my $req_headers = { %{$req->headers}, 'referer' => $url->scheme . '://' . $url->host };

#warn "DEBUG: request to [" . $req_url . "] with headers:\n" . Dumper($req_headers);
        http_request(
            GET     => $req_url,
            timeout => $timeout,
            recurse => 0,
            headers => $req_headers,
            cookie_jar => $cookie_jar,
            persistent => 0,
            on_header => sub {
                $headers = shift;
#warn "DEBUG: received headers:\n" . Dumper($headers);

                # If you want to send respond to browser after just headers, do this
                if (0 && $headers->{'location'}) {
#warn "DEBUG: redirecting with headers:\n" . Dumper($headers);
                    $req->respond([$headers->{'status'} || 302, 'found', $headers, 'Redirecting...']);
                    return 0;
                }

                return 1;
            },
            on_body => sub {
                unless ($respond_set) {
#warn "DEBUG: streaming response with headers:\n" . Dumper($headers);
                    $req->respond([
                        200, 'ok', $headers,
                        sub {
                            $data_cb = shift;
                        }
                    ]);
                    $respond_set = 1;
                }

                my ($res, $h) = @_;

                $buffer .= $res;

                if ($data_cb) {
                    $data_cb->($buffer);
                    $buffer = '';
                }

                return 1;
            },
            sub {
                $data_cb->($buffer) if ($data_cb);
            }
        );

    },
);

$pid = pid_write();
warn 'started';
$httpd->run;


1;