view release on metacpan or  search on metacpan

lib/App/HTTP_Proxy_IMP/Request.pm  view on Meta::CPAN

############################################################################
# Request
############################################################################

use strict;
use warnings;

package App::HTTP_Proxy_IMP::Request;
use base 'Net::Inspect::Flow';
use fields (
    'conn',         # App::HTTP_Proxy_IMP::Connection object
    'meta',         # meta data
    'me_proxy',     # defined if I'm proxy, if true will be used for Via:
    'up_proxy',     # address of upstream proxy if any
    'acct',         # some accounting data
    'connected',    # false|CONN_HOST|CONN_INTERNAL

    'imp_analyzer', # App::HTTP_Proxy_IMP::IMP object
    'defer_rqhdr',  # deferred request header (wait until body length known)
    'defer_rqbody', # deferred request body (wait until header can be sent)

    'method',       # request method
    'rqhost',       # hostname from request
    'rq_version',   # version of request
    'rp_encoder',   # sub to encode response body (chunked)
    'keep_alive',   # do we use keep_alive in response
);

use App::HTTP_Proxy_IMP::Debug qw(debug $DEBUG debug_context);
use Scalar::Util 'weaken';
use Net::Inspect::Debug 'trace';
use Net::IMP qw(:DEFAULT :log);
use Net::IMP::HTTP; # constants
use Sys::Hostname 'hostname';

my $HOSTNAME = hostname();

# connected to host or do we fake the response internally
use constant CONN_HOST => 1;
use constant CONN_INTERNAL => 2;

sub DESTROY { 
    $DEBUG && debug("destroy request"); 
    #Devel::TrackObjects->show_tracked;
}
sub new_request {
    my ($factory,$meta,$conn) = @_;
    my $self = $factory->new;
    $DEBUG && $conn->xdebug("new request $self");

    $self->{meta} = $meta;
    weaken($self->{conn} = $conn);
    $self->{defer_rqhdr} = $self->{defer_rqbody} = '';

    $self->{acct} = { %$meta, Id => $self->id };
    if ( my $f = $conn->{imp_factory} ) {
	$self->{imp_analyzer} = $f->new_analyzer($self,$meta);
    }

    $self->{me_proxy} = $HOSTNAME;
    $self->{up_proxy} = $meta->{upstream};

    return $self;
}

sub xdebug {
    my $self = shift;
    my $ctx = debug_context( id => $self->id );
    goto &debug;
}

sub id {
    my $self = shift;
    $self->{conn} or return '';
    return $$.'.'.$self->{conn}{connid}.'.'.$self->{meta}{reqid}
}

sub fatal {
    my ($self,$reason) = @_;
    warn "[fatal] ".$self->id." $reason\n";
    if ( my $conn = $self->{conn} ) {
        my $relay =  $conn->{relay};
        $relay->account('fatal');
        $relay->close;
    }
}

sub deny {
    my ($self,$reason) = @_;
    warn "[deny] ".$self->id." $reason\n";
    if ( my $relay = $self->{conn} && $self->{conn}{relay} ) {
        $relay->account('deny', status => 'DENIED', reason => $reason );
	$relay->forward(1,0,"HTTP/1.0 403 $reason\r\n\r\n") 
	   if ! $self->{acct}{code};
	$relay->close;
    }
}

sub xtrace {
    my $self = shift;
    my $msg = shift;
    $msg = "$$.$self->{conn}{connid}.$self->{meta}{reqid} $msg";
    unshift @_,$msg;
    goto &trace;
}


############################################################################
# process HTTP request header
# called from HTTP connection object
# if IMP plugin is configured it will send the received header to the plugin
# and continue from the IMP callback to _request_header_after_imp.