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