/*
* 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;
}