view release on metacpan or  search on metacpan

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

    # reset infos about content-length
    $xhdr->{content_length} = $xhdr->{chunked} = undef;
    delete @{ $xhdr->{fields} }{ qw/ content-length transfer-encoding / };

    # if we have read the whole body already or at least know, that we will
    # not change anymore data, we could compute the new content-length
    my $clen;
    my $nochange;
    while ( defined $orig_clen ) {
	my $rpsize = $orig_hlen + $orig_clen;

	if ( my $pass = $self->{pass}[1] ) {
	    if ( $pass == IMP_MAXOFFSET or $pass >= $rpsize ) {
		# will not look at and not change body
		$nochange = 1;
		goto compute_clen;
	    }
	}
	if ( my $prepass = $self->{prepass}[1] ) {
	    if ( $prepass == IMP_MAXOFFSET or $prepass >= $rpsize ) {
		# will not change body
		$nochange = 1;
		goto compute_clen;
	    }
	}
	if ($self->{ibuf}[1][0][0] >= $rpsize) { # ibuf[server].base
	    # everything passed thru ibuf
	    goto compute_clen;
	}

	# we still don't know final size
	last;

	compute_clen:
	# bytes in ibuf and outstanding bytes will not be changed, so:
	# new_content_length = 
	#  ( total_size - received )             # not yet received
	#  + ( received - ibuf.base )            # still in ibuf
	#  --->
	#  total_size - ibuf.base
	$clen = $rpsize - $self->{ibuf}[1][0][0];

	last;
    }

    if ( $self->{decode}{IMP_DATA_HTTPRQ_CONTENT+0}[1] ) {
	if ( $nochange ) {
	    # we will pass encoded stuff, either no decoding needs to
	    # be done (pass) or we will decode only for the analyzer (prepass)
	    # which will only watch at the content, but not change it
	    $self->{pass_encoded}[1] = 1;

	    my $pass = $self->{pass}[1];
	    if ( $pass and defined $orig_clen and ( 
		$pass == IMP_MAXOFFSET or 
		$pass >= $orig_clen + $orig_hlen )) {
		# no need to decode body
		$self->{decode}{IMP_DATA_HTTPRQ_CONTENT+0}[1] = undef;
	    }
	} else {
	    # content is encoded and inspection wants to see decoded stuff,
	    # which we then will forward too 
	    # but decoding might change length
	    $clen = undef;
	    # the content will be delivered decoded
	    delete $xhdr->{fields}{'content-encoding'}
	}
    }
    if ( defined $clen ) {
	$xhdr->{fields}{'content-length'} = [ $clen ];
	$xhdr->{content_length} = $clen;
    }

    callback:
    $callback->(@cb_args,$hdr,$xhdr);
}



############################################################################
# handle response body data
############################################################################
sub response_body {
    my ($self,$data,@callback) = @_;

    # forward to IMP analyzer
    $self->{eof}[1] = 1 if $data eq '';
    _imp_data($self,1,$data,0,IMP_DATA_HTTPRQ_CONTENT,
	\&_response_body_imp,\@callback);
}

sub _response_body_imp {
    my ($self,$data,$changed,$args) = @_;
    my ($callback,@cb_args) = @$args;
    my $eof = _check_eof($self,1);
    $callback->(@cb_args,$data,$eof) if $data ne '' || $eof;
}


sub _check_eof {
    my ($self,$dir) = @_;
    $DEBUG && $self->{request}->xdebug(
	"check eof[%d]  - eof=%d - %s - (pre)pass=%d/%d",
	$dir,$self->{eof}[$dir], _show_buf($self,$dir),
	$self->{prepass}[$dir],
	$self->{pass}[$dir]
    );
    return $self->{eof}[$dir]                    # received eof
	&& ! defined $self->{ibuf}[$dir][0][2]   # no more data in buf
	&& (                                     # (pre)pass til end ok
	    $self->{prepass}[$dir] == IMP_MAXOFFSET
	    || $self->{pass}[$dir] == IMP_MAXOFFSET
	);
}

sub _show_buf {
    my ($self,$dir) = @_;
    return join('|',
	map { ($_->[2]||'none')."($_->[0],+".length($_->[1]).")" } 
	@{ $self->{ibuf}[$dir] }
    );
}

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

	    push @{$fwd{$dir}}, [
		1,          # changed
		$newdata,   # new data
		$ib0->[3],  # callback
		$ib0->[4],  # cbargs
	    ];

	    next;
	}
        if ( $rtype ~~ [ IMP_PAUSE, IMP_CONTINUE ] ) {
	    my $dir = shift(@$rv);
	    my $relay = $self->{request}{conn}{relay};
	    if ( $relay and my $fo = $relay->fd($dir)) {
		$fo->mask( r => ($rtype == IMP_PAUSE ? 0:1));
	    }
	    next;
	}

	if ( $rtype == IMP_FATAL ) {
	    $request->fatal(shift(@$rv));
	    next;
	}

	return $request->fatal("unsupported IMP return type: $rtype");
    }

    %fwd or return; # no passes/replacements...

    while ( my ($dir,$fwd) = each %fwd ) {
	while ( my $fw = shift(@$fwd)) {
	    #warn Dumper($fw); use Data::Dumper;
	    my ($changed,$data,$callback,$args) = @$fw;
	    $callback->($self,$data,$changed,$args);
	}
    }
}

############################################################################
# send data to IMP analyzer
# if we had a previous (pre)pass some data can be forwarded immediatly, for
# others we have to wait for the analyzer callback
# returns how many bytes of data are waiting for callback, e.g. 0 if we
# we can pass everything immediately
############################################################################
sub _imp_data {
    my ($self,$dir,$data,$offset,$type,$callback,$args) = @_;
    my $ibuf = $self->{ibuf}[$dir];
    my $eobuf = $ibuf->[-1][0] + length($ibuf->[-1][1]);

    my $encoded_data;
    if ( my $decode = $self->{decode}{$type+0}[$dir] ) {
	# set up decoder if not set up yet
	if ( ! ref($decode)) {
	    # create function to decode content
	    $self->{decode}{$type+0}[$dir] = $decode = _create_decoder($decode)
		|| return $self->{request}->fatal(
		"cannot decode content-encoding $decode");
	}

	# offsets relates to original stream, but we put the decoded stream
	# into ibuf. And offset>0 means, that we have a gap in the input,
	# which is not allowed, when decoding a stream.
	die "cannot use content decoder with gap in data" if $offset;

	$encoded_data = $data if $self->{pass_encoded}[$dir];
	defined( $data = $decode->($data) )
	    or return $self->{request}->fatal("decoding content failed");
    }

    if ( $offset ) {
	die "offset($offset)<eobuf($eobuf)" if $offset < $eobuf;
	$offset = 0 if $offset == $eobuf;
    }

    my $fwd; # what gets send to analyzer

    my $dlen = length($data);
    my $pass =  $self->{pass}[$dir];
    if ( $pass ) {
	# if pass is set there should be no data in ibuf, e.g. everything
	# before should have been passed
	! $ibuf->[0][2] or die "unexpected data in ibuf";

	if ( $pass == IMP_MAXOFFSET ) {
	    # pass thru w/o analyzing
	    $ibuf->[0][0] += $dlen;
	    $DEBUG && $self->{request}->xdebug("can pass($dir) infinite");
	    return $callback->($self,$encoded_data // $data,0,$args);
	}

	my $canpass = $pass - ( $offset||$eobuf );
	if ( $canpass <= 0 ) {
	    # cannot pass anything, pass should have been reset already
	    die "pass($dir,$pass) must be point into future ($canpass)";
	} elsif ( $canpass >= $dlen) {
	    # can pass everything
	    $ibuf->[0][0] += $dlen;
	    if ( $data eq '' ) {
		# forward eof to analyzer
		$fwd = $data;
		$DEBUG && $self->{request}->xdebug("pass($dir) eof");
		goto SEND2IMP;
	    }
	    $DEBUG && $self->{request}->xdebug(
		"can pass($dir) all: pass($canpass)>=data.len($dlen)");
	    return $callback->($self,$encoded_data // $data,0,$args);
	} elsif ( $type < 0 ) {
	    # can pass part of data, only for streaming types
	    # remove from data what can be passed 
	    die "body might change" if $self->{pass_encoded}[$dir];
	    $ibuf->[0][0] += $canpass;
	    my $passed_data = substr($data,0,$canpass,'');
	    $eobuf += $canpass;
	    $dlen = length($data);
	    $DEBUG && $self->{request}->xdebug(
		"can pass($dir) part: pass($canpass)<data.len($dlen)");
	    $callback->($self,$passed_data,0,$args); # callback but continue
	}
    }