view release on metacpan or  search on metacpan

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

package Apache2::Proxy;

use strict;
use warnings;

our $VERSION = 0.04;

=head1 NAME

Apache2::Proxy - a mod_perl based http proxy base class

=head1 SYNOPSIS

A mod_perl based HTTP proxy base class

=cut


use Apache2::Const -compile => qw( OK SERVER_ERROR NOT_FOUND DECLINED
  REDIRECT LOG_DEBUG LOG_ERR LOG_INFO CONN_KEEPALIVE HTTP_BAD_REQUEST
  HTTP_UNAUTHORIZED HTTP_SEE_OTHER HTTP_MOVED_PERMANENTLY DONE
  HTTP_NO_CONTENT HTTP_PARTIAL_CONTENT HTTP_NOT_MODIFIED );
use Apache2::Connection  ();
use Apache2::Log         ();
use Apache2::RequestRec  ();
use Apache2::RequestUtil ();
use Apache2::RequestIO   ();
use Apache2::Response    ();
use Apache2::ServerRec   ();
use Apache2::ServerUtil  ();
use Apache2::URI         ();
use Apache2::Filter      ();
use APR::Table           ();

use Compress::Zlib ();
use Compress::Bzip2 ();
use Encode ();

use URI;
use Net::HTTP;
use HTTP::Response;
use HTTP::Headers;
use HTTP::Headers::Util ();
use Data::Dumper;
use Net::DNS;
our $Resolver = Net::DNS::Resolver->new;

use constant DEBUG         => 1;
use constant VERBOSE_DEBUG => 0;

use constant MAX_CONTENT_LENGTH => 131072;    # 128k

# firefox default headers
our %Headers = (
    'Accept-Encoding' => 'gzip,deflate',
    'Accept-Charset'  => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7',
    'Accept-Lang'     => 'en-us,en;q=0.5',
    'Accept' =>
'text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5',
    'User-Agent' =>
'Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.5; en-US; rv:1.9.0.10) Gecko/2009042315 Firefox/3.0.10',
);

our %Response = (
    200 => 'twohundred',
    204 => 'twoohfour',
    206 => 'twoohsix',
    301 => 'threeohone',
    302 => 'redirect',
    303 => 'redirect',
    304 => 'threeohfour',
    307 => 'redirect',
    400 => 'bsod',
    401 => 'bsod',
    403 => 'bsod',
    404 => 'bsod',
    410 => 'bsod',
    500 => 'bsod',
    502 => 'bsod',
    503 => 'bsod',
    504 => 'bsod',
);

# handles common proxy functions

# takes $r and returns the http headers

sub get_request_headers {
    my ( $class, $r ) = @_;

    my %headers;
    $r->headers_in->do(
        sub {
            my $k = shift;
            my $v = shift;

            if ( $k =~ m/^connection/i ) {
                $headers{$k} = 'keep-alive';
                return 1;
            }

            # pass this header onto the remote request
            $headers{$k} = $v;