INN commit: trunk (innd/perl.c lib/perl.c nnrpd/perl.c)
INN Commit
rra at isc.org
Mon Aug 10 11:51:03 UTC 2015
Date: Monday, August 10, 2015 @ 04:51:03
Author: iulius
Revision: 9930
Perl XS code: Clean up the use of ERRSV along with the SvTRUE macro
ERRSV macro has a getter C function internally. SvTRUE macro evaluates
its arguments multiple times, leading to exponential calls of the
getter function. ERRSV should be assigned to a SV* variable before
passing that SV* to SvTRUE macro.
Thanks to bulk88 for having pointed that out in the Perl bug tracker.
Modified:
trunk/innd/perl.c
trunk/lib/perl.c
trunk/nnrpd/perl.c
--------------+
innd/perl.c | 18 ++++++++++++------
lib/perl.c | 33 +++++++++++++++++++++------------
nnrpd/perl.c | 20 ++++++++++++++------
3 files changed, 47 insertions(+), 24 deletions(-)
Modified: innd/perl.c
===================================================================
--- innd/perl.c 2015-08-09 19:56:52 UTC (rev 9929)
+++ innd/perl.c 2015-08-10 11:51:03 UTC (rev 9930)
@@ -71,6 +71,7 @@
char * p;
static char buf[256];
bool failure;
+ SV * errsv;
if (!PerlFilterActive) return NULL;
filter = perl_get_cv("filter_art", 0);
@@ -114,11 +115,12 @@
/* Check $@, which will be set if the sub died. */
buf[0] = '\0';
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog(L_ERROR, "Perl function filter_art died on article %s: %s",
HDR_FOUND(HDR__MESSAGE_ID) ? HDR(HDR__MESSAGE_ID) : "?",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void) POPs;
} else {
failure = false;
@@ -154,6 +156,7 @@
char *p;
static char buf[256];
bool failure;
+ SV * errsv;
if (!PerlFilterActive) return NULL;
filter = perl_get_cv("filter_messageid", 0);
@@ -170,10 +173,11 @@
/* Check $@, which will be set if the sub died. */
buf[0] = '\0';
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog(L_ERROR, "Perl function filter_messageid died on id %s: %s",
- messageID, SvPV(ERRSV, PL_na));
+ messageID, SvPV(errsv, PL_na));
(void) POPs;
} else {
failure = false;
@@ -206,6 +210,7 @@
HV *mode;
CV *filter;
bool failure;
+ SV * errsv;
filter = perl_get_cv("filter_mode", 0);
if (!filter) return;
@@ -244,10 +249,11 @@
SPAGAIN;
/* Check $@, which will be set if the sub died. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog(L_ERROR, "Perl function filter_mode died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void) POPs;
} else {
failure = false;
Modified: lib/perl.c
===================================================================
--- lib/perl.c 2015-08-09 19:56:52 UTC (rev 9929)
+++ lib/perl.c 2015-08-10 11:51:03 UTC (rev 9930)
@@ -66,6 +66,7 @@
{
dSP;
char *argv[] = { NULL };
+ SV *errsv;
if (value == PerlFilterActive)
return true;
@@ -78,9 +79,10 @@
/* No need for PUSHMARK(SP) with call_argv(). */
perl_call_argv("filter_end", G_EVAL | G_DISCARD | G_NOARGS, argv);
SPAGAIN;
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
syslog (L_ERROR, "SERVER perl function filter_end died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void) POPs;
}
PUTBACK;
@@ -133,6 +135,7 @@
if (startupfile != NULL && filterfile != NULL) {
char *evalfile = NULL;
bool failure;
+ SV *errsv;
dSP;
ENTER;
@@ -153,10 +156,11 @@
evalfile = NULL;
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog(L_ERROR,"SERVER perl loading %s failed: %s",
- startupfile, SvPV(ERRSV, PL_na));
+ startupfile, SvPV(errsv, PL_na));
} else {
failure = false;
}
@@ -187,6 +191,7 @@
char *argv[] = { NULL };
char *evalfile = NULL;
bool failure;
+ SV *errsv;
if (perl_get_cv("filter_before_reload", false) != NULL) {
ENTER;
@@ -195,10 +200,11 @@
perl_call_argv("filter_before_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
SPAGAIN;
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog (L_ERROR,"SERVER perl function filter_before_reload died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void)POPs;
} else {
failure = false;
@@ -228,10 +234,11 @@
evalfile = NULL;
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog (L_ERROR,"SERVER perl loading %s failed: %s",
- filterfile, SvPV(ERRSV, PL_na));
+ filterfile, SvPV(errsv, PL_na));
} else {
failure = false;
}
@@ -258,9 +265,10 @@
evalfile = NULL;
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
syslog (L_ERROR,"SERVER perl undef &%s failed: %s",
- function, SvPV(ERRSV, PL_na)) ;
+ function, SvPV(errsv, PL_na)) ;
}
PUTBACK;
FREETMPS;
@@ -276,10 +284,11 @@
perl_call_argv("filter_after_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
SPAGAIN;
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog (L_ERROR,"SERVER perl function filter_after_reload died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void)POPs;
} else {
failure = false;
Modified: nnrpd/perl.c
===================================================================
--- nnrpd/perl.c 2015-08-09 19:56:52 UTC (rev 9929)
+++ nnrpd/perl.c 2015-08-10 11:51:03 UTC (rev 9930)
@@ -66,6 +66,7 @@
int OtherSize;
char *argv[] = { NULL };
bool failure;
+ SV *errsv;
if(!PerlLoaded) {
loadPerl();
@@ -194,10 +195,11 @@
buf[0] = '\0';
/* Check $@. */
- if (SvTRUE(ERRSV)) {
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) {
failure = true;
syslog(L_ERROR, "Perl function filter_post died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
(void)POPs;
} else {
failure = false;
@@ -247,6 +249,7 @@
SV *sv;
int rc, i;
char *key, *val, *buffer;
+ SV *errsv;
if (!PerlFilterActive)
return;
@@ -277,8 +280,9 @@
SPAGAIN;
if (rc == 0) { /* Error occured, same as checking $@. */
+ errsv = ERRSV;
syslog(L_ERROR, "Perl function access died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
Reply("%d Internal error (1). Goodbye!\r\n", NNTP_FAIL_TERMINATING);
ExitWithStats(1, true);
}
@@ -321,6 +325,7 @@
{
dSP;
int rc;
+ SV *errsv;
if (!PerlFilterActive)
return;
@@ -338,9 +343,10 @@
SPAGAIN;
- if (SvTRUE(ERRSV)) { /* Check $@. */
+ errsv = ERRSV;
+ if (SvTRUE(errsv)) { /* Check $@. */
syslog(L_ERROR, "Perl function authenticate died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
Reply("%d Internal error (1). Goodbye!\r\n", NNTP_FAIL_TERMINATING);
ExitWithStats(1, true);
}
@@ -362,6 +368,7 @@
HV *attribs;
int rc;
char *p;
+ SV *errsv;
if (!PerlFilterActive)
*code = NNTP_FAIL_AUTHINFO_BAD;
@@ -391,8 +398,9 @@
SPAGAIN;
if (rc == 0 ) { /* Error occurred, same as checking $@. */
+ errsv = ERRSV;
syslog(L_ERROR, "Perl function authenticate died: %s",
- SvPV(ERRSV, PL_na));
+ SvPV(errsv, PL_na));
Reply("%d Internal error (1). Goodbye!\r\n", NNTP_FAIL_TERMINATING);
ExitWithStats(1, false);
}
More information about the inn-committers
mailing list