perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Stas Bekman <s...@stason.org>
Subject [patch] C implementation of $r->content + rfc on the name
Date Thu, 15 May 2003 08:04:24 GMT
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;
+
+        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);
+        if (rc != APR_SUCCESS) {
+            apr_brigade_destroy(bb);
+            Perl_croak(aTHX_ modperl_apr_strerror(rc));
+        }
+
+        // XXX: more efficient way?
+        sv_catpvn(sv, buffer, bufsiz);
+        apr_brigade_cleanup(bb);
+    }
+    while (!seen_eos);
+
+    apr_brigade_destroy(bb);
+
+    return sv;
+}
+
  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


Mime
View raw message