On _ 2003-07-01 at 20:20, Manuel Sousa wrote:
> Hi all,
>
> I just tried the latest CVS (couple of hours ago) version and found a
> bug when using 2 instances of the module.
There is a patch against latest CVS that should fix it. Enjoy.
--
Best Regards,
Boian Jordanov
SNE
Orbitel - the Internet Company
tel. +359 2 937 07 23
Index: rlm_perl.c
===================================================================
RCS file: /source/radiusd/src/modules/rlm_perl/rlm_perl.c,v
retrieving revision 1.11
diff -u -r1.11 rlm_perl.c
--- rlm_perl.c 25 Jun 2003 21:37:57 -0000 1.11
+++ rlm_perl.c 16 Jul 2003 08:35:55 -0000
@@ -12,7 +12,7 @@
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
@@ -40,10 +40,6 @@
#undef INADDR_ANY
#endif
-#ifdef INADDR_NONE
-#undef INADDR_NONE
-#endif
-
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
@@ -52,118 +48,122 @@
static const char rcsid[] = "$Id: rlm_perl.c,v 1.11 2003/06/25 21:37:57 aland Exp $";
+#ifdef USE_ITHREADS
+
+/*
+ * Pool of Perl's clones (genetically cloned) ;)
+ *
+ */
+typedef struct pool_handle {
+ struct pool_handle *next;
+ struct pool_handle *prev;
+ enum {busy, idle} status;
+ unsigned int request_count;
+ PerlInterpreter *clone;
+} POOL_HANDLE;
+
+typedef struct PERL_POOL {
+ POOL_HANDLE *head;
+ POOL_HANDLE *tail;
+
+ int current_clones;
+ int active_clones;
+ int max_clones;
+ int start_clones;
+ int min_spare_clones;
+ int max_spare_clones;
+ int max_request_per_clone;
+ int cleanup_delay;
+ perl_mutex mutex;
+ time_t time_when_last_added;
+} PERL_POOL;
+
+#endif
/*
- * Define a structure for our module configuration.
+ * Define a structure for our module configuration.
*
- * These variables do not need to be in a structure, but it's
- * a lot cleaner to do so, and a pointer to the structure can
- * be used as the instance handle.
+ * These variables do not need to be in a structure, but it's
+ * a lot cleaner to do so, and a pointer to the structure can
+ * be used as the instance handle.
*/
typedef struct perl_inst {
- /* Name of the perl module */
- char *module;
-
- /* Name of the functions for each module method */
- char *func_authorize;
- char *func_authenticate;
- char *func_accounting;
- char *func_start_accounting;
- char *func_stop_accounting;
- char *func_preacct;
- char *func_checksimul;
- char *func_detach;
- char *func_xlat;
- char *xlat_name;
- char *perl_flags;
+ /* Name of the perl module */
+ char *module;
+
+ /* Name of the functions for each module method */
+ char *func_authorize;
+ char *func_authenticate;
+ char *func_accounting;
+ char *func_start_accounting;
+ char *func_stop_accounting;
+ char *func_preacct;
+ char *func_checksimul;
+ char *func_detach;
+ char *func_xlat;
+ char *xlat_name;
+ char *perl_flags;
+ PerlInterpreter *perl;
+#ifdef USE_ITHREADS
+ PERL_POOL *perl_pool;
+#endif
} PERL_INST;
/*
- * A mapping of configuration file names to internal variables.
+ * A mapping of configuration file names to internal variables.
*
- * Note that the string is dynamically allocated, so it MUST
- * be freed. When the configuration file parse re-reads the string,
- * it free's the old one, and strdup's the new one, placing the pointer
- * to the strdup'd string into 'config.string'. This gets around
- * buffer over-flows.
+ * Note that the string is dynamically allocated, so it MUST
+ * be freed. When the configuration file parse re-reads the string,
+ * it free's the old one, and strdup's the new one, placing the pointer
+ * to the strdup'd string into 'config.string'. This gets around
+ * buffer over-flows.
*/
static CONF_PARSER module_config[] = {
- { "module", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,module), NULL, "module"},
- { "func_authorize", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_authorize), NULL, "authorize"},
- { "func_authenticate", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_authenticate), NULL, "authenticate"},
- { "func_accounting", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_accounting), NULL, "accounting"},
- { "func_preacct", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_preacct), NULL, "preacct"},
- { "func_checksimul", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_checksimul), NULL, "checksimul"},
- { "func_detach", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_detach), NULL, "detach"},
- { "func_xlat", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_xlat), NULL, "xlat"},
- { "perl_flags", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,perl_flags), NULL, NULL},
- { "func_start_accounting", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_start_accounting), NULL, NULL},
- { "func_stop_accounting", PW_TYPE_STRING_PTR,
- offsetof(PERL_INST,func_stop_accounting), NULL, NULL},
+ { "module", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,module), NULL, "module"},
+ { "func_authorize", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_authorize), NULL, "authorize"},
+ { "func_authenticate", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_authenticate), NULL, "authenticate"},
+ { "func_accounting", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_accounting), NULL, "accounting"},
+ { "func_preacct", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_preacct), NULL, "preacct"},
+ { "func_checksimul", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_checksimul), NULL, "checksimul"},
+ { "func_detach", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_detach), NULL, "detach"},
+ { "func_xlat", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_xlat), NULL, "xlat"},
+ { "perl_flags", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,perl_flags), NULL, NULL},
+ { "func_start_accounting", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_start_accounting), NULL, NULL},
+ { "func_stop_accounting", PW_TYPE_STRING_PTR,
+ offsetof(PERL_INST,func_stop_accounting), NULL, NULL},
- { NULL, -1, 0, NULL, NULL } /* end the list */
+ { NULL, -1, 0, NULL, NULL } /* end the list */
};
-
+
/*
* man perlembed
*/
EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
+#ifdef USE_ITHREADS
/*
- * We share one perl interpreter among all of the instances
- * of this module. And clone it for every thread if we have perl
+ * We use one perl to clone from it i.e. main boss
+ * We clone it for every instance if we have perl
* with -Duseithreads compiled in
*/
static PerlInterpreter *interp;
-#ifdef USE_ITHREADS
-
-/*
- * Pool of Perl's clones (genetically cloned) ;)
- *
- */
-typedef struct pool_handle {
- struct pool_handle *next;
- struct pool_handle *prev;
- enum {busy, idle} status;
- unsigned int request_count;
- PerlInterpreter *clone;
-} POOL_HANDLE;
-
-typedef struct PERL_POOL {
- POOL_HANDLE *head;
- POOL_HANDLE *tail;
-
- int current_clones;
- int active_clones;
- int max_clones;
- int start_clones;
- int min_spare_clones;
- int max_spare_clones;
- int max_request_per_clone;
- int cleanup_delay;
- perl_mutex mutex;
- time_t time_when_last_added;
-} PERL_POOL;
-
-static PERL_POOL perl_pool;
-
static const CONF_PARSER pool_conf[] = {
- { "max_clones", PW_TYPE_INTEGER, 0, &perl_pool.max_clones, "32"},
- { "start_clones",PW_TYPE_INTEGER, 0, &perl_pool.start_clones, "5"},
- { "min_spare_clones",PW_TYPE_INTEGER, 0, &perl_pool.min_spare_clones, "3"},
- { "max_spare_clones",PW_TYPE_INTEGER, 0, &perl_pool.max_spare_clones, "3"},
- { "cleanup_delay",PW_TYPE_INTEGER, 0, &perl_pool.cleanup_delay, "5"},
- { "max_request_per_clone",PW_TYPE_INTEGER, 0, &perl_pool.max_request_per_clone, "0"},
+ { "max_clones", PW_TYPE_INTEGER, offsetof(PERL_POOL, max_clones), NULL, "32"},
+ { "start_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, start_clones), NULL, "5"},
+ { "min_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL, min_spare_clones),NULL, "3"},
+ { "max_spare_clones",PW_TYPE_INTEGER, offsetof(PERL_POOL,max_spare_clones),NULL, "3"},
+ { "cleanup_delay",PW_TYPE_INTEGER, offsetof(PERL_POOL,cleanup_delay),NULL, "5"},
+ { "max_request_per_clone",PW_TYPE_INTEGER, offsetof(PERL_POOL,max_request_per_clone),NULL, "0"},
{ NULL, -1, 0, NULL, NULL } /* end the list */
};
@@ -239,14 +239,14 @@
free(handles);
}
-static PerlInterpreter *rlm_perl_clone()
+static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl)
{
PerlInterpreter *clone;
UV clone_flags = CLONEf_KEEP_PTR_TABLE;
- PERL_SET_CONTEXT(interp);
+ PERL_SET_CONTEXT(perl);
- clone = perl_clone(interp, clone_flags);
+ clone = perl_clone(perl, clone_flags);
{
dTHXa(clone);
}
@@ -281,7 +281,7 @@
while (PL_scopestack_ix > 1 ){
LEAVE;
}
-
+
perl_destruct(perl);
perl_free(perl);
@@ -302,7 +302,7 @@
rlm_perl_close_handles(handles);
}
-static void delete_pool_handle(POOL_HANDLE *handle)
+static void delete_pool_handle(POOL_HANDLE *handle, PERL_INST *inst)
{
POOL_HANDLE *prev;
POOL_HANDLE *next;
@@ -311,34 +311,36 @@
next = handle->next;
if (prev == NULL) {
- perl_pool.head = next;
+ inst->perl_pool->head = next;
} else {
prev->next = next;
}
if (next == NULL) {
- perl_pool.tail = prev;
+ inst->perl_pool->tail = prev;
} else {
next->prev = prev;
}
- perl_pool.current_clones--;
+ inst->perl_pool->current_clones--;
+
+ free(handle);
}
-static void move2tail(POOL_HANDLE *handle)
+static void move2tail(POOL_HANDLE *handle, PERL_INST *inst)
{
POOL_HANDLE *prev;
POOL_HANDLE *next;
- if (perl_pool.head == NULL) {
+ if (inst->perl_pool->head == NULL) {
handle->prev = NULL;
handle->next = NULL;
- perl_pool.head = handle;
- perl_pool.tail = handle;
+ inst->perl_pool->head = handle;
+ inst->perl_pool->tail = handle;
return;
}
- if (perl_pool.tail == handle) {
+ if (inst->perl_pool->tail == handle) {
return;
}
@@ -352,7 +354,7 @@
}
if (prev == NULL) {
- perl_pool.head = next;
+ inst->perl_pool->head = next;
next->prev = NULL;
} else {
@@ -363,19 +365,19 @@
}
handle->next = NULL;
- prev = perl_pool.tail;
+ prev = inst->perl_pool->tail;
- perl_pool.tail = handle;
+ inst->perl_pool->tail = handle;
handle->prev = prev;
prev->next = handle;
}
-static POOL_HANDLE *pool_grow () {
+static POOL_HANDLE *pool_grow (PERL_INST *inst) {
POOL_HANDLE *handle;
time_t now;
- if (perl_pool.max_clones == perl_pool.current_clones) {
+ if (inst->perl_pool->max_clones == inst->perl_pool->current_clones) {
return NULL;
}
@@ -389,18 +391,18 @@
handle->prev = NULL;
handle->next = NULL;
handle->status = idle;
- handle->clone = rlm_perl_clone();
+ handle->clone = rlm_perl_clone(inst->perl);
handle->request_count = 0;
- perl_pool.current_clones++;
- move2tail(handle);
+ inst->perl_pool->current_clones++;
+ move2tail(handle, inst);
now = time(NULL);
- perl_pool.time_when_last_added = now;
+ inst->perl_pool->time_when_last_added = now;
return handle;
}
-static POOL_HANDLE *pool_pop()
+static POOL_HANDLE *pool_pop(PERL_INST *inst)
{
POOL_HANDLE *handle;
POOL_HANDLE *found;
@@ -409,11 +411,11 @@
* Lock the pool and be fast other thread maybe
* waiting for us to finish
*/
- MUTEX_LOCK(&perl_pool.mutex);
+ MUTEX_LOCK(&inst->perl_pool->mutex);
found = NULL;
- for (handle = perl_pool.head; handle ; handle = tmp) {
+ for (handle = inst->perl_pool->head; handle ; handle = tmp) {
tmp = handle->next;
if (handle->status == idle){
@@ -423,37 +425,37 @@
}
if (found == NULL) {
- if (perl_pool.current_clones < perl_pool.max_clones ) {
+ if (inst->perl_pool->current_clones < inst->perl_pool->max_clones ) {
- found = pool_grow();
- perl_pool.current_clones++;
+ found = pool_grow(inst);
+ inst->perl_pool->current_clones++;
if (found == NULL) {
radlog(L_ERR,"Cannot grow pool returning");
- MUTEX_UNLOCK(&perl_pool.mutex);
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return NULL;
}
} else {
radlog(L_ERR,"reached maximum clones %d cannot grow",
- perl_pool.current_clones);
- MUTEX_UNLOCK(&perl_pool.mutex);
+ inst->perl_pool->current_clones);
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return NULL;
}
}
- move2tail(found);
+ move2tail(found, inst);
found->status = busy;
- perl_pool.active_clones++;
+ inst->perl_pool->active_clones++;
found->request_count++;
/*
* Hurry Up
*/
- MUTEX_UNLOCK(&perl_pool.mutex);
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
radlog(L_DBG,"perl_pool: item 0x%lx asigned new request. Handled so far: %d",
(unsigned long) found->clone, found->request_count);
return found;
}
-static int pool_release(POOL_HANDLE *handle) {
+static int pool_release(POOL_HANDLE *handle, PERL_INST *inst) {
POOL_HANDLE *tmp, *tmp2;
int spare, i, t;
@@ -461,40 +463,40 @@
/*
* Lock it
*/
- MUTEX_LOCK(&perl_pool.mutex);
+ MUTEX_LOCK(&inst->perl_pool->mutex);
handle->status = idle;
- perl_pool.active_clones--;
+ inst->perl_pool->active_clones--;
- spare = perl_pool.current_clones - perl_pool.active_clones;
+ spare = inst->perl_pool->current_clones - inst->perl_pool->active_clones;
radlog(L_DBG,"perl_pool total/active/spare [%d/%d/%d]"
- , perl_pool.current_clones, perl_pool.active_clones, spare);
+ , inst->perl_pool->current_clones, inst->perl_pool->active_clones, spare);
- if (spare < perl_pool.min_spare_clones) {
- t = perl_pool.min_spare_clones - spare;
+ if (spare < inst->perl_pool->min_spare_clones) {
+ t = inst->perl_pool->min_spare_clones - spare;
for (i=0;i<t; i++) {
- if ((tmp = pool_grow()) == NULL) {
- MUTEX_UNLOCK(&perl_pool.mutex);
+ if ((tmp = pool_grow(inst)) == NULL) {
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return -1;
}
}
- MUTEX_UNLOCK(&perl_pool.mutex);
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
now = time(NULL);
- if ((now - perl_pool.time_when_last_added) < perl_pool.cleanup_delay) {
- MUTEX_UNLOCK(&perl_pool.mutex);
+ if ((now - inst->perl_pool->time_when_last_added) < inst->perl_pool->cleanup_delay) {
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
- if (spare > perl_pool.max_spare_clones) {
- spare -= perl_pool.max_spare_clones;
- for (tmp = perl_pool.head; (tmp !=NULL ) && (spare > 0) ; tmp = tmp2) {
+ if (spare > inst->perl_pool->max_spare_clones) {
+ spare -= inst->perl_pool->max_spare_clones;
+ for (tmp = inst->perl_pool->head; (tmp !=NULL ) && (spare > 0) ; tmp = tmp2) {
tmp2 = tmp->next;
if(tmp->status == idle) {
rlm_destroy_perl(tmp->clone);
- delete_pool_handle(tmp);
- perl_pool.current_clones--;
+ delete_pool_handle(tmp,inst);
+ inst->perl_pool->current_clones--;
spare--;
break;
}
@@ -503,24 +505,31 @@
/*
* Hurry Up :)
*/
- MUTEX_UNLOCK(&perl_pool.mutex);
+ MUTEX_UNLOCK(&inst->perl_pool->mutex);
return 0;
}
-static int init_pool (CONF_SECTION *conf) {
+static int init_pool (CONF_SECTION *conf, PERL_INST *inst) {
POOL_HANDLE *handle;
- int t;
+ int t;
+ PERL_POOL *pool;
+
+ pool = rad_malloc(sizeof(PERL_POOL));
+ memset(pool,0,sizeof(PERL_POOL));
- MUTEX_INIT(&perl_pool.mutex);
+ inst->perl_pool = pool;
+
+ MUTEX_INIT(&pool->mutex);
/*
* Read The Config
*
*/
- cf_section_parse(conf,NULL,pool_conf);
-
- for(t = 0;t < perl_pool.start_clones ;t++){
- if ((handle = pool_grow()) == NULL) {
+ cf_section_parse(conf,pool,pool_conf);
+ inst->perl_pool = pool;
+
+ for(t = 0;t < inst->perl_pool->start_clones ;t++){
+ if ((handle = pool_grow(inst)) == NULL) {
return -1;
}
@@ -536,9 +545,12 @@
*
* Try to avoid putting too much stuff in here - it's better to
* do it in instantiate() where it is not global.
+ * I use one global interpetator to make things more fastest for
+ * Threading env I clone new perl from this interp.
*/
static int perl_init(void)
{
+#ifdef USE_ITHREADS
if ((interp = perl_alloc()) == NULL) {
radlog(L_INFO, "rlm_perl: No memory for allocating new perl !");
return -1;
@@ -546,7 +558,7 @@
perl_construct(interp);
PL_perl_destruct_level = 2;
-
+#endif
return 0;
}
@@ -600,12 +612,12 @@
int count, ret;
STRLEN n_a;
- perl = interp;
+ perl = inst->perl;
#ifdef USE_ITHREADS
POOL_HANDLE *handle;
- if ((handle = pool_pop()) == NULL) {
+ if ((handle = pool_pop(instance)) == NULL) {
return 0;
}
@@ -615,7 +627,8 @@
{
dTHXa(perl);
}
-#endif
+#endif
+ PERL_SET_CONTEXT(perl);
{
dSP;
ENTER;SAVETMPS;
@@ -665,7 +678,7 @@
}
}
#ifdef USE_ITHREADS
- pool_release(handle);
+ pool_release(handle, instance);
#endif
return 0;
}
@@ -687,9 +700,9 @@
static int perl_instantiate(CONF_SECTION *conf, void **instance)
{
PERL_INST *inst = (PERL_INST *) instance;
- HV *rad_reply_hv = newHV();
- HV *rad_check_hv = newHV();
- HV *rad_request_hv = newHV();
+ HV *rad_reply_hv;
+ HV *rad_check_hv;
+ HV *rad_request_hv;
char *embed[4], *xlat_name;
int exitstatus = 0, argc=0;
@@ -722,20 +735,38 @@
argc = 3;
}
- exitstatus = perl_parse(interp, xs_init, argc, embed, NULL);
+#ifdef USE_ITHREADS
+ inst->perl = perl_clone(interp ,CLONEf_KEEP_PTR_TABLE);
+
+ dTHXa(inst->perl);
+ PERL_SET_CONTEXT(inst->perl);
+#else
+ if ((inst->perl = perl_alloc()) == NULL) {
+ radlog(L_INFO, "rlm_perl: No memory for allocating new perl !");
+ return -1;
+ }
+
+ perl_construct(inst->perl);
+#endif
#if PERL_REVISION >= 5 && PERL_VERSION >=8
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#endif
+ exitstatus = perl_parse(inst->perl, xs_init, argc, embed, NULL);
+
if(!exitstatus) {
- exitstatus = perl_run(interp);
+ exitstatus = perl_run(inst->perl);
} else {
radlog(L_INFO,"rlm_perl: perl_parse failed: %s not found or has syntax errors. \n", inst->module);
return (-1);
}
newXS("radiusd::radlog",XS_radiusd_radlog, "rlm_perl.c");
+
+ rad_reply_hv = newHV();
+ rad_check_hv = newHV();
+ rad_request_hv = newHV();
rad_reply_hv = get_hv("RAD_REPLY",1);
rad_check_hv = get_hv("RAD_CHECK",1);
@@ -750,8 +781,7 @@
}
#ifdef USE_ITHREADS
-
- if ((init_pool(conf)) == -1) {
+ if ((init_pool(conf, inst)) == -1) {
radlog(L_ERR,"Couldn't init a pool of perl clones. Exiting");
return -1;
}
@@ -882,7 +912,7 @@
#ifdef USE_ITHREADS
POOL_HANDLE *handle;
- if ((handle = pool_pop()) == NULL) {
+ if ((handle = pool_pop(instance)) == NULL) {
return RLM_MODULE_FAIL;
}
@@ -891,7 +921,10 @@
dTHXa(handle->clone);
PERL_SET_CONTEXT(handle->clone);
}
-#endif
+#else
+ PERL_SET_CONTEXT(inst->perl);
+ radlog(L_DBG,"Using perl at 0x%lx",(unsigned long) inst->perl);
+#endif
{
dSP;
@@ -960,7 +993,7 @@
}
}
#ifdef USE_ITHREADS
- pool_release(handle);
+ pool_release(handle,instance);
radlog(L_DBG,"Unreserve perl at address 0x%lx", (unsigned long) handle->clone);
#endif
@@ -1061,14 +1094,15 @@
int exitstatus=0,count=0;
#ifdef USE_ITHREADS
- POOL_HANDLE *handle;
+ POOL_HANDLE *handle, *tmp, *tmp2;
+
- for (handle = perl_pool.head; handle; handle = handle->next) {
+ for (handle = inst->perl_pool->head; handle; handle = handle->next) {
radlog(L_INFO,"Detach perl 0x%lx", (unsigned long) handle->clone);
/*
* Wait until clone becomes idle
- *
+ * FIXME: What if thread lock block and don't to leave ? Deadlock ?
*/
while (handle->status == busy) {
}
@@ -1099,22 +1133,25 @@
(unsigned long) handle->clone, exitstatus);
}
}
-
}
/*
- *
- * FIXME: For more efficienty we don't
- * free entire pool. We only reread config flags thus way
- * we can extend pool_size.
- *
+ * Free handles
*/
+
+ for (tmp = inst->perl_pool->head; tmp !=NULL ; tmp = tmp2) {
+ tmp2 = tmp->next;
+ rlm_perl_destruct(tmp->clone);
+ delete_pool_handle(tmp,inst);
+ }
+
{
- dTHXa(interp);
- PERL_SET_CONTEXT(interp);
+ dTHXa(inst->perl);
#endif /* USE_ITHREADS */
+ PERL_SET_CONTEXT(inst->perl);
{
dSP;
PUSHMARK(SP);
+
count = call_pv(inst->func_detach, G_SCALAR | G_EVAL );
SPAGAIN;
@@ -1125,6 +1162,8 @@
}
}
PUTBACK;
+ FREETMPS;
+ LEAVE;
}
#ifdef USE_ITHREADS
}
@@ -1139,8 +1178,17 @@
if (inst->func_preacct) free(inst->func_preacct);
if (inst->func_checksimul) free(inst->func_checksimul);
if (inst->func_detach) free(inst->func_detach);
-
+
+#ifdef USE_ITHREADS
+ free(inst->perl_pool->head);
+ free(inst->perl_pool->tail);
+ MUTEX_DESTROY(&inst->perl_pool->mutex);
+ free(inst->perl_pool);
+#endif
+ perl_destruct(inst->perl);
+ perl_free(inst->perl);
free(inst);
+
return exitstatus;
}
