perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject Re: [patch] C implementation of $r->content + rfc on the name
Date Fri, 16 May 2003 11:48:20 GMT
On Thu, 2003-05-15 at 16:04, Stas Bekman wrote:
> recently I've learn that the implementation of ap_get_client_block is buggy. 
> For example it can't handle situations where EOS arrives in the bucket brigade 
> as data. There was a short followup on the httpd-dev list, which has quickly 
> died. But the fact remains, we can't rely on using ap_get_client_block even in 
> Apache::compat. I've already rewritten ModPerl::Test::read_post to read the 
> POST data using bbs and it works fine. I was just about to replace the 
> $r->content implementation in Apache::compat when I've realized that it's too 
> slow and should be done in C.
> 
> Notice that this C implementation is the same as $r->content() in the scalar 
> context in mp1, though it handles chunked encoding and doesn't rely on C-L 
> header. It simply delegates these headaches to httpd. This C implementation 
> just reads the POST data, just like $r->args returns just the QUERY_STRING. It 
> won't handle any multi-part POST. Though I think it might be useful and faster 
> then any other fully-fledged implementation, when all you want is to grab the 
> POSTed data as is.
> 
> Let me know if you have any problems with that. The only part is I hate is 
> that since we have to keep the same name in Apache/compat.pm, once someone 
> loads Apache::compat, $r->content is going to be overloaded to handle list 
> context as well. May be we should give this new mp2 function a new name? e.g. 
> $r->body?
> 
> 
> Index: lib/Apache/compat.pm
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
> retrieving revision 1.85
> diff -u -r1.85 compat.pm
> --- lib/Apache/compat.pm	11 Apr 2003 07:34:03 -0000	1.85
> +++ lib/Apache/compat.pm	15 May 2003 07:52:48 -0000
> @@ -285,24 +285,15 @@
> 
>   use constant IOBUFSIZE => 8192;
> 
> -sub content {
> -    my $r = shift;
> +{
> +    my $content_sub = *Apache::RequestRec::content{CODE};
> +    *Apache::RequestRec::content = sub {
> +        my $r = shift;
> 
> -    $r->setup_client_block;
> -
> -    return undef unless $r->should_client_block;
> -
> -    my $data = '';
> -    my $buf;
> -    while (my $read_len = $r->get_client_block($buf, IOBUFSIZE)) {
> -        if ($read_len == -1) {
> -            die "some error while reading with get_client_block";
> -        }
> -        $data .= $buf;
> +        my $data = $r->$content_sub;
> +        return $data unless wantarray;
> +        return $r->parse_args($data);
>       }
> -
> -    return $data unless wantarray;
> -    return $r->parse_args($data);
>   }
> 
>   sub clear_rgy_endav {
> Index: xs/Apache/RequestIO/Apache__RequestIO.h
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h,v
> retrieving revision 1.37
> diff -u -r1.37 Apache__RequestIO.h
> --- xs/Apache/RequestIO/Apache__RequestIO.h	14 Mar 2003 05:33:19 -0000	1.37
> +++ xs/Apache/RequestIO/Apache__RequestIO.h	15 May 2003 07:52:48 -0000
> @@ -245,6 +245,60 @@
>       return total;
>   }
> 
> +
> +/* get the POSTed body as-is */
> +static SV *mpxs_Apache__RequestRec_content(pTHX_ request_rec *r)
> +{
> +    SV *sv = newSVpvn("", 0);
> +    int rc;
> +    int seen_eos = 0;
> +    apr_bucket_brigade *bb = apr_brigade_create(r->pool,
> +                                                r->connection->bucket_alloc);
> +
> +    do {
> +        char *buffer;
> +        apr_bucket *b;
> +        apr_size_t bufsiz = HUGE_STRING_LEN;

See next comment

> +        rc = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES,
> +                            APR_BLOCK_READ, HUGE_STRING_LEN);
> +        if (rc != APR_SUCCESS) {
> +            apr_brigade_destroy(bb);
> +            Perl_croak(aTHX_ modperl_apr_strerror(rc));
> +        }
> +
> +        /* If this fails, it means that a filter is written
> +         * incorrectly and that it needs to learn how to properly
> +         * handle APR_BLOCK_READ requests by returning data when
> +         * requested.
> +         */
> +        AP_DEBUG_ASSERT(!APR_BRIGADE_EMPTY(bb));
> +
> +        /* search for EOS */
> +        APR_BRIGADE_FOREACH(b, bb) {
> +            if (APR_BUCKET_IS_EOS(b)) {
> +                seen_eos = 1;
> +                break;
> +            }
> +        }
> +
> +        rc = apr_brigade_pflatten(bb, &buffer, &bufsiz, r->pool);

No need to set bufsiz to HUGE_STRING_LEN (8192 bytes), since from the
source of apr_brigade_pflatten, it will allocate apr_brigade_length(bb)
from the pool, then overwrite bufsize with what it read.

> +        if (rc != APR_SUCCESS) {
> +            apr_brigade_destroy(bb);
> +            Perl_croak(aTHX_ modperl_apr_strerror(rc));
> +        }
> +
> +        // XXX: more efficient way?
> +        sv_catpvn(sv, buffer, bufsiz);

So if we have a file upload POST, for example of 4MB,
apr_brigade_pflatten() will pcalloc 4MB from the pool, then sv_catpvn
will in turn malloc another 4MB.. Doesn't sound super cool.

Why not implement your own pflatten equivalent

apr_status_t modperl_brigade_sv_flatten(pTHX_ apr_bucket_brigade *bb, SV
*sv) {
                                               
{
    apr_off_t actual;
    apr_size_t total;
    apr_status_t rv;

    /* XXX: 1: triggers reads on unknown size buckets */
    apr_brigade_length(bb, 1, &actual);
    total = (apr_size_t)actual;
    
    return apr_brigade_flatten(bb, SvGROW(sv, total), &total);
}

Something like that, to at least avoid allocating the storage twice.


> +        apr_brigade_cleanup(bb);
> +    }
> +    while (!seen_eos);

Seems to me like a potential infinite loop waiting to happen. What if we
never see an EOS ?

> +    apr_brigade_destroy(bb);
> +
> +    return sv;
> +}

Hey! Shouldn't we stash that sv in $r somewhere, because it would be
nice to be able to read $r->content more than only once.


>   static MP_INLINE
>   SV *mpxs_Apache__RequestRec_GETC(pTHX_ request_rec *r)
>   {
> Index: xs/maps/modperl_functions.map
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
> retrieving revision 1.56
> diff -u -r1.56 modperl_functions.map
> --- xs/maps/modperl_functions.map	1 Apr 2003 05:20:50 -0000	1.56
> +++ xs/maps/modperl_functions.map	15 May 2003 07:52:48 -0000
> @@ -45,6 +45,7 @@
>    SV *:DEFINE_UNTIE    | | request_rec *:r, int:refcnt
>    mpxs_Apache__RequestRec_sendfile | | r, filename=r->filename, offset=0, len=0
>    mpxs_Apache__RequestRec_read | | r, buffer, bufsiz, offset=0
> + mpxs_Apache__RequestRec_content | | r
>    long:DEFINE_READ | | request_rec *:r, SV *:buffer, int:bufsiz, int:offset=0
>    mpxs_Apache__RequestRec_write | | r, buffer, bufsiz=-1, offset=0
>    mpxs_Apache__RequestRec_print | | ...
> Index: xs/tables/current/ModPerl/FunctionTable.pm
> ===================================================================
> RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
> retrieving revision 1.114
> diff -u -r1.114 FunctionTable.pm
> --- xs/tables/current/ModPerl/FunctionTable.pm	12 May 2003 13:00:15 -0000	1.114
> +++ xs/tables/current/ModPerl/FunctionTable.pm	15 May 2003 07:52:48 -0000
> @@ -5595,6 +5595,23 @@
>       ]
>     },
>     {
> +    'return_type' => 'SV *',
> +    'name' => 'mpxs_Apache__RequestRec_content',
> +    'attr' => [
> +      'static'
> +    ],
> +    'args' => [
> +      {
> +        'type' => 'PerlInterpreter *',
> +        'name' => 'my_perl'
> +      },
> +      {
> +        'type' => 'request_rec *',
> +        'name' => 'r'
> +      },
> +    ]
> +  },
> +  {
>       'return_type' => 'int',
>       'name' => 'mpxs_Apache__RequestRec_OPEN',
>       'args' => [
> 
> __________________________________________________________________
> Stas Bekman            JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/     mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org   http://ticketmaster.com
> 
> 
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
-- 
-- -----------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B)
http://gozer.ectoplasm.org/    F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so ingenious.
perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'

Mime
View raw message