HTTP Request Input Filter to dump post data

HTTP Request Input Filter to dump post data

am 27.10.2010 22:08:07 von leo

This is a multi-part message in MIME format.
--------------020307040500040706090605
Content-Type: text/plain; charset=ISO-8859-1
Content-Transfer-Encoding: 7bit

Hi!

I am trying to use a http request input filter to dump the post data of
certain requests into a file. (The filter is attached.)

Registering the input filter using
PerlInputFilterHandler +Leo::DumpInputData
works fine, the handler gets called on dump requests and the request
headers are written correctly.

However dumping the post data doesn't work, $f->read($buffer, BUFF_LEN)
gets called only once and returns 0 bytes read. (Even though the content
should be about 10k of data and the PerlResponseHandler that finally
consumes the data can correctly parse the whole request.)

What am I doing wrong?

Thanks,
--leo

P.S.: I am using mod_perl-2.0.4-6.el5 on RHEL5. The response handler is
set up by a PerlTransHandler that issues the following:
-------------------- 8< --------------------
$r->handler('perl-script');

$r->set_handlers(PerlResponseHandler => [
# set path_info for the CGI script
sub { $_[0]->path_info( $path_info ); DECLINED },
'ModPerl::Registry'
]);
-------------------- 8< --------------------

That shouldn't reset the input filter, should it?

--
e-mail ::: Leo.Bergolth (at) wu.ac.at
fax ::: +43-1-31336-906050
location ::: IT-Services | Vienna University of Economics | Austria



--------------020307040500040706090605
Content-Type: text/plain;
name="DumpInputData.pm"
Content-Transfer-Encoding: 7bit
Content-Disposition: attachment;
filename="DumpInputData.pm"

# PerlInputFilterHandler +Leo::DumpInputData

package Leo::DumpInputData;

use strict;
use warnings;
use base qw(Apache2::Filter);

use File::Temp ();

use constant BUFF_LEN => 8000;
use Apache2::Const -compile => 'OK';

use Apache2::Const -compile => 'OK';



sub handler : FilterRequestHandler {
my $f = shift;

# runs on first invocation
unless ($f->ctx) {
init($f);
}

my $r = $f->r;
my $ctx = $f->ctx;
$r->log_error("LEO: ctx: ".$f->ctx.", outfile: ".$ctx->{'outfile'});
if ($ctx) {
my $fh = $ctx->{'outfile'};
my $buffer;
my $cnt;
while ($cnt = $f->read($buffer, BUFF_LEN)) {
$f->print($buffer);
$r->log_error("LEO: read $cnt $buffer");
if (defined $fh) {
print $fh "LEO: $buffer";
}
}
$r->log_error("LEO: read $cnt end");
# runs on the last invocation
if ($f->seen_eos) {
if ($fh) {
close($fh);
}
}
}
Apache2::Const::OK;
}



sub init {
my $f = shift;

my $r = $f->r;
# $r->log_error("LEO: ".$r->uri.", $$, ".$r->method);
my $fh = new File::Temp( UNLINK => 0,
SUFFIX => '.txt',
TMPDIR => 1,
# DIR => '/tmp',
TEMPLATE => "ep_post_".$$."_XXXXX",
);
if ($fh) {
my $filename = $fh->filename;
$f->ctx( { 'outfile' => $fh } );
$r->notes->set('leo_headers_file' => $filename);
my $method = $r->method();
$r->log_error("LEO: ".$r->uri.", $$, $method, $filename");
# print $fh $r->as_string(), "\r\n";
print $fh $r->the_request(), "\r\n";
my $headers_in = $r->headers_in();
for my $k (sort keys (%$headers_in)) {
print $fh "$k: ".$headers_in->{$k}."\r\n";
}
print $fh "\r\n";
}
}

1;




--------------020307040500040706090605--