Reading Transfer-Encoding: chunked requests

[Steve Fink <st...@fink.com>]

I have a workable solution, but am hoping somebody knowledgeable about
mod_perl, CGI.pm, and the 'chunked' Transfer-Encoding could critique
it.

I am using sendmail's milter API to capture email messages and pass
them through a perl script that compares the messages against a text
index. I originally used a server written in perl to process the
messages, but then decided to switch over the using Apache as the
server so I wouldn't have to deal with keeping yet another server
alive all the time. Also, I have preexisting mod_perl CGI code that
handles similar documents submitted via a browser.

However, it turns out to be difficult and just a generally bad idea to
buffer messages on the sendmail side before sending them over to the
server, so I'm using the 'chunked' transfer encoding to send a piece
at a time, as soon as each piece arrives at sendmail. Unfortunately,
mod_perl and CGI.pm currently do not support the chunked encoding for
requests.

So I wrote a subclass of CGI.pm that buffers the input and hands it
over to CGI::new(). It seems to work, but I'm calling initialization
routines in a strange way and may be bypassing some of the normal
setup. Is there a recommended way of doing things like this? (Maybe
one that eliminates the need for IO::String?)

Oh, and yes, I know I should set timeouts while reading chunks. And
that I shouldn't assume that all chunked requests are multipart forms.
(Is there an easy way to fix that one?)

Thanks in advance!

Here is my module:

package Apache::ChunkableCGI;

use base 'CGI';
use IO::String;

use constant REQUEST_NO_BODY => 0;
use constant REQUEST_CHUNKED_ERROR => 1;
use constant REQUEST_CHUNKED_DECHUNK => 2;
use constant REQUEST_CHUNKED_PASS => 3;

sub new {
    my $self = shift;

    my $r = Apache->request;

    if ($r->header_in('Transfer-Encoding') ne 'chunked') {
	return $self->SUPER::new(@_);
    }

    my $status = $r->setup_client_block(REQUEST_CHUNKED_DECHUNK);
    warn "setup status: $status";
    my $data;
    if ($r->should_client_block()) {
	my $buf;
	while ($status = $r->get_client_block($buf, 3 << 20)) {
#	    warn "get block status: $status";
	    $data .= $buf;
	}
    } else {
	warn "client should not block";
    }

    my ($boundary) = $ENV{CONTENT_TYPE} =~ /boundary= \"? ([^\";,]+) \"?/x;
    my $fh = IO::String->new(\$data);
    # I don't remember why I didn't just use $self->SUPER::new
    my $cgi = (ref($self) || $self)->SUPER::new({});
    $cgi->read_multipart($boundary, length($data), $fh);

    return $cgi;
}

1;