/* * Do any per-module initialization that is separate to each * configured instance of the module. e.g. set up connections * to external databases, read configuration files, set up * dictionary entries, etc. * * If configuration information is given in the config section * that must be referenced in later calls, store a handle to it * in *instance otherwise put a null pointer there. * * Setup a hashes wich we will use later * parse a module and give him a chance to live * */ static int mod_instantiate(void *instance, CONF_SECTION *conf) { rlm_perl_t *inst = instance; AV *end_AV; char const **embed_c; /* Stupid Perl and lack of const consistency */ char **embed; char **envp = NULL; int exitstatus = 0, argc=0; char arg[] = "0"; CONF_SECTION *cs; #ifdef USE_ITHREADS /* * Create pthread key. This key will be stored in instance */ pthread_mutex_init(&inst->clone_mutex, NULL); MEM(inst->thread_key = talloc_zero(inst, pthread_key_t)); rlm_perl_make_key(inst->thread_key); #endif /* * Setup the argument array we pass to the perl interpreter */ MEM(embed_c = talloc_zero_array(inst, char const *, 4)); memcpy(&embed, &embed_c, sizeof(embed)); embed_c[0] = NULL; if (inst->perl_flags) { embed_c[1] = inst->perl_flags; embed_c[2] = inst->module; embed_c[3] = arg; argc = 4; } else { embed_c[1] = inst->module; embed_c[2] = arg; argc = 3; } /* * Create tweak the server's environment to support * perl. Docs say only call this once... Oops. */ if (!perl_sys_init3_called) { PERL_SYS_INIT3(&argc, &embed, &envp); perl_sys_init3_called = 1; } /* * Allocate a new perl interpreter to do the parsing */ if ((inst->perl = perl_alloc()) == NULL) { ERROR("No memory for allocating new perl interpretor!"); return -1; } perl_construct(inst->perl); /* ...and initialise it */ #ifdef USE_ITHREADS PL_perl_destruct_level = 2; { dTHXa(inst->perl); } PERL_SET_CONTEXT(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); end_AV = PL_endav; PL_endav = (AV *)NULL; if (exitstatus) { ERROR("Perl_parse failed: %s not found or has syntax errors", inst->module); return -1; } /* parse perl configuration sub-section */ cs = cf_section_find(conf, "config", NULL); if (cs) { inst->rad_perlconf_hv = get_hv("RAD_PERLCONF", 1); perl_parse_config(cs, 0, inst->rad_perlconf_hv); } inst->perl_parsed = true; perl_run(inst->perl); PL_endav = end_AV; return 0; }
/* * Do any per-module initialization that is separate to each * configured instance of the module. e.g. set up connections * to external databases, read configuration files, set up * dictionary entries, etc. * * If configuration information is given in the config section * that must be referenced in later calls, store a handle to it * in *instance otherwise put a null pointer there. * * Setup a hashes wich we will use later * parse a module and give him a chance to live * */ static int mod_instantiate(CONF_SECTION *conf, void *instance) { rlm_perl_t *inst = instance; AV *end_AV; char const **embed_c; /* Stupid Perl and lack of const consistency */ char **embed; char **envp = NULL; char const *xlat_name; int exitstatus = 0, argc=0; MEM(embed_c = talloc_zero_array(inst, char const *, 4)); memcpy(&embed, &embed_c, sizeof(embed)); /* * Create pthread key. This key will be stored in instance */ #ifdef USE_ITHREADS pthread_mutex_init(&inst->clone_mutex, NULL); inst->thread_key = rad_malloc(sizeof(*inst->thread_key)); memset(inst->thread_key,0,sizeof(*inst->thread_key)); rlm_perl_make_key(inst->thread_key); #endif char arg[] = "0"; embed_c[0] = NULL; if (inst->perl_flags) { embed_c[1] = inst->perl_flags; embed_c[2] = inst->module; embed_c[3] = arg; argc = 4; } else { embed_c[1] = inst->module; embed_c[2] = arg; argc = 3; } PERL_SYS_INIT3(&argc, &embed, &envp); if ((inst->perl = perl_alloc()) == NULL) { ERROR("rlm_perl: No memory for allocating new perl !"); return (-1); } perl_construct(inst->perl); #ifdef USE_ITHREADS PL_perl_destruct_level = 2; { dTHXa(inst->perl); } PERL_SET_CONTEXT(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); end_AV = PL_endav; PL_endav = Nullav; if(!exitstatus) { perl_run(inst->perl); } else { ERROR("rlm_perl: perl_parse failed: %s not found or has syntax errors. \n", inst->module); return (-1); } PL_endav = end_AV; xlat_name = cf_section_name2(conf); if (!xlat_name) xlat_name = cf_section_name1(conf); if (xlat_name) { xlat_register(xlat_name, perl_xlat, NULL, inst); } /* parse perl configuration sub-section */ CONF_SECTION *cs; cs = cf_section_sub_find(conf, "config"); if (cs) { DEBUG("rlm_perl (%s): parsing 'config' section...", xlat_name); inst->rad_perlconf_hv = get_hv("RAD_PERLCONF",1); perl_parse_config(cs, 0, inst->rad_perlconf_hv); DEBUG("rlm_perl (%s): done parsing 'config'.", xlat_name); } return 0; }
/* * Do any per-module initialization that is separate to each * configured instance of the module. e.g. set up connections * to external databases, read configuration files, set up * dictionary entries, etc. * * If configuration information is given in the config section * that must be referenced in later calls, store a handle to it * in *instance otherwise put a null pointer there. * * Boyan: * Setup a hashes wich we will use later * parse a module and give him a chance to live * */ static int mod_instantiate(CONF_SECTION *conf, void *instance) { rlm_perl_t *inst = instance; AV *end_AV; char **embed; char **envp = NULL; char const *xlat_name; int exitstatus = 0, argc=0; MEM(embed = talloc_zero_array(inst, char *, 4)); /* * Create pthread key. This key will be stored in instance */ #ifdef USE_ITHREADS pthread_mutex_init(&inst->clone_mutex, NULL); inst->thread_key = rad_malloc(sizeof(*inst->thread_key)); memset(inst->thread_key,0,sizeof(*inst->thread_key)); rlm_perl_make_key(inst->thread_key); #endif char arg[] = "0"; embed[0] = NULL; if (inst->perl_flags) { embed[1] = inst->perl_flags; embed[2] = inst->module; embed[3] = arg; argc = 4; } else { embed[1] = inst->module; embed[2] = arg; argc = 3; } PERL_SYS_INIT3(&argc, &embed, &envp); if ((inst->perl = perl_alloc()) == NULL) { ERROR("rlm_perl: No memory for allocating new perl !"); return (-1); } perl_construct(inst->perl); #ifdef USE_ITHREADS PL_perl_destruct_level = 2; { dTHXa(inst->perl); } PERL_SET_CONTEXT(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); end_AV = PL_endav; PL_endav = Nullav; if(!exitstatus) { perl_run(inst->perl); } else { ERROR("rlm_perl: perl_parse failed: %s not found or has syntax errors. \n", inst->module); return (-1); } PL_endav = end_AV; xlat_name = cf_section_name2(conf); if (!xlat_name) xlat_name = cf_section_name1(conf); if (xlat_name) { xlat_register(xlat_name, perl_xlat, NULL, inst); } return 0; }
/* * Do any per-module initialization that is separate to each * configured instance of the module. e.g. set up connections * to external databases, read configuration files, set up * dictionary entries, etc. * * If configuration information is given in the config section * that must be referenced in later calls, store a handle to it * in *instance otherwise put a null pointer there. * * Boyan: * Setup a hashes wich we will use later * parse a module and give him a chance to live * */ static int perl_instantiate(CONF_SECTION *conf, void **instance) { PERL_INST *inst = (PERL_INST *) instance; HV *rad_reply_hv; HV *rad_check_hv; HV *rad_config_hv; HV *rad_request_hv; #ifdef WITH_PROXY HV *rad_request_proxy_hv; HV *rad_request_proxy_reply_hv; #endif AV *end_AV; char **embed; char **envp = NULL; const char *xlat_name; int exitstatus = 0, argc=0; embed = rad_malloc(4 * sizeof(char *)); memset(embed, 0, 4 *sizeof(char *)); /* * Set up a storage area for instance data */ inst = rad_malloc(sizeof(PERL_INST)); memset(inst, 0, sizeof(PERL_INST)); /* * If the configuration parameters can't be parsed, then * fail. */ if (cf_section_parse(conf, inst, module_config) < 0) { free(embed); free(inst); return -1; } /* * Create pthread key. This key will be stored in instance */ #ifdef USE_ITHREADS pthread_mutex_init(&inst->clone_mutex, NULL); inst->thread_key = rad_malloc(sizeof(*inst->thread_key)); memset(inst->thread_key,0,sizeof(*inst->thread_key)); rlm_perl_make_key(inst->thread_key); #endif char arg[] = "0"; embed[0] = NULL; if (inst->perl_flags) { embed[1] = inst->perl_flags; embed[2] = inst->module; embed[3] = arg; argc = 4; } else { embed[1] = inst->module; embed[2] = arg; argc = 3; } PERL_SYS_INIT3(&argc, &embed, &envp); #ifdef USE_ITHREADS if ((inst->perl = perl_alloc()) == NULL) { radlog(L_DBG, "rlm_perl: No memory for allocating new perl !"); free(embed); free(inst); return (-1); } perl_construct(inst->perl); PL_perl_destruct_level = 2; { dTHXa(inst->perl); } PERL_SET_CONTEXT(inst->perl); #else if ((inst->perl = perl_alloc()) == NULL) { radlog(L_ERR, "rlm_perl: No memory for allocating new perl !"); free(embed); free(inst); 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); end_AV = PL_endav; PL_endav = Nullav; newXS("radiusd::radlog",XS_radiusd_radlog, "rlm_perl"); if(!exitstatus) { exitstatus = perl_run(inst->perl); } else { radlog(L_ERR,"rlm_perl: perl_parse failed: %s not found or has syntax errors. \n", inst->module); free(embed); free(inst); return (-1); } PL_endav = end_AV; rad_reply_hv = newHV(); rad_check_hv = newHV(); rad_config_hv = newHV(); rad_request_hv = newHV(); #ifdef WITH_PROXY rad_request_proxy_hv = newHV(); rad_request_proxy_reply_hv = newHV(); #endif rad_reply_hv = get_hv("RAD_REPLY",1); rad_check_hv = get_hv("RAD_CHECK",1); rad_config_hv = get_hv("RAD_CONFIG",1); rad_request_hv = get_hv("RAD_REQUEST",1); #ifdef WITH_PROXY rad_request_proxy_hv = get_hv("RAD_REQUEST_PROXY",1); rad_request_proxy_reply_hv = get_hv("RAD_REQUEST_PROXY_REPLY",1); #endif xlat_name = cf_section_name2(conf); if (xlat_name == NULL) xlat_name = cf_section_name1(conf); if (xlat_name){ inst->xlat_name = strdup(xlat_name); xlat_register(xlat_name, perl_xlat, inst); } *instance = inst; return 0; }