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