stas 2003/12/22 19:02:34
Modified: src/modules/perl modperl_filter.c modperl_io_apache.c
xs/Apache/RequestIO Apache__RequestIO.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
. Changes
Added: t/filter/TestFilter in_error.pm
t/filter in_error.t
Log:
fix the $r->read function to return undef on failure similar to the
core perl function and make $! available for those who test for read()
failures + test.
Revision Changes Path
1.1 modperl-2.0/t/filter/TestFilter/in_error.pm
Index: in_error.pm
===================================================================
package TestFilter::in_error;
# errors in filters should be properly propogated to httpd
# XXX: need to test output as well, and separately connection and
# request filters
use strict;
use warnings FATAL => 'all';
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Filter ();
use APR::Table ();
use Apache::TestTrace;
use Apache::Const -compile => qw(OK);
sub handler {
my $filter = shift;
debug join '', "-" x 20 , " filter called ", "-" x 20;
die "This filter must die";
return Apache::OK;
}
sub response {
my $r = shift;
my $len = $r->read(my $data, $r->headers_in->{'Content-Length'});
# XXX: what about $! it's incorrect now
die "failed to read POSTed data: $!" unless defined $len;
debug "read $len bytes [$data]";
$r->content_type('text/plain');
$r->print("it shouldn't be printed, because the input filter has died");
Apache::OK;
}
1;
__DATA__
SetHandler modperl
PerlModule TestFilter::in_error
PerlResponseHandler TestFilter::in_error::response
1.1 modperl-2.0/t/filter/in_error.t
Index: in_error.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
plan tests => 1;
my $location = '/TestFilter__in_error';
my $res = POST $location, content => 'foo';
ok t_cmp(500, $res->code, "an error in a filter should cause 500");
1.79 +5 -1 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.78
retrieving revision 1.79
diff -u -u -r1.78 -r1.79
--- modperl_filter.c 13 Dec 2003 23:40:31 -0000 1.78
+++ modperl_filter.c 23 Dec 2003 03:02:34 -0000 1.79
@@ -452,7 +452,11 @@
av_push(args, newSViv(filter->readbytes));
}
- /* XXX filters are VOID handlers. should we ignore the status? */
+ /* while filters are VOID handlers, we need to log any errors,
+ * because most perl coders will forget to check the return errors
+ * from read() and print() calls. and if the caller is not a perl
+ * program they won't make any sense of ERRSV or $!
+ */
if ((status = modperl_callback(aTHX_ handler, p, r, s, args)) != OK) {
status = modperl_errsv(aTHX_ status, r, s);
}
1.14 +11 -2 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.13
retrieving revision 1.14
diff -u -u -r1.13 -r1.14
--- modperl_io_apache.c 7 Nov 2003 08:58:50 -0000 1.13
+++ modperl_io_apache.c 23 Dec 2003 03:02:34 -0000 1.14
@@ -277,15 +277,24 @@
rc = ap_get_brigade(r->input_filters, bb, AP_MODE_READBYTES,
APR_BLOCK_READ, len);
if (rc != APR_SUCCESS) {
+ char *error;
/* 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,
+
+ if (SvTRUE(ERRSV)) {
+ STRLEN n_a;
+ error = SvPV(ERRSV, n_a);
+ }
+ else {
+ error = modperl_apr_strerror(rc);
+ }
+ sv_setpv(get_sv("!", TRUE),
(char *)apr_psprintf(r->pool,
"failed to get bucket brigade: %s",
- modperl_apr_strerror(rc)));
+ error));
return -1;
}
1.40 +7 -9 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.39
retrieving revision 1.40
diff -u -u -r1.39 -r1.40
--- Apache__RequestIO.h 6 Nov 2003 11:22:02 -0000 1.39
+++ Apache__RequestIO.h 23 Dec 2003 03:02:34 -0000 1.40
@@ -209,7 +209,7 @@
#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,
+static SV* mpxs_Apache__RequestRec_read(pTHX_ request_rec *r,
SV *bufsv, int len,
int offset)
{
@@ -220,7 +220,10 @@
}
if (len <= 0) {
- return 0;
+ sv_setpv(get_sv("!", TRUE),
+ (char *)apr_psprintf(r->pool,
+ "The LENGTH argument can't be negative"));
+ return &PL_sv_undef;
}
/* XXX: need to handle negative offset */
@@ -237,15 +240,10 @@
sv_setpvn(bufsv, "", 0);
}
else {
- /* 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);
- }
+ return &PL_sv_undef;
}
- return total;
+ return sv_2mortal(newSViv(total));
}
static MP_INLINE
1.63 +1 -1 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.62
retrieving revision 1.63
diff -u -u -r1.62 -r1.63
--- modperl_functions.map 18 Dec 2003 18:53:50 -0000 1.62
+++ modperl_functions.map 23 Dec 2003 03:02:34 -0000 1.63
@@ -48,7 +48,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, bufsv, len, offset=0
- long:DEFINE_READ | | request_rec *:r, SV *:bufsv, int:len, int:offset=0
+ SV *: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.134 +1 -1 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.133
retrieving revision 1.134
diff -u -u -r1.133 -r1.134
--- FunctionTable.pm 8 Dec 2003 19:31:53 -0000 1.133
+++ FunctionTable.pm 23 Dec 2003 03:02:34 -0000 1.134
@@ -5748,7 +5748,7 @@
]
},
{
- 'return_type' => 'long',
+ 'return_type' => 'SV *',
'name' => 'mpxs_Apache__RequestRec_read',
'attr' => [
'static'
1.295 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.294
retrieving revision 1.295
diff -u -u -r1.294 -r1.295
--- Changes 23 Dec 2003 00:34:36 -0000 1.294
+++ Changes 23 Dec 2003 03:02:34 -0000 1.295
@@ -12,6 +12,10 @@
=item 1.99_13-dev
+fix the $r->read function to return undef on failure similar to the
+core perl function and make $! available for those who test for read()
+failures. [Stas]
+
Make sure that pnotes are destroyed after PerlCleanup handlers are
finished and not before + test. [Stas]
