static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl, pthread_key_t *key) { int ret; PerlInterpreter *interp; UV clone_flags = 0; PERL_SET_CONTEXT(perl); interp = pthread_getspecific(*key); if (interp) return interp; interp = perl_clone(perl, clone_flags); { dTHXa(interp); } # if PERL_REVISION >= 5 && PERL_VERSION <8 call_pv("CLONE",0); # endif ptr_table_free(PL_ptr_table); PL_ptr_table = NULL; PERL_SET_CONTEXT(aTHX); rlm_perl_clear_handles(aTHX); ret = pthread_setspecific(*key, interp); if (ret != 0) { DEBUG("Failed associating interpretor with thread %s", fr_syserror(ret)); rlm_perl_destruct(interp); return NULL; } return interp; }
static void rlm_destroy_perl(PerlInterpreter *perl) { void **handles; dTHXa(perl); PERL_SET_CONTEXT(perl); handles = rlm_perl_get_handles(aTHX); if (handles) rlm_perl_close_handles(handles); rlm_perl_destruct(perl); }
static int mod_detach(void *instance) { rlm_perl_t *inst = (rlm_perl_t *) instance; int exitstatus = 0, count = 0; if (inst->perl_parsed) { dTHXa(inst->perl); PERL_SET_CONTEXT(inst->perl); if (inst->rad_perlconf_hv != NULL) hv_undef(inst->rad_perlconf_hv); if (inst->func_detach) { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } } #ifdef USE_ITHREADS rlm_perl_destruct(inst->perl); pthread_mutex_destroy(&inst->clone_mutex); #else perl_destruct(inst->perl); perl_free(inst->perl); #endif /* * Hope this is not really needed. * Is only allowed to be called once just before exit(). * PERL_SYS_TERM(); */ return exitstatus; }
static int mod_detach(void *instance) { rlm_perl_t *inst = (rlm_perl_t *) instance; int exitstatus = 0, count = 0; #if 0 /* * FIXME: Call this in the destruct function? */ { dTHXa(handle->clone); PERL_SET_CONTEXT(handle->clone); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; /* * FIXME: bug in perl * */ if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } } #endif if (inst->func_detach) { dTHXa(inst->perl); PERL_SET_CONTEXT(inst->perl); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } } #ifdef USE_ITHREADS rlm_perl_destruct(inst->perl); pthread_mutex_destroy(&inst->clone_mutex); #else perl_destruct(inst->perl); perl_free(inst->perl); #endif PERL_SYS_TERM(); return exitstatus; }
/* * Detach a instance give a chance to a module to make some internal setup ... */ static int perl_detach(void *instance) { PERL_INST *inst = (PERL_INST *) instance; int exitstatus=0,count=0; #ifdef USE_ITHREADS POOL_HANDLE *handle, *tmp, *tmp2; MUTEX_LOCK(&inst->perl_pool->mutex); inst->perl_pool->detach = yes; MUTEX_UNLOCK(&inst->perl_pool->mutex); for (handle = inst->perl_pool->head; handle != NULL; handle = handle->next) { radlog(L_DBG,"Detach perl 0x%lx", (unsigned long) handle->clone); /* * Wait until clone becomes idle */ MUTEX_LOCK(&handle->lock); /* * Give a clones chance to run detach function */ { dTHXa(handle->clone); PERL_SET_CONTEXT(handle->clone); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; /* * FIXME: bug in perl * */ if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; radlog(L_DBG,"detach at 0x%lx returned status %d", (unsigned long) handle->clone, exitstatus); } } MUTEX_UNLOCK(&handle->lock); } /* * Free handles */ for (tmp = inst->perl_pool->head; tmp !=NULL ; tmp = tmp2) { tmp2 = tmp->next; radlog(L_DBG,"rlm_perl:: Destroy perl"); rlm_perl_destruct(tmp->clone); delete_pool_handle(tmp,inst); } { dTHXa(inst->perl); #endif /* USE_ITHREADS */ PERL_SET_CONTEXT(inst->perl); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } #ifdef USE_ITHREADS } #endif xlat_unregister(inst->xlat_name, perl_xlat); free(inst->xlat_name); if (inst->func_authorize) free(inst->func_authorize); if (inst->func_authenticate) free(inst->func_authenticate); if (inst->func_accounting) free(inst->func_accounting); if (inst->func_preacct) free(inst->func_preacct); if (inst->func_checksimul) free(inst->func_checksimul); if (inst->func_pre_proxy) free(inst->func_pre_proxy); if (inst->func_post_proxy) free(inst->func_post_proxy); if (inst->func_post_auth) free(inst->func_post_auth); 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); rlm_perl_destruct(inst->perl); #else perl_destruct(inst->perl); perl_free(inst->perl); #endif free(inst); return exitstatus; }
/* * Detach a instance give a chance to a module to make some internal setup ... */ static int perl_detach(void *instance) { PERL_INST *inst = (PERL_INST *) instance; int exitstatus = 0, count = 0; #if 0 /* * FIXME: Call this in the destruct function? */ { dTHXa(handle->clone); PERL_SET_CONTEXT(handle->clone); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; /* * FIXME: bug in perl * */ if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } } #endif { dTHXa(inst->perl); PERL_SET_CONTEXT(inst->perl); { dSP; ENTER; SAVETMPS; PUSHMARK(SP); count = call_pv(inst->func_detach, G_SCALAR | G_EVAL ); SPAGAIN; if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; } } xlat_unregister(inst->xlat_name, perl_xlat); free(inst->xlat_name); #ifdef USE_ITHREADS rlm_perl_destruct(inst->perl); #else perl_destruct(inst->perl); perl_free(inst->perl); #endif free(inst); return exitstatus; }