Wrap perl_clone() call in a mutex

It appears to not be safe to have multiple threads clone the same
inst->perl at the same time.

diff --git a/src/modules/rlm_perl/rlm_perl.c b/src/modules/rlm_perl/rlm_perl.c
index b3f65c951b4b466e71bec78c4bee2806590231ee..bdc32e5faae45a8bb3d58c3fabf64b1486629fef 100644 (file)
--- a/src/modules/rlm_perl/rlm_perl.c
+++ b/src/modules/rlm_perl/rlm_perl.c
@@ -65,6 +65,10 @@ typedef struct {
        perl_func_def_t *func;
 } perl_call_env_t;
 
+typedef struct {
+       pthread_mutex_t mutex;
+} rlm_perl_mutable_t;
+
 /*
  *     Define a structure for our module configuration.
  *
@@ -83,6 +87,7 @@ typedef struct {
        PerlInterpreter *perl;
        bool            perl_parsed;
        HV              *rad_perlconf_hv;       //!< holds "config" items (perl %RAD_PERLCONF hash).
+       rlm_perl_mutable_t      *mutable;
 
 } rlm_perl_t;
 
@@ -1558,7 +1563,15 @@ static int mod_thread_instantiate(module_thread_inst_ctx_t const *mctx)
 
        PERL_SET_CONTEXT(inst->perl);
 
+       /*
+        *      Ensure only one thread is cloning an interpreter at a time
+        *      Whilst the documentation of perl_clone() does not say anything
+        *      about this, seg faults have been seen if multiple threads clone
+        *      the same inst->perl at the same time.
+        */
+       pthread_mutex_lock(&inst->mutable->mutex);
        interp = perl_clone(inst->perl, clone_flags);
+       pthread_mutex_unlock(&inst->mutable->mutex);
        {
                dTHXa(interp);                  /* Sets the current thread's interpreter */
        }
@@ -1741,6 +1754,9 @@ static int mod_instantiate(module_inst_ctx_t const *mctx)
 
        PL_endav = end_AV;
 
+       inst->mutable = talloc(NULL, rlm_perl_mutable_t);
+       pthread_mutex_init(&inst->mutable->mutex, NULL);
+
        return 0;
 }
 
@@ -1779,6 +1795,7 @@ static int mod_detach(module_detach_ctx_t const *mctx)
        }
 
        rlm_perl_interp_free(inst->perl);
+       talloc_free(inst->mutable);
 
        return ret;
 }