public
Last active

Filtering HTTP Proxy

  • Download Gist
http-proxy.pl
Perl
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 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
#!/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;

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.