Bug#486069: perl: embedding perl hangs on hppa without PERL_SYS_INIT3() since 5.10.0

[Julien ÉLIE]

Hi Russ,

I do not know whether PERL_SYS_INIT3() is in Perl 5.004_03 (as INN is said
to compile with it).


>> void PERLsetup (char *startupfile, char *filterfile, const char *function)
>> {
>>     if (PerlCode == NULL) {
>> +        int argc = 5;
>> +        const char *argv[] = { "innd",
>> +                         "-e", "sub _load_ { do $_[0] }",
>> +                         "-e", "sub _eval_ { eval $_[0] }",
>> +                         NULL };
>
> This stuff is a hack that isn't actually necessary, incidentally.  eval_pv
> is the right way to call arbitrary Perl code and will let us call do and
> eval directly.  I never got around rewriting things to use that, though.

I tried to change it but it does not seem to work:  I obtain

    Jun 28 16:51:53 news innd: SERVER perl filter not defined

I do not know why there is that comment just below the definition of sub _load_
and sub _eval_:

    /* We can't call 'eval' and 'do' directly for some reason, so we define
       some wrapper functions to give us access. */

Maybe eval_pv does not work for what we need?


Here is what I wrote:

===================================================================
--- lib/perl.c  (révision 7873)
+++ lib/perl.c  (copie de travail)
@@ -99,21 +99,8 @@
     }
 }

-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
@@ -124,24 +111,28 @@
 void PERLsetup (char *startupfile, char *filterfile, const char *function)
 {
     if (PerlCode == NULL) {
+        int argc = 1;
+        const char *argv[] = { "innd", NULL };
+        char *env[]  = { NULL };
+
+        PERL_SYS_INIT3(&argc, &argv, &env);
         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) ;
+        eval_pv(evalfile, TRUE);
         PerlUnSilence();

         SPAGAIN ;
@@ -171,13 +162,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 +178,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) ;
+    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 +195,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, "eval undef &%s", function);
+        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 +230,7 @@
 {
    perl_destruct(PerlCode);
    perl_free(PerlCode);
+   PERL_SYS_TERM();
    PerlFilterActive = false;
 }