INN commit: trunk (8 files)

INN Commit rra at isc.org
Mon Jun 13 15:08:31 UTC 2011


    Date: Monday, June 13, 2011 @ 08:08:31
  Author: iulius
Revision: 9205

Build INN with the new "-Wunused-but-set-variable" GCC 4.6.0 warning.
It was complaining about an unused "sv" variable.

This commit fixes the following issues:
* innd and nnrpd segfaults because of a corrupted Perl stack.
A copy of the Perl stack pointer is saved at several places
in the code but not always restored the way it should be.  For instance,
PerlFilter() calls could reallocate the Perl stack and subsequently
cause failures when the stack is used afterwards.
Make sure that the Perl stack could not be modified twice in the row
without being properly updated at global scope.

* use ENTER-SAVETMPS-PUSHMARK-PUTBACK and SPAGAIN-PUTBACK-FREETMPS-LEAVE
macros whenever they are required.
Note that call_argv() does not need PUSHMARK-PUTBACK.

* fixed two memory leaks because of a xasprintf() which was not free'd.

* documentation of the filter_end() Perl routine that is called, if
defined, prior to the deactivation of Perl filters.  Both used by innd
and nnrpd when Perl filtering is turned off (either with "ctlinnd perl n"
or when a Perl function dies at run time).

Modified:
  trunk/doc/pod/ctlinnd.pod
  trunk/doc/pod/hook-perl.pod
  trunk/doc/pod/news.pod
  trunk/innd/perl.c
  trunk/lib/perl.c
  trunk/nnrpd/perl.c
  trunk/samples/filter_innd.pl
  trunk/samples/filter_nnrpd.pl

-------------------------+
 doc/pod/ctlinnd.pod     |    4 +
 doc/pod/hook-perl.pod   |    9 +-
 doc/pod/news.pod        |   11 +++
 innd/perl.c             |   60 ++++++++++++++----
 lib/perl.c              |  147 +++++++++++++++++++++++++++++++++-------------
 nnrpd/perl.c            |   58 ++++++++++--------
 samples/filter_innd.pl  |    7 +-
 samples/filter_nnrpd.pl |    7 ++
 8 files changed, 222 insertions(+), 81 deletions(-)

Modified: doc/pod/ctlinnd.pod
===================================================================
--- doc/pod/ctlinnd.pod	2011-06-11 06:48:50 UTC (rev 9204)
+++ doc/pod/ctlinnd.pod	2011-06-13 15:08:31 UTC (rev 9205)
@@ -297,6 +297,10 @@
 was built with Perl filtering support.  If I<flag> starts with C<y>,
 filtering is enabled; if it starts with C<n>, filtering is disabled.
 
+When filtering is disabled, if the F<filter_innd.pl> Perl filter defined
+a function C<filter_end>, it will be called prior to the deactivation of
+the filter.
+
 =item python I<flag>
 
 Enable or disable Python filtering.  This command is only available if INN

Modified: doc/pod/hook-perl.pod
===================================================================
--- doc/pod/hook-perl.pod	2011-06-11 06:48:50 UTC (rev 9204)
+++ doc/pod/hook-perl.pod	2011-06-13 15:08:31 UTC (rev 9205)
@@ -195,6 +195,8 @@
 with C<ctlinnd perl y>.  Perl filtering is turned off automatically if
 loading of the filter fails or if the filter code returns any sort of a
 fatal error (either due to Perl itself or due to a C<die> in the Perl code).
+When filtering is disabled and a C<filter_end()> function is available,
+it will be called prior to the deactivation of the filter.
 
 =head1 Supported innd Callbacks
 
@@ -294,9 +296,10 @@
 If F<filter_nnrpd.pl> loads successfully and defines the Perl function
 filter_post(), Perl filtering is turned on.  Otherwise, it's turned off.
 If filter_post() ever returns a fatal error (either from Perl or from a
-C<die> in the Perl code), Perl filtering is turned off for the life of that
-nnrpd process and any further posts made during that session won't go
-through the filter.
+C<die> in the Perl code), Perl filtering is turned off for the life of
+that nnrpd process and any further posts made during that session won't go
+through the filter.  Besides, if F<filter_nnrpd.pl> defines a C<filter_end()>
+function, it will be called prior to the deactivation of the filter.
 
 While Perl filtering is on, every article received by nnrpd via the POST
 command is passed to the filter_post() Perl function before it is passed

Modified: doc/pod/news.pod
===================================================================
--- doc/pod/news.pod	2011-06-11 06:48:50 UTC (rev 9204)
+++ doc/pod/news.pod	2011-06-13 15:08:31 UTC (rev 9205)
@@ -205,6 +205,14 @@
 
 =item *
 
+The X-Trace: header field was not properly generated when an article
+was locally posted.  The field mentioning the IP address was skipped,
+resulting in a wrong syntax for this header.  The local "127.0.0.1" IP
+address is now used.  Besides, C<localhost> is now mentioned instead of
+an obscure C<stdin> in injection header fields.
+
+=item *
+
 B<pullnews> no longer stops processing newsgroups when an error occur during
 its run (for instance when a newsgroup mentioned in the configuration file
 is removed from an upstream server).  Besides, it can now use authentication
@@ -234,7 +242,8 @@
 
 Other minor bug fixes and documentation improvements.  In particular, the
 I<debug-shrinking>, I<fast-exit> and I<initial-sleep> keys in F<innfeed.conf>
-are now documented.
+are now documented.  The function C<filter_end()>, called when Perl filtering
+is turned off, is also documented for the B<innd> and B<nnrpd> Perl filters.
 
 =back
 

Modified: innd/perl.c
===================================================================
--- innd/perl.c	2011-06-11 06:48:50 UTC (rev 9204)
+++ innd/perl.c	2011-06-13 15:08:31 UTC (rev 9205)
@@ -70,6 +70,7 @@
     int         i, rc;
     char *      p;
     static char buf[256];
+    bool        failure;
 
     if (!PerlFilterActive) return NULL;
     filter = perl_get_cv("filter_art", 0);
@@ -105,6 +106,7 @@
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
+    PUTBACK;
     rc = perl_call_sv((SV *) filter, G_EVAL|G_SCALAR|G_NOARGS);
     SPAGAIN;
 
@@ -113,20 +115,27 @@
     /* Check $@, which will be set if the sub died. */
     buf[0] = '\0';
     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));
         (void) POPs;
-        PerlFilter(false);
-    } else if (rc == 1) {
-        p = POPp;
-        if (p && *p)
-            strlcpy(buf, p, sizeof(buf));
+    } else {
+        failure = false;
+        if (rc == 1) {
+            p = POPp;
+            if (p && *p)
+                strlcpy(buf, p, sizeof(buf));
+        }
     }
 
     PUTBACK;
     FREETMPS;
     LEAVE;
+
+    if (failure)
+        PerlFilter(false);
+
     return (buf[0] != '\0') ? buf : NULL;
 }
 
@@ -144,6 +153,7 @@
     int         rc;
     char        *p;
     static char buf[256];
+    bool        failure;
 
     if (!PerlFilterActive) return NULL;
     filter = perl_get_cv("filter_messageid", 0);
@@ -161,19 +171,26 @@
     /* Check $@, which will be set if the sub died. */
     buf[0] = '\0';
     if (SvTRUE(ERRSV)) {
+        failure = true;
         syslog(L_ERROR, "Perl function filter_messageid died on id %s: %s",
                messageID, SvPV(ERRSV, PL_na));
         (void) POPs;
-        PerlFilter(false);
-    } else if (rc == 1) {
-        p = POPp;
-        if (p && *p)
-            strlcpy(buf, p, sizeof(buf));
+    } else {
+        failure = false;
+        if (rc == 1) {
+            p = POPp;
+            if (p && *p)
+                strlcpy(buf, p, sizeof(buf));
+        }
     }
-    
+
     PUTBACK;
     FREETMPS;
     LEAVE;
+
+    if (failure)
+        PerlFilter(false);
+
     return (buf[0] != '\0') ? buf : NULL;
 }
 
@@ -188,6 +205,7 @@
     dSP;
     HV          *mode;
     CV          *filter;
+    bool        failure;
 
     filter = perl_get_cv("filter_mode", 0);
     if (!filter) return;
@@ -216,16 +234,31 @@
 
     (void) hv_store(mode, "reason", 6, newSVpv(reason, 0), 0);
 
+    ENTER;
+    SAVETMPS;
     PUSHMARK(SP);
+    PUTBACK;
+
     perl_call_sv((SV *) filter, G_EVAL|G_DISCARD|G_NOARGS);
 
+    SPAGAIN;
+
     /* Check $@, which will be set if the sub died. */
     if (SvTRUE(ERRSV)) {
+        failure = true;
         syslog(L_ERROR, "Perl function filter_mode died: %s",
                 SvPV(ERRSV, PL_na));
         (void) POPs;
+    } else {
+        failure = false;
+    }
+
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+
+    if (failure)
         PerlFilter(false);
-    }
 }
 
 
@@ -240,7 +273,7 @@
 {
     dSP;
     char *argv[] = { NULL };
-    
+
     if (perl_get_cv("filter_stats", false) == NULL)
         return NULL;
     else {
@@ -249,6 +282,7 @@
 
 	ENTER;
 	SAVETMPS;
+        /* No need for PUSHMARK(SP) with call_argv(). */
 	perl_call_argv("filter_stats", G_EVAL | G_NOARGS, argv);
 	SPAGAIN;
         result = POPp;

Modified: lib/perl.c
===================================================================
--- lib/perl.c	2011-06-11 06:48:50 UTC (rev 9204)
+++ lib/perl.c	2011-06-13 15:08:31 UTC (rev 9205)
@@ -3,7 +3,7 @@
 **  Embedded Perl support for INN.
 **
 **  Originally written by Christophe Wolfhugel <wolf at pasteur.fr> (although
-**  he wouldn't recongize it any more, so don't blame him) and modified,
+**  he wouldn't recognize it any more, so don't blame him) and modified,
 **  expanded, and tweaked by James Brister, Dave Hayes, and Russ Allbery
 **  among others.
 **
@@ -75,12 +75,15 @@
         if (perl_get_cv("filter_end", false) != NULL) {
             ENTER;
             SAVETMPS;
+            /* No need for PUSHMARK(SP) with call_argv(). */
             perl_call_argv("filter_end", G_EVAL | G_DISCARD | G_NOARGS, argv);
+            SPAGAIN;
             if (SvTRUE(ERRSV)) {
                 syslog (L_ERROR, "SERVER perl function filter_end died: %s",
                         SvPV(ERRSV, PL_na));
                 (void) POPs;
             }
+            PUTBACK;
             FREETMPS;
             LEAVE;
         }
@@ -126,36 +129,49 @@
 #endif
         perl_parse(PerlCode, xs_init, argc, argv, env) ;
     }
-    
+
     if (startupfile != NULL && filterfile != NULL) {
         char *evalfile = NULL;
+        bool failure;
         dSP;
-    
-        ENTER ;
-        SAVETMPS ;
 
-        /* The Perl expression which will be evaluated. */   
+        ENTER;
+        SAVETMPS;
+        PUSHMARK(SP);
+        PUTBACK;
+
+        /* The Perl expression which will be evaluated. */
         xasprintf(&evalfile, "do '%s'", startupfile);
 
         PerlSilence();
         perl_eval_pv(evalfile, TRUE);
         PerlUnSilence();
-        
-        SPAGAIN ;
-        
-        if (SvTRUE(ERRSV))     /* check $@ */ {
+
+        SPAGAIN;
+
+        free(evalfile);
+        evalfile = NULL;
+
+        /* Check $@. */
+        if (SvTRUE(ERRSV)) {
+            failure = true;
             syslog(L_ERROR,"SERVER perl loading %s failed: %s",
-		   startupfile, SvPV(ERRSV, PL_na)) ;
-            PerlFilter (false) ;
-    
+                   startupfile, SvPV(ERRSV, PL_na));
         } else {
-            PERLreadfilter (filterfile,function) ;
+            failure = false;
         }
 
-        FREETMPS ;
-        LEAVE ;
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+
+        if (failure) {
+            PerlFilter (false);
+        } else {
+            PERLreadfilter (filterfile, function);
+        }
     } else {
-        PERLreadfilter (filterfile,function) ;
+        PERLreadfilter (filterfile, function);
     }
 }
 
@@ -167,23 +183,38 @@
    function there. */
 int PERLreadfilter(char *filterfile, const char *function)
 {
-    dSP ;
+    dSP;
     char *argv[] = { NULL };
     char *evalfile = NULL;
+    bool failure;
 
-    ENTER ;
-    SAVETMPS ;
-
-    if (perl_get_cv("filter_before_reload", false) != NULL)    {
+    if (perl_get_cv("filter_before_reload", false) != NULL) {
+        ENTER;
+        SAVETMPS;
+        /* No need for PUSHMARK(SP) with call_argv(). */
         perl_call_argv("filter_before_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
-        if (SvTRUE(ERRSV))     /* check $@ */ {
+        SPAGAIN;
+        /* Check $@. */
+        if (SvTRUE(ERRSV)) {
+            failure = true;
             syslog (L_ERROR,"SERVER perl function filter_before_reload died: %s",
-                    SvPV(ERRSV, PL_na)) ;
-            (void)POPs ;
-            PerlFilter (false) ;
+                    SvPV(ERRSV, PL_na));
+            (void)POPs;
+        } else {
+            failure = false;
         }
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+        if (failure)
+            PerlFilter (false);
     }
 
+    ENTER;
+    SAVETMPS;
+    PUSHMARK(SP);
+    PUTBACK;
+
     /* The Perl expression which will be evaluated. */
     xasprintf(&evalfile, "do '%s'", filterfile);
 
@@ -191,35 +222,74 @@
     perl_eval_pv(evalfile, TRUE);
     PerlUnSilence();
 
+    SPAGAIN;
+
     free(evalfile);
     evalfile = NULL;
 
-    if (SvTRUE(ERRSV))     /* check $@ */ {
+    /* Check $@. */
+    if (SvTRUE(ERRSV)) {
+        failure = true;
         syslog (L_ERROR,"SERVER perl loading %s failed: %s",
-                filterfile, SvPV(ERRSV, PL_na)) ;
-        PerlFilter (false) ;
-        
+                filterfile, SvPV(ERRSV, PL_na));
+    } else {
+        failure = false;
+    }
+    PUTBACK;
+    FREETMPS;
+    LEAVE;
+    if (failure) {
+        PerlFilter (false);
+
         /* If the reload failed we don't want the old definition hanging
            around. */
+
+        ENTER;
+        SAVETMPS;
+        PUSHMARK(SP);
+        PUTBACK;
+
         xasprintf(&evalfile, "undef &%s", function);
         perl_eval_pv(evalfile, TRUE);
 
-        if (SvTRUE(ERRSV))     /* check $@ */ {
+        SPAGAIN;
+
+        free(evalfile);
+        evalfile = NULL;
+
+        /* Check $@. */
+        if (SvTRUE(ERRSV)) {
             syslog (L_ERROR,"SERVER perl undef &%s failed: %s",
                     function, SvPV(ERRSV, PL_na)) ;
         }
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
     } else if ((perl_filter_cv = perl_get_cv(function, false)) == NULL) {
-        PerlFilter (false) ;
+        PerlFilter (false);
     }
 
     if (perl_get_cv("filter_after_reload", false) != NULL) {
+        ENTER;
+        SAVETMPS;
+        /* No need for PUSHMARK(SP) with call_argv(). */
         perl_call_argv("filter_after_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
-        if (SvTRUE(ERRSV))     /* check $@ */ {
+        SPAGAIN;
+        /* Check $@. */
+        if (SvTRUE(ERRSV)) {
+            failure = true;
             syslog (L_ERROR,"SERVER perl function filter_after_reload died: %s",
-                    SvPV(ERRSV, PL_na)) ;
-            (void)POPs ;
-            PerlFilter (false) ;
+                    SvPV(ERRSV, PL_na));
+            (void)POPs;
+        } else {
+            failure = false;
         }
+        PUTBACK;
+        FREETMPS;
+        LEAVE;
+        if (failure) {
+            PerlFilter (false);
+        }
     }
 
     /* We try to find an inversion between filter_innd.pl
@@ -237,9 +307,6 @@
         }
     }
 
-    FREETMPS ;
-    LEAVE ;
-
     return (perl_filter_cv != NULL) ;
 }
 
@@ -296,7 +363,7 @@
     savestdout = 0;
     return;
   }
-    
+
   if (dup2(newfd,2) < 0) {
     syslog(L_ERROR,"SERVER perl silence cant redirect stderr: %m");
     savestderr = 0;

Modified: nnrpd/perl.c
===================================================================
--- nnrpd/perl.c	2011-06-11 06:48:50 UTC (rev 9204)
+++ nnrpd/perl.c	2011-06-13 15:08:31 UTC (rev 9205)
@@ -64,6 +64,7 @@
     SV *modswitch;
     int OtherSize;
     char *argv[] = { NULL };
+    bool failure;
 
     if(!PerlLoaded) {
         loadPerl();
@@ -77,10 +78,10 @@
         syslog(L_ERROR,"Whoops.  Can't open error log: %m");
     }
 #endif /* DEBUG_MODIFY */
-   
+
     ENTER;
     SAVETMPS;
-   
+
     /* Create the Perl hash. */
     hdr = perl_get_hv("hdr", true);
     for (hp = Table; hp < EndOfTable; hp++) {
@@ -88,7 +89,7 @@
             (void) hv_store(hdr, (char *) hp->Name, strlen(hp->Name),
                      newSVpv(hp->Body, 0), 0);
     }
-   
+
     /* Also store other headers. */
     OtherSize = OtherCount;
     for (i = 0; i < OtherCount; i++) {
@@ -109,12 +110,13 @@
 
     /* Store user. */
     sv_setpv(perl_get_sv("user", true), PERMuser);
-   
+
     /* Store body. */
     body = perl_get_sv("body", true);
     sv_setpv(body, article);
 
     /* Call the filtering function. */
+    /* No need for PUSHMARK(SP) with call_argv(). */
     rc = perl_call_argv("filter_post", G_EVAL|G_SCALAR, argv);
 
     SPAGAIN;
@@ -126,7 +128,7 @@
         HeadersModified = true;
         i = 0;
 
-#ifdef DEBUG_MODIFY     
+#ifdef DEBUG_MODIFY
         dumpTable("Before mod");
 #endif /* DEBUG_MODIFY */
 
@@ -136,7 +138,7 @@
              * new values. */
             p = HePV(scan, len);
             s = SvPV(HeVAL(scan), PL_na);
-#ifdef DEBUG_MODIFY     
+#ifdef DEBUG_MODIFY
             fprintf(flog,"Hash iter: '%s','%s'\n", p, s);
 #endif /* DEBUG_MODIFY */
 
@@ -179,22 +181,30 @@
     sv_setsv(body, &PL_sv_undef);
 
     buf[0] = '\0';
-   
-    if (SvTRUE(ERRSV)) {    /* Check $@. */
+
+    /* Check $@. */
+    if (SvTRUE(ERRSV)) {
+        failure = true;
         syslog(L_ERROR, "Perl function filter_post died: %s",
                SvPV(ERRSV, PL_na));
         (void)POPs;
-        PerlFilter(false);
-    } else if (rc == 1) {
-        p = POPp;
-        if (p != NULL && *p != '\0')
-            strlcpy(buf, p, sizeof(buf));
+    } else {
+        failure = false;
+        if (rc == 1) {
+            p = POPp;
+            if (p != NULL && *p != '\0')
+                strlcpy(buf, p, sizeof(buf));
+        }
     }
 
+    PUTBACK;
     FREETMPS;
     LEAVE;
-   
-    if (buf[0] != '\0') 
+
+    if (failure)
+        PerlFilter(false);
+
+    if (buf[0] != '\0')
         return buf;
     return NULL;
 }
@@ -238,6 +248,7 @@
     (void) hv_store(attribs, "username", 8, newSVpv(user, 0), 0);
 
     PUSHMARK(SP);
+    PUTBACK;
 
     if (perl_get_cv("access", 0) == NULL) {
         syslog(L_ERROR, "Perl function access not defined");
@@ -276,7 +287,7 @@
         strlcat(buffer, ": \"", BIG_BUFFER);
         strlcat(buffer, val, BIG_BUFFER);
         strlcat(buffer, "\"\n", BIG_BUFFER);
- 
+
         vector_add(access_vec, buffer);
     }
 
@@ -293,14 +304,15 @@
 {
     dSP;
     int rc;
-    
+
     if (!PerlFilterActive)
         return;
 
     ENTER;
     SAVETMPS;
     PUSHMARK(SP);
-    
+    PUTBACK;
+
     if (perl_get_cv("auth_init", 0) == NULL) {
         syslog(L_ERROR, "Perl function auth_init not defined");
         Reply("%d Internal error (3).  Goodbye!\r\n", NNTP_FAIL_TERMINATING);
@@ -311,7 +323,6 @@
 
     SPAGAIN;
 
-
     if (SvTRUE(ERRSV)) {    /* Check $@. */
         syslog(L_ERROR, "Perl function authenticate died: %s",
                SvPV(ERRSV, PL_na));
@@ -336,7 +347,7 @@
     HV *attribs;
     int rc;
     char *p;
-    
+
     if (!PerlFilterActive)
         *code = NNTP_FAIL_AUTHINFO_BAD;
 
@@ -357,8 +368,9 @@
     (void) hv_store(attribs, "intport", 7, newSViv(Client.serverport), 0);
     (void) hv_store(attribs, "username", 8, newSVpv(user, 0), 0);
     (void) hv_store(attribs, "password", 8, newSVpv(passwd, 0), 0);
-    
+
     PUSHMARK(SP);
+    PUTBACK;
     rc = perl_call_pv("authenticate", G_EVAL|G_ARRAY);
 
     SPAGAIN;
@@ -382,7 +394,7 @@
     if (rc == 3) {
         p = POPp;
         strlcpy(newUser, p, BIG_BUFFER);
-    } 
+    }
 
     p = POPp;
     strlcpy(errorstring, p, BIG_BUFFER);
@@ -405,7 +417,7 @@
     int i;
 
     fprintf(flog, "===BEGIN TABLE DUMP: %s\n", msg);
-      
+
     for (hp = Table; hp < EndOfTable; hp++) {
         fprintf(flog, " Name: '%s'",hp->Name);
         fflush(flog);

Modified: samples/filter_innd.pl
===================================================================
--- samples/filter_innd.pl	2011-06-11 06:48:50 UTC (rev 9204)
+++ samples/filter_innd.pl	2011-06-13 15:08:31 UTC (rev 9205)
@@ -12,6 +12,9 @@
 # called, and after it's finished loading, the perl routine
 # `filter_after_reload' is called. See startup_innd.pl for more details.
 #
+# When filtering is disabled, the filter_end() Perl routine is called,
+# if defined, prior to the deactivation of the filter.
+#
 # The following routines can be defined here for use by innd:
 #
 #	sub filter_art { ... }
@@ -124,10 +127,12 @@
      $rval;
 }
 
+sub filter_end {
+# Do whatever you want to clean up things when Perl filtering is disabled.
+}
 
 
 
-
 ###########################################################################
 ##
 ## Another sample. More elaborate, but cleaner... from Christophe

Modified: samples/filter_nnrpd.pl
===================================================================
--- samples/filter_nnrpd.pl	2011-06-11 06:48:50 UTC (rev 9204)
+++ samples/filter_nnrpd.pl	2011-06-13 15:08:31 UTC (rev 9205)
@@ -13,6 +13,8 @@
 # in the rejection message (make sure that such a message is properly encoded
 # in UTF-8 so as to comply with the NNTP protocol).
 #
+# When filtering is disabled, the filter_end() Perl routine is called,
+# if defined, prior to the deactivation of the filter.
 
 #
 # Do any initialization steps.
@@ -73,3 +75,8 @@
 
     return ($lines, $quoted, $antiquoted);
 }
+
+sub filter_end {
+# Do whatever you want to clean up things when Perl filtering is disabled.
+}
+




More information about the inn-committers mailing list