HTTP Request Input Filter to dump post data

[Alexander 'Leo' Bergolth]

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



# 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;