view release on metacpan or  search on metacpan

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

	$self->{conn}->in(1,"HTTP/1.0 200 Connection established\r\n\r\n");
	return _call_spooled_this($self->{conn});
    }

    if ( my $imp = $self->{imp_analyzer} ) {
	my $debug = $DEBUG && debug_context( id => $self->id);
	if ( $imp->fixup_request_header(\$hdr, defered => 0) ) {
	    $self->{defer_rqhdr} = '';
	} else {
	    # keep deferring sending header, length not known
	    _call_spooled_this($self->{conn}); # any body already ?
	    return;
	}
    }

    my $relay = $self->{conn}{relay} or return;
    $relay->forward(0,1,$hdr) if $self->{connected} == CONN_HOST;
    _call_spooled_this($self->{conn}); # any body already ?
}

sub _call_spooled_this {
    my $conn = shift;

    # call spooled request_bodies, e.g. until we see a new request
    debug("check for spooled subs in this request");
    my $spool = $conn->{spool} or return;
    $conn->{spool} = undef;
    while (@$spool && ! $conn->{spool} ) {
	my ($sub,@arg) = @{ $spool->[0] };
	last if $sub == \&in_request_header;
	shift(@$spool);
	$DEBUG && debug("handle spooled event $sub");
	$sub->(@arg);
    }
    push @{ $conn->{spool}}, @$spool if @$spool; # put back
}

sub _call_spooled_next {
    my $conn = shift;

    # skip until we have a next request, then continue
    debug("check for spooled requests, ignoring subs for this");
    my $spool = $conn->{spool} or return;
    $conn->{spool} = undef;
    while (@$spool) {
	my ($sub,@arg) = @{ $spool->[0] };
	last if $sub == \&in_request_header;
	$DEBUG && debug("skip spooled event $sub");
	shift(@$spool);
    }
    while (@$spool && ! $conn->{spool} ) {
	my ($sub,@arg) = @{ $spool->[0] };
	$DEBUG && debug("handle spooled event $sub");
	$sub->(@arg);
    }
    push @{ $conn->{spool}}, @$spool if @$spool; # put back
}

############################################################################
# process request body data
# if IMP, we might need to wait for a callback to decide what to do with
# the data, otherwise the data are further send directly
# if IMP might modify the data, we need to defer sending the header to get
# the final content-length and fixup the header accordingly
############################################################################
sub in_request_body {
    my ($self,$data,$eof) = @_;
    my $conn  = $self->{conn}  or return;
    my $relay = $conn->{relay} or return;
    if ( ! $self->{connected} ) {
	# not connected yet
	$DEBUG && $self->xdebug("spool request body data");
	push @{$conn->{spool}}, [ \&in_request_body, @_ ];
	return;
    }
    
    $DEBUG && $self->xdebug("got request body data len=%d eof=%d",length($data),$eof);
    my $imp = $self->{imp_analyzer};
    if ( ! $imp ) {
	# fast path w/o imp
	$relay->forward(0,1,$data) if $data ne '' 
	    and $self->{connected} == CONN_HOST;
	return;
    }

    # feed data into IMP
    $DEBUG && $self->xdebug("fwd request body to IMP");
    my $debug = $DEBUG && debug_context( id => $self->id);
    $imp->request_body($data,\&_request_body_after_imp,$self) if $data ne '';
    $imp->request_body('',\&_request_body_after_imp,$self) if $eof;
}

############################################################################
# process request body data in case of IMP
# called from IMP callback working on request body data
############################################################################
sub _request_body_after_imp {
    my ($self,$data,$eof) = @_;
    my $conn  = $self->{conn}  or return;
    my $relay = $conn->{relay} or return;

    my $debug = $DEBUG && debug_context( id => $self->id);

    if ( $self->{defer_rqhdr} ne '') {
	$self->{defer_rqbody} .= $data;
	if ( not $self->{imp_analyzer}->fixup_request_header( 
	    \$self->{defer_rqhdr}, 
	    defered => length($self->{defer_rqbody}) 
	)) {
	    # body length still not known
	    $DEBUG && debug("request body length still unknown");
	    $self->{defer_rqbody} .= $data;
	    $eof or return;
	}

	$DEBUG && debug("forward %d bytes header + %d bytes body",
	    length($self->{defer_rqhdr}),
	    length($self->{defer_rqbody}));

	$relay->forward(0,1,$self->{defer_rqhdr}.$self->{defer_rqbody} )
	    if $self->{connected} == CONN_HOST;

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

	$relay->forward(1,0,$data);
    } 

    if ($eof) {
        $relay->account('request');
	if ( ! $self->{keep_alive} ) {
	    # close connection
	    $DEBUG && $self->xdebug("end of request: close");
	    return $relay->close;
	}

	# keep connection open
	# and continue with next request if we have one
	$DEBUG && $self->xdebug("end of request: keep-alive");
	_call_spooled_next( $self->{conn} );
    }
}

############################################################################
# Websockets, TLS upgrades etc
# if not IMP the forwarding will be done inside this function, otherwise it
# will be done in _in_data_imp, which gets called by IMP callback
############################################################################
sub in_data {
    my ($self,$dir,$data,$eof) = @_;

    if ( my $imp = $self->{imp_analyzer} ) {
	my $debug = $DEBUG && debug_context( id => $self->id);
	$data ne '' and $imp->data($dir,$data,\&_in_data_imp,$self);
	$eof and $imp->data($dir,'',\&_in_data_imp,$self);
    } else {
	my $relay = $self->{conn}{relay} or return;
	$DEBUG && $self->xdebug("got %d bytes from %d, eof=%d",length($data),$dir,$eof);
	if ( $data ne '' ) {
	    if ( $dir == 1 ) {
		$relay->forward(1,0,$data)
	    } else {
		$relay->forward(0,1,$data) if $self->{connected} == CONN_HOST;
	    }
	}
	$relay->account('upgrade') if $eof;
    }
}
sub _in_data_imp {
    my ($self,$dir,$data,$eof) = @_;
    my $relay = $self->{conn}{relay} or return;
    $DEBUG && $self->xdebug("imp got %d bytes from %d, eof=%d",length($data),$dir,$eof);
    if ( $data ne '' ) {
	if ( $dir == 1 ) {
	    $relay->forward(1,0,$data)
	} else {
	    $relay->forward(0,1,$data) if $self->{connected} == CONN_HOST;
	}
    }

    $relay->account('upgrade') if $eof;
}

############################################################################
# chunks and junk gets ignored
# - we decide ourself, when we will forward data chunked and do the
#   chunking ourself
# - junk data will not be forwarded
############################################################################

sub in_chunk_header {}
sub in_chunk_trailer {}
sub in_junk {}


1;