INN commit: trunk (doc/pod/news.pod lib/perl.c)

INN Commit Russ_Allbery at isc.org
Sun Jun 29 08:16:20 UTC 2008


    Date: Sunday, June 29, 2008 @ 01:16:19
  Author: iulius
Revision: 7924

Fixed a hang in Perl hooks on (at least) HP/PA since Perl 5.10.
On such architectures, pthread_mutex_lock() hangs inside perl_parse()
if PERL_SYS_INIT3() hasn't been called.

Also rewrite "do" and "eval" calls to use perl_eval_pv().

Modified:
  trunk/doc/pod/news.pod
  trunk/lib/perl.c

------------------+
 doc/pod/news.pod |    4 +++
 lib/perl.c       |   67 ++++++++++++++++++++++++-----------------------------
 2 files changed, 35 insertions(+), 36 deletions(-)

Modified: doc/pod/news.pod
===================================================================
--- doc/pod/news.pod	2008-06-27 18:13:48 UTC (rev 7923)
+++ doc/pod/news.pod	2008-06-29 08:16:19 UTC (rev 7924)
@@ -144,6 +144,10 @@
 
 =item *
 
+Fixed a hang in Perl hooks on (at least) HP/PA since S<Perl 5.10>.
+
+=item *
+
 Fixed a compilation problem on some platforms because of AF_INET6 which
 was not inside a HAVE_INET6 block in B<innfeed>.
 

Modified: lib/perl.c
===================================================================
--- lib/perl.c	2008-06-27 18:13:48 UTC (rev 7923)
+++ lib/perl.c	2008-06-29 08:16:19 UTC (rev 7924)
@@ -99,49 +99,42 @@
     }
 }
 
-static void PerlParse (void)
-{
-    const char *argv[] = { "innd",
-                           "-e", "sub _load_ { do $_[0] }",
-                           "-e", "sub _eval_ { eval $_[0] }",
-                           NULL } ;
 
-    /* We can't call 'eval' and 'do' directly for some reason, so we define
-       some wrapper functions to give us access. */
-        
-    perl_parse (PerlCode,xs_init,5,(char **)argv,NULL) ;
-}
 
-
-
 /*
-** Loads a setup Perl module. startupfile is the name of the file loaded
-** one-time at startup. filterfile is the file containing the filter
-** functions which is loaded at startup and at each reload. function is a
-** function name that must be defined after the file file is loaded for
+** Loads a setup Perl module.  startupfile is the name of the file loaded
+** one-time at startup.  filterfile is the file containing the filter
+** functions which is loaded at startup and at each reload.  function is a
+** function name that must be defined after the filterfile file is loaded for
 ** filtering to be turned on to start with.
 */
 void PERLsetup (char *startupfile, char *filterfile, const char *function)
 {
     if (PerlCode == NULL) {
+        /* Perl waits on standard input if not called with '-e'. */
+        int argc = 3;
+        const char *argv[] = { "innd", "-e", "0", NULL };
+        char *env[]  = { NULL };
+#ifdef PERL_SYS_INIT3
+        PERL_SYS_INIT3(&argc, &argv, &env);
+#endif
         PerlCode = perl_alloc();
         perl_construct(PerlCode);
-        PerlParse () ;
+        perl_parse(PerlCode, xs_init, argc, (char **)argv, env) ;
     }
     
     if (startupfile != NULL && filterfile != NULL) {
-        char *argv[2] ;
-        int rc ;
+        char *evalfile = NULL;
         dSP;
     
         ENTER ;
         SAVETMPS ;
-    
-        argv[0] = startupfile ;
-        argv[1] = NULL ;
 
+        /* The Perl expression which will be evaluated. */   
+        asprintf(&evalfile, "do '%s'", startupfile);
+
         PerlSilence();
-        rc = perl_call_argv ("_load_",G_DISCARD, argv) ;
+        perl_eval_pv(evalfile, TRUE);
         PerlUnSilence();
         
         SPAGAIN ;
@@ -171,13 +164,12 @@
 int PERLreadfilter(char *filterfile, const char *function)
 {
     dSP ;
-    char *argv [3] ;
+    char *argv[] = { NULL };
+    char *evalfile = NULL;
     
     ENTER ;
     SAVETMPS ;
     
-    argv[0] = NULL;
-
     if (perl_get_cv("filter_before_reload", false) != NULL)    {
         perl_call_argv("filter_before_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
         if (SvTRUE(ERRSV))     /* check $@ */ {
@@ -188,13 +180,16 @@
         }
     }
 
-    argv[0] = filterfile ;
-    argv[1] = NULL ;
-    
+    /* The Perl expression which will be evaluated. */
+    asprintf(&evalfile, "do '%s'", filterfile);
+
     PerlSilence();
-    perl_call_argv ("_load_", 0, argv) ;
+    perl_eval_pv(evalfile, TRUE);
     PerlUnSilence();
 
+    free(evalfile);
+    evalfile = NULL;
+
     if (SvTRUE(ERRSV))     /* check $@ */ {
         syslog (L_ERROR,"SERVER perl loading %s failed: %s",
                 filterfile, SvPV(ERRSV, PL_na)) ;
@@ -202,20 +197,17 @@
         
         /* If the reload failed we don't want the old definition hanging
            around. */
-        argv[0] = xmalloc (strlen (function) + strlen ("undef &%s")) ;
-        sprintf (argv[0],"undef &%s",function) ;
-        perl_call_argv ("_eval_",0,argv) ;
+        asprintf(&evalfile, "undef &%s", function);
+        perl_eval_pv(evalfile, TRUE);
 
         if (SvTRUE(ERRSV))     /* check $@ */ {
             syslog (L_ERROR,"SERVER perl undef &%s failed: %s",
                     function, SvPV(ERRSV, PL_na)) ;
         }
-        free (argv[0]) ;
     } else if ((perl_filter_cv = perl_get_cv(function, false)) == NULL) {
         PerlFilter (false) ;
     }
     
-    argv[0] = NULL;
     if (perl_get_cv("filter_after_reload", false) != NULL) {
         perl_call_argv("filter_after_reload", G_EVAL|G_DISCARD|G_NOARGS, argv);
         if (SvTRUE(ERRSV))     /* check $@ */ {
@@ -240,6 +232,9 @@
 {
    perl_destruct(PerlCode);
    perl_free(PerlCode);
+#ifdef PERL_SYS_TERM
+   PERL_SYS_TERM();
+#endif
    PerlFilterActive = false;
 }
 



More information about the inn-committers mailing list