You are viewing a plain text version of this content. The canonical link for it is here.
Posted to dev@perl.apache.org by Stas Bekman <st...@stason.org> on 2004/09/26 05:32:24 UTC
[mp2 patch for the archives] "inlining" APR::Error
while I was trying to figure out where the taint problem is coming from
and before I've enclosed each callback call into PL_tainted untainting
block, I've first ported APR::Error not to be a perl+xs module, but to be
a part of the mod_perl.so. Of course there is an ugly part of eval_pv of
the perl code, but it worked. So as I have another solution for the
die(Nullch) problem, if it's accepted, then we don't need this hack, but I
didn't want to dispose it without having it archived, in case we will need
it in the future.
[inlined and attached, since some of the lines weren't polished and
therefore wrapped]
[besides the patch one needs to nuke xs/APR/Error]
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.222
diff -u -r1.222 mod_perl.c
--- src/modules/perl/mod_perl.c 21 Sep 2004 21:35:30 -0000 1.222
+++ src/modules/perl/mod_perl.c 26 Sep 2004 03:30:23 -0000
@@ -110,6 +110,8 @@
*/
modperl_require_module(aTHX_ "DynaLoader", FALSE);
+ modperl_error_boot(aTHX);
+
IoFLUSH_on(PL_stderrgv); /* unbuffer STDERR */
}
Index: src/modules/perl/modperl_error.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_error.c,v
retrieving revision 1.7
diff -u -r1.7 modperl_error.c
--- src/modules/perl/modperl_error.c 9 Sep 2004 15:08:03 -0000 1.7
+++ src/modules/perl/modperl_error.c 26 Sep 2004 03:30:23 -0000
@@ -44,7 +44,6 @@
return Perl_form(aTHX_ "%s", ptr ? ptr : "unknown error");
}
-
/* modperl_croak notes: under -T we can't really do anything when die
* was called in the stacked eval_sv (which is the case when a
* response handler calls a filter handler and that filter calls die
@@ -65,20 +64,6 @@
{
HV *stash;
HV *data;
- int is_tainted = PL_tainted;
-
- /* see the explanation above */
- if (is_tainted) {
- TAINT_NOT;
- }
- Perl_require_pv(aTHX_ "APR/Error.pm");
- if (is_tainted) {
- TAINT;
- }
-
- if (SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ "%s", SvPV_nolen(ERRSV));
- }
stash = gv_stashpvn("APR::Error", 10, FALSE);
data = newHV();
@@ -92,3 +77,102 @@
Perl_croak(aTHX_ Nullch);
}
+
+XS(XS_APR__Error_strerror)
+{
+ dXSARGS;
+ if (items != 1) {
+ Perl_croak(aTHX_ "Usage: APR::Error::strerror(rc)");
+ }
+ else {
+ apr_status_t rc = (apr_status_t)SvIV(ST(0));
+ char * RETVAL;
+ dXSTARG;
+ RETVAL = modperl_error_strerror(aTHX_ rc);
+ sv_setpv(TARG, RETVAL);
+ XSprePUSH;
+ PUSHTARG;
+ }
+
+ XSRETURN(1);
+}
+ /* APR::Error needs to be loaded before any other modules are
+ * loaded, but we can't know when a user will load Apache2.pm,
+ * therefore it can't live in the extension perl module. For now
+ * just inlining it here */
+#define APR_ERROR_PERL_CODE "package APR::Error;" \
+ " " \
+ "use overload " \
+ " nomethod => \\&fatal, " \
+ " 'bool' => \\&str, " \
+ " '==' => \\&num, " \
+ " '0+' => \\&num, " \
+ " '\"\"' => \\&str; " \
+ " " \
+ "sub fatal { die __PACKAGE__ . qq: Can't handle '$_[3]'] } " \
+ " " \
+ "# normally the object is created on the C side, but if you want to
" \
+ "# create one from Perl, you can. just pass a hash with args: " \
+ "# rc, file, line, func " \
+ "sub new { " \
+ " my $class = shift; " \
+ " my %args = @_; " \
+ " bless \%args, $class; " \
+ "} " \
+ " " \
+ "# " \
+ "# - even though most of the time the error id is not useful to the
end " \
+ "# users, developers may need to know it. For example in case of a
" \
+ "# non-english user locale setting, the error string could be " \
+ "# incomprehensible to a developer, but by having the error id it's
" \
+ "# possible to find the english equivalent " \
+ "# - the filename and line number are needed because perl doesn't " \
+ "# provide that info when exception objects are involved " \
+ "sub str { " \
+ " sprintf qq[%s: (%d) %s at %s line %d], $_[0]->{func}, " \
+ " $_[0]->{rc}, APR::Error::strerror($_[0]->{rc}), " \
+ " $_[0]->{file}, $_[0]->{line}; " \
+ "} " \
+ " " \
+ "sub num { $_[0]->{rc} } " \
+ "### Carp treatment ### " \
+ " " \
+ "require Carp; " \
+ "require Carp::Heavy; " \
+ " " \
+ "# skip the wrappers from this package from the long callers trace " \
+ "$Carp::CarpInternal{+__PACKAGE__}++; " \
+ " " \
+ "# XXX: Carp::(confess|cluck) see no calls stack when Perl_croak is
" \
+ "# called with Nullch (which is the way exception objects are " \
+ "# returned), so we fixup it here (doesn't quite work for croak " \
+ "# caller). " \
+ " " \
+ "sub cluck { " \
+ " if (ref $_[0] eq __PACKAGE__) { " \
+ " Carp::cluck(qq[$_[0]->{func}: ($_[0]->{rc}) ] . " \
+ " APR::Error::strerror($_[0]->{rc})); " \
+ " } " \
+ " else { " \
+ " &Carp::cluck; " \
+ " } " \
+ "} " \
+ " " \
+ "sub confess { " \
+ " if (ref $_[0] eq __PACKAGE__) { " \
+ " Carp::confess(qq[$_[0]->{func}: ($_[0]->{rc}) ] . " \
+ " APR::Error::strerror($_[0]->{rc})); " \
+ " } " \
+ " else { " \
+ " &Carp::confess; " \
+ " } " \
+ "} " \
+ "1;"
+
+void modperl_error_boot(pTHX)
+{
+ newXS("APR::Error::strerror", XS_APR__Error_strerror, __FILE__);
+
+ eval_pv(APR_ERROR_PERL_CODE, TRUE);
+}
+
Index: src/modules/perl/modperl_error.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_error.h,v
retrieving revision 1.3
diff -u -r1.3 modperl_error.h
--- src/modules/perl/modperl_error.h 9 Sep 2004 15:08:03 -0000 1.3
+++ src/modules/perl/modperl_error.h 26 Sep 2004 03:30:23 -0000
@@ -36,6 +36,10 @@
void modperl_croak(pTHX_ apr_status_t rc, const char* func);
+XS(XS_APR__Error_strerror);
+
+void modperl_error_boot(pTHX);
+
#define MP_RUN_CROAK(rc_run, func) STMT_START \
{ \
apr_status_t rc = rc_run; \
Index: xs/APR/APR/APR.xs
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/APR/APR/APR.xs,v
retrieving revision 1.12
diff -u -r1.12 APR.xs
--- xs/APR/APR/APR.xs 25 Jun 2004 15:29:25 -0000 1.12
+++ xs/APR/APR/APR.xs 26 Sep 2004 03:30:23 -0000
@@ -65,6 +65,7 @@
file = file; /* -Wall */
APR_initialize();
extra_apr_init(aTHX);
+ modperl_error_boot(aTHX);
void
END()
Index: xs/maps/apr_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/apr_functions.map,v
retrieving revision 1.87
diff -u -r1.87 apr_functions.map
--- xs/maps/apr_functions.map 22 Sep 2004 23:22:06 -0000 1.87
+++ xs/maps/apr_functions.map 26 Sep 2004 03:30:23 -0000
@@ -468,7 +468,7 @@
MODULE=APR::Error
~apr_strerror
- char *:DEFINE_strerror | | apr_status_t:rc
+# char *:DEFINE_strerror | | apr_status_t:rc
!MODULE=APR::General
-apr_app_initialize
--
__________________________________________________________________
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