view release on metacpan or  search on metacpan

script/selective_proxy  view on Meta::CPAN

        # 502 Bad Gateway / 504 Gateway Timeout
        # Note to implementors: some deployed proxies are known to
        # return 400 or 500 when DNS lookups time out.
        my $response = HTTP::Response->new( 200 );
        $response->content_type( "text/plain" );
        $self->response($response);
        return $last;
    }

    # send the response headers (FIXME more headers required?)
    my $response = HTTP::Response->new(200);
    $self->response($response);
    $self->{$_}{response}->select_filters( $response ) for qw( headers body );

    $self->_send_response_headers( $served );

    # we now have a TCP connection to the upstream host
    $last = 1;
    my $class = ref($conn);
    { no strict 'refs'; unshift(@{$class . "::ISA"}, 'IO::Socket::SSL'); } # Forcibly change classes the socket inherits from
    $class->start_SSL($conn, 
        SSL_server => 1, 
        SSL_key_file => $key,
        SSL_cert_file => $cert, # Turn our client socket into SSL.
    ) or warn("Could not start SSL");
    ${*$conn}{'httpd_nomore'} = 0; # Pay no attention to the Connection: close header behind the curtain.
    {   # Build a method to fiddle with the request object we get from the client, as it needs to http->https
        my $old_setrequest_method = \&HTTP::Proxy::request;
        my $new_request_method = sub {
            my ($self, $new_req) = @_;
            if ($new_req) {
                use Data::Dumper;
                if (!$new_req->uri->scheme or $new_req->uri->scheme eq 'http') {
                    $new_req->uri->scheme('https');
                    $new_req->uri->host($new_req->header('Host'));
                }
            }
            $old_setrequest_method->($self, $new_req);
        };
        # And monkeypatch it into HTTP proxy, using local to restrict it by lexical scope
        # so that it goes away once we exit the block (i.e. the CONNECT method finishes).
        no warnings qw[once redefine];
        local *HTTP::Proxy::request = $new_request_method;
        use warnings qw[once redefine];
        $self->serve_connections($conn);
    }
    $conn->stop_SSL($conn);
    return $last;
}
{
    no warnings qw(once redefine);
    *HTTP::Proxy::_handle_CONNECT = \&_handle_CONNECT;
}

our %http_proxy_defaults = (
    port                    => 3128,
    max_clients             => 10,
    max_requests_per_child  => 100,
    min_spare_servers       => 1,
    max_spare_servers       => 5,
    keep_alive              => 0,
    max_keep_alive_requests => 1,
    keep_alive_timeout      => 60,
    engine                  => 'NoFork',
);

sub _generate_proxy_config {
    my %in_params = @_;
    my %params;
    foreach my $k (keys %http_proxy_defaults) {
        $params{$k} = exists $in_params{$k} ? $in_params{$k} : $http_proxy_defaults{$k};
    }
    return %params;
}

my $_help = q{No config file passed on command line.
    
Please create a file in a text editor which looks like this:
# Note that more options are available, please see example_config.ini in the distribution for usage.
port = 3128
debug = 1
#upstream_proxy = proxy.example.com:8080

[search.cpan.org]
/s/=/tmp/css
/stuff/=/tmp/stuff

[www.google.com]
/js/=/tmp/js
/some/file.jpg=/tmp/somefile.jpg

and save it in your editor. Then re-run selective_proxy, appending the configuration file name.
};

sub main {
    my $conf_file = shift(@ARGV);
    die($_help) unless ($conf_file);
    die("Config file passed on command line ($conf_file) could not be read.\n") unless (-r $conf_file);

    my %config = %{ Config::Tiny->read( $conf_file ) };

    my $root_config = delete $config{_};
    my $debug = delete $root_config->{debug};
    my $upstream_proxy = delete $root_config->{upstream_proxy};

    my $proxy = HTTP::Proxy->new( 
        _generate_proxy_config( %{$root_config} ),
        max_connections => 0, # Not lettng the users stamp on this..
    );
    $proxy->init;
    die("No agent") unless $proxy->{agent};
    warn("Upstream proxy: $upstream_proxy") if $upstream_proxy;
    $proxy->{agent}->proxy([qw/http https/], $upstream_proxy) if $upstream_proxy;;
    
    $proxy->push_filter( 
        method => 'GET, HEAD',
        request => HTTP::Proxy::Selective->new(\%config, $debug)
    );
    warn("Starting proxy at " . $proxy->url . "\n");
    $proxy->start;
}

main() unless caller();