Filtering HTTP Proxy

http-proxy.pl

#!/usr/bin/env perl
use strict;
use warnings;
use AnyEvent::HTTP;
use AnyEvent::HTTP::Socks;
use AnyEvent::HTTPD;
use URI;

# Default is 4 connections per host.
$AnyEvent::HTTP::MAX_PER_HOST = 8;

my $server = AnyEvent::HTTPD->new(port => 8080);
$server->reg_cb(
    request => sub {
        my ($server, $req) = @_;

        # Don't create additional events for the URI path components.
        $server->stop_request;

        my $server_headers = $req->headers;
        {
            # Non-standard header added by browser; some sites misinterpret
            # this to mean the request is coming from an open proxy.
            my $pc = delete $server_headers->{'proxy-connection'};
            if ($pc and not exists $server_headers->{connection}) {
                $server_headers->{connection} = $pc;
            }
        }

        my $server_body = $req->content;
        if (not defined $server_body and 'POST' eq $req->method) {
            my $u = $req->url->clone;
            $u->query_form($req->vars);
            $server_body = $u->query;
        }

        # Avoid separating pseudo-headers in each callback.
        my (%client_headers, %client_pseudo_headers);
        my ($client_body, $client_body_cb);

        # Do any pre-request tweaks here...
        my $client_body_filter;
        my $client_header_filter;
        my @proxy;

        # if ($req->url->host eq 'www.example.com') {
        #     $client_body_filter = sub {
        #         $client_body =~ s/foo/bar/g;
        #     };
        #     $client_header_filter = sub {
        #         delete @client_headers{qw(set-cookie set-cookie2)};
        #     };
        #     my $proxy = URI->new('http://12.345.678.90:16661');
        #     @proxy = 'socks' eq substr($proxy->scheme, 0, 5)
        #         ? (socks => $proxy->as_string)
        #         : (proxy => [$proxy->host, $proxy->port]);
        # }

        http_request(
            $req->method => $req->url,
            headers      => $server_headers,
            body         => $server_body,
            recurse      => 0,
            timeout      => @proxy ? 60 : 120,
            @proxy,

            on_header => sub {
                my $headers = shift;

                # Don't send the pseudo-headers back to the client.
                while (my ($h, $v) = each %$headers) {
                    $h =~ /^[A-Z]/ ? $client_pseudo_headers{$h} = $v
                                   : $client_headers{$h} = $v;
                }

                if ('CODE' eq ref $client_header_filter) {
                    $client_header_filter->();
                }

                # Don't start the response now- wait until the entire body
                # has accumulated.
                return 1 if $client_body_filter;

                $req->respond([
                    $client_pseudo_headers{Status},
                    $client_pseudo_headers{Reason},
                    \%client_headers, sub { $client_body_cb = shift }
                ]);
                return 1;
            },

            on_body => sub {
                if ($client_body_filter) {
                    $client_body .= $_[0];
                    return 1;
                }
                return unless $client_body_cb;
                $client_body_cb->($_[0]);
            },

            # Completion callback.
            sub {
                unless ('CODE' eq ref $client_body_filter) {
                    $client_body_cb->();
                    return;
                }

                $client_body_filter->();

                $req->respond([
                    $client_pseudo_headers{Status},
                    $client_pseudo_headers{Reason},
                    \%client_headers, $client_body
                ]);
            }
        );
    }
);

$server->run;

exit;