stas 2003/11/06 03:22:03
Modified: src/modules/perl modperl_io_apache.c modperl_io_apache.h
xs/Apache/RequestIO Apache__RequestIO.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
. Changes
Log:
rewrite $r->read() and perlio read functions to use the same function,
which completely satisfies the read request if possible, on the way
getting rid of get_client_block and its supporting functions which
have problems and will most likely will be removed from the httpd-API
in the future. Directly manipulate bucket brigades instead.
Revision Changes Path
1.9 +81 -24 modperl-2.0/src/modules/perl/modperl_io_apache.c
Index: modperl_io_apache.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_io_apache.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- modperl_io_apache.c 1 Nov 2003 09:25:02 -0000 1.8
+++ modperl_io_apache.c 6 Nov 2003 11:22:02 -0000 1.9
@@ -105,37 +105,17 @@
PerlIOApache *st = PerlIOSelf(f, PerlIOApache);
request_rec *r = st->r;
long total = 0;
- int rc;
if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) ||
PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) {
return 0;
}
- if (!r->read_length) {
- /* only do this once per-request */
- if ((rc = ap_setup_client_block(r, REQUEST_CHUNKED_ERROR)) != OK) {
- ap_log_error(APLOG_MARK, APLOG_ERR, 0, r->server,
- "mod_perl: ap_setup_client_block failed: %d", rc);
- return -1;
- }
- }
-
- if (r->read_length || ap_should_client_block(r)) {
- total = ap_get_client_block(r, vbuf, count);
+ total = modperl_request_read(aTHX_ r, (char*)vbuf, count);
- MP_TRACE_o(MP_FUNC, "wanted %db, read %db [%s]",
- count, total,
- IO_DUMP_FIRST_CHUNK(r->pool, vbuf, total));
-
- if (total < 0) {
- /*
- * XXX: as stated in ap_get_client_block, the real
- * error gets lots, so we only know that there was one
- */
- ap_log_error(APLOG_MARK, APLOG_ERR, 0, r->server,
- "mod_perl: $r->read failed to read");
- }
+ if (total < 0) {
+ PerlIOBase(f)->flags |= PERLIO_F_ERROR;
+ /* modperl_request_read takes care of setting ERRSV */
}
return total;
@@ -268,6 +248,83 @@
#endif /* defined MP_IO_TIE_PERLIO */
+/****** Other request IO functions *******/
+
+
+MP_INLINE SSize_t modperl_request_read(pTHX_ request_rec *r,
+ char *buffer, Size_t len)
+{
+ long total = 0;
+ int wanted = len;
+ int seen_eos = 0;
+ char *tmp = buffer;
+ apr_bucket_brigade *bb;
+
+ if (len <= 0) {
+ return 0;
+ }
+
+ bb = apr_brigade_create(r->pool, r->connection->bucket_alloc);
+ if (bb == NULL) {
+ r->connection->keepalive = AP_CONN_CLOSE;
+ return -1;
+ }
+
+ do {
+ apr_size_t read;
+ int rc;
+
+ rc = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES,
+ APR_BLOCK_READ, len);
+ if (rc != APR_SUCCESS) {
+ /* if we fail here, we want to just return and stop trying
+ * to read data from the client.
+ */
+ r->connection->keepalive = AP_CONN_CLOSE;
+ apr_brigade_destroy(bb);
+ sv_setpv(ERRSV,
+ (char *)apr_psprintf(r->pool,
+ "failed to get bucket brigade: %s",
+ modperl_apr_strerror(rc)));
+ return -1;
+ }
+
+ /* 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));
+
+ if (APR_BUCKET_IS_EOS(APR_BRIGADE_LAST(bb))) {
+ seen_eos = 1;
+ }
+
+ read = len;
+ rc = apr_brigade_flatten(bb, tmp, &read);
+ if (rc != APR_SUCCESS) {
+ apr_brigade_destroy(bb);
+ sv_setpv(ERRSV,
+ (char *)apr_psprintf(r->pool,
+ "failed to read: %s",
+ modperl_apr_strerror(rc)));
+ return -1;
+ }
+ total += read;
+ tmp += read;
+ len -= read;
+
+ apr_brigade_cleanup(bb);
+
+ } while (len > 0 && !seen_eos);
+
+ apr_brigade_destroy(bb);
+
+ MP_TRACE_o(MP_FUNC, "wanted %db, read %db [%s]", wanted, total,
+ IO_DUMP_FIRST_CHUNK(r->pool, buffer, total));
+
+ return total;
+}
1.2 +4 -1 modperl-2.0/src/modules/perl/modperl_io_apache.h
Index: modperl_io_apache.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_io_apache.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- modperl_io_apache.h 20 Aug 2003 23:20:14 -0000 1.1
+++ modperl_io_apache.h 6 Nov 2003 11:22:02 -0000 1.2
@@ -25,5 +25,8 @@
#define modperl_io_apache_init(pTHX)
#endif /* #ifdef PERLIO_LAYERS */
-
+
+MP_INLINE SSize_t modperl_request_read(pTHX_ request_rec *r,
+ char *buffer, Size_t len);
+
#endif /* MODPERL_IO_APACHE_H */
1.39 +25 -35 modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h
Index: Apache__RequestIO.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/Apache/RequestIO/Apache__RequestIO.h,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -u -r1.38 -r1.39
--- Apache__RequestIO.h 20 Aug 2003 23:13:28 -0000 1.38
+++ Apache__RequestIO.h 6 Nov 2003 11:22:02 -0000 1.39
@@ -206,55 +206,45 @@
(r->read_length || ap_should_client_block(r))
/* alias */
-#define mpxs_Apache__RequestRec_READ(r, buffer, bufsiz, offset) \
- mpxs_Apache__RequestRec_read(aTHX_ r, buffer, bufsiz, offset)
+#define mpxs_Apache__RequestRec_READ(r, bufsv, len, offset) \
+ mpxs_Apache__RequestRec_read(aTHX_ r, bufsv, len, offset)
static long mpxs_Apache__RequestRec_read(pTHX_ request_rec *r,
- SV *buffer, int bufsiz,
+ SV *bufsv, int len,
int offset)
{
- long total = 0;
- int rc;
+ long total;
- if ((rc = mpxs_setup_client_block(r)) != APR_SUCCESS) {
- return 0;
+ if (!SvOK(bufsv)) {
+ sv_setpvn(bufsv, "", 0);
}
- if (mpxs_should_client_block(r)) {
- long nrd;
- /* ap_should_client_block() will return 0 if r->read_length */
- mpxs_sv_grow(buffer, bufsiz+offset);
- while (bufsiz) {
- nrd = ap_get_client_block(r, SvPVX(buffer)+offset+total, bufsiz);
- if (nrd > 0) {
- total += nrd;
- bufsiz -= nrd;
- }
- else if (nrd == 0) {
- break;
- }
- else {
- /*
- * XXX: as stated in ap_get_client_block, the real
- * error gets lots, so we only know that there was one
- */
- ap_log_error(APLOG_MARK, APLOG_ERR, 0, r->server,
- "mod_perl: $r->read failed to read");
- break;
- }
- }
+ if (len <= 0) {
+ return 0;
}
+ /* XXX: need to handle negative offset */
+ /* XXX: need to pad with \0 if offset > size of the buffer */
+
+ mpxs_sv_grow(bufsv, len+offset);
+ total = modperl_request_read(aTHX_ r, SvPVX(bufsv)+offset, len);
+
if (total > 0) {
- mpxs_sv_cur_set(buffer, offset+total);
- SvTAINTED_on(buffer);
+ mpxs_sv_cur_set(bufsv, offset+total);
+ SvTAINTED_on(bufsv);
}
+ else if (total == 0) {
+ sv_setpvn(bufsv, "", 0);
+ }
else {
- sv_setpvn(buffer, "", 0);
+ /* need to return undef according to the read entry, but at
+ * the moment we return IV, so need to change to return SV,
+ * meanwhile just crock */
+ if (SvTRUE(ERRSV)) {
+ (void)modperl_errsv(aTHX_ HTTP_INTERNAL_SERVER_ERROR, r, NULL);
+ }
}
- MP_TRACE_o(MP_FUNC, "%d bytes [%s]", total, SvPVX(buffer));
-
return total;
}
1.59 +2 -2 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -u -r1.58 -r1.59
--- modperl_functions.map 30 Aug 2003 02:33:26 -0000 1.58
+++ modperl_functions.map 6 Nov 2003 11:22:02 -0000 1.59
@@ -46,8 +46,8 @@
SV *:DEFINE_CLOSE | | request_rec *:r
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
- long:DEFINE_READ | | request_rec *:r, SV *:buffer, int:bufsiz, int:offset=0
+ mpxs_Apache__RequestRec_read | | r, bufsv, len, offset=0
+ long:DEFINE_READ | | request_rec *:r, SV *:bufsv, int:len, int:offset=0
mpxs_Apache__RequestRec_write | | r, buffer, bufsiz=-1, offset=0
mpxs_Apache__RequestRec_print | | ...
apr_ssize_t:DEFINE_WRITE | | \
1.127 +27 -2 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.126
retrieving revision 1.127
diff -u -u -r1.126 -r1.127
--- FunctionTable.pm 14 Oct 2003 17:32:40 -0000 1.126
+++ FunctionTable.pm 6 Nov 2003 11:22:02 -0000 1.127
@@ -5754,16 +5754,41 @@
},
{
'type' => 'SV *',
- 'name' => 'buffer'
+ 'name' => 'bufsv'
},
{
'type' => 'int',
- 'name' => 'bufsiz'
+ 'name' => 'len'
},
{
'type' => 'int',
'name' => 'offset'
}
+ ]
+ },
+ {
+ 'return_type' => 'SSize_t',
+ 'name' => 'modperl_request_read',
+ 'attr' => [
+ 'static'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'request_rec *',
+ 'name' => 'r'
+ },
+ {
+ 'type' => 'char *',
+ 'name' => 'buffer'
+ },
+ {
+ 'type' => 'Size_t',
+ 'name' => 'len'
+ },
]
},
{
1.246 +6 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.245
retrieving revision 1.246
diff -u -u -r1.245 -r1.246
--- Changes 5 Nov 2003 19:36:15 -0000 1.245
+++ Changes 6 Nov 2003 11:22:02 -0000 1.246
@@ -12,6 +12,12 @@
=item 1.99_11-dev -
+rewrite $r->read() and perlio read functions to use the same function,
+which completely satisfies the read request if possible, on the way
+getting rid of get_client_block and its supporting functions which
+have problems and will most likely will be removed from the httpd-API
+in the future. Directly manipulate bucket brigades instead. [Stas]
+
Since Apache2.pm pops /foo/Apache2 dirs to the top of @INC, it now
also takes care of keeping lib and blib dirs before the system dirs,
so that previously installed libraries won't get loaded instead of the
