#include <freeradius-devel/rad_assert.h>
#ifdef INADDR_ANY
-#undef INADDR_ANY
+# undef INADDR_ANY
#endif
#include <EXTERN.h>
#include <perl.h>
char const *xlat_name;
char const *perl_flags;
PerlInterpreter *perl;
- bool perl_parsed;
+ bool perl_parsed;
pthread_key_t *thread_key;
#ifdef USE_ITHREADS
{ "func_start_accounting", FR_CONF_OFFSET(PW_TYPE_STRING, rlm_perl_t, func_start_accounting), NULL },
{ "func_stop_accounting", FR_CONF_OFFSET(PW_TYPE_STRING, rlm_perl_t, func_stop_accounting), NULL },
-
- { NULL, -1, 0, NULL, NULL } /* end the list */
+ CONF_PARSER_TERMINATOR
};
/*
EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
#ifdef USE_ITHREADS
-#define dl_librefs "DynaLoader::dl_librefs"
-#define dl_modules "DynaLoader::dl_modules"
+# define dl_librefs "DynaLoader::dl_librefs"
+# define dl_modules "DynaLoader::dl_modules"
static void rlm_perl_clear_handles(pTHX)
{
AV *librefs = get_av(dl_librefs, false);
handles = (void **)rad_malloc(sizeof(void *) * (AvFILL(librefs)+2));
- for (i=0; i<=AvFILL(librefs); i++) {
+ for (i = 0; i <= AvFILL(librefs); i++) {
void *handle;
SV *handle_sv = *av_fetch(librefs, i, false);
-
- if(!handle_sv) {
- ERROR("Could not fetch $%s[%d]!\n",
- dl_librefs, (int)i);
+ if (!handle_sv) {
+ ERROR("Could not fetch $%s[%d]!", dl_librefs, (int)i);
continue;
}
handle = (void *)SvIV(handle_sv);
- if (handle) {
- handles[i] = handle;
- }
+ if (handle) handles[i] = handle;
}
av_clear(modules);
return;
}
- for (i=0; handles[i]; i++) {
- DEBUG("close %p\n", handles[i]);
+ for (i = 0; handles[i]; i++) {
+ DEBUG("Close %p", handles[i]);
dlclose(handles[i]);
}
* FIXME: This shouldn't happen
*
*/
- while (PL_scopestack_ix > 1 ){
+ while (PL_scopestack_ix > 1) {
LEAVE;
}
{
dTHXa(interp);
}
-#if PERL_REVISION >= 5 && PERL_VERSION <8
+# if PERL_REVISION >= 5 && PERL_VERSION <8
call_pv("CLONE",0);
-#endif
+# endif
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
#endif
/*
- * This is wrapper for radlog
- * Now users can call radiusd::radlog(level,msg) wich is the same
- * calling radlog from C code.
+ * This is wrapper for radlog
+ * Now users can call radiusd::radlog(level,msg) wich is the same
+ * calling radlog from C code.
*/
static XS(XS_radiusd_radlog)
{
}
/*
- * The xlat function
+ * The xlat function
*/
static ssize_t perl_xlat(void *instance, REQUEST *request, char const *fmt, char *out, size_t freespace)
{
DEBUG("%*s}", indent_section, " ");
}
+static int mod_bootstrap(CONF_SECTION *conf, void *instance)
+{
+ rlm_perl_t *inst = instance;
+
+ char const *xlat_name;
+
+ xlat_name = cf_section_name2(conf);
+ if (!xlat_name) xlat_name = cf_section_name1(conf);
+
+ 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
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;
+ char arg[] = "0";
- CONF_SECTION *cs;
-
- MEM(embed_c = talloc_zero_array(inst, char const *, 4));
- memcpy(&embed, &embed_c, sizeof(embed));
+ CONF_SECTION *cs;
#ifdef USE_ITHREADS
/*
rlm_perl_make_key(inst->thread_key);
#endif
- char arg[] = "0";
-
+ /*
+ * 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;
argc = 3;
}
+ /*
+ * Create tweak the server's environment to support
+ * perl. Docs say only call this once... Oops.
+ */
PERL_SYS_INIT3(&argc, &embed, &envp);
+ /*
+ * Allocate a new perl interpreter to do the parsing
+ */
if ((inst->perl = perl_alloc()) == NULL) {
ERROR("rlm_perl: No memory for allocating new perl !");
- return (-1);
+ return -1;
}
-
- perl_construct(inst->perl);
+ perl_construct(inst->perl); /* ...and initialise it */
#ifdef USE_ITHREADS
PL_perl_destruct_level = 2;
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
#endif
- 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);
- }
-
exitstatus = perl_parse(inst->perl, xs_init, argc, embed, NULL);
end_AV = PL_endav;
PL_endav = (AV *)NULL;
if (exitstatus) {
- ERROR("rlm_perl: perl_parse failed: %s not found or has syntax errors. \n", inst->module);
+ ERROR("rlm_perl: perl_parse failed: %s not found or has syntax errors", inst->module);
return -1;
}
/* parse perl configuration sub-section */
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);
+ 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);
}
inst->perl_parsed = true;
vp_cursor_t cursor;
RINDENT();
- pairsort(vps, attrtagcmp);
+ fr_pair_list_sort(vps, fr_pair_cmp_by_da_tag);
for (vp = fr_cursor_init(&cursor, vps);
vp;
vp = fr_cursor_next(&cursor)) {
if (SvOK(sv)) {
STRLEN len;
val = SvPV(sv, len);
- vp = pairmake(ctx, vps, key, NULL, op);
+ vp = fr_pair_make(ctx, vps, key, NULL, op);
if (!vp) {
fail:
REDEBUG("Failed to create pair %s:%s %s %s", list_name, key,
switch (vp->da->type) {
case PW_TYPE_STRING:
- pairbstrncpy(vp, val, len);
+ fr_pair_value_bstrncpy(vp, val, len);
break;
default:
- if (pairparsevalue(vp, val, len) < 0) goto fail;
+ if (fr_pair_value_from_str(vp, val, len) < 0) goto fail;
}
RDEBUG("&%s:%s %s $%s{'%s'} -> '%s'", list_name, key, fr_int2str(fr_tokens, op, "<INVALID>"),
HV *rad_check_hv;
HV *rad_config_hv;
HV *rad_request_hv;
+ HV *rad_state_hv;
#ifdef WITH_PROXY
HV *rad_request_proxy_hv;
HV *rad_request_proxy_reply_hv;
rad_check_hv = get_hv("RAD_CHECK", 1);
rad_config_hv = get_hv("RAD_CONFIG", 1);
rad_request_hv = get_hv("RAD_REQUEST", 1);
+ rad_state_hv = get_hv("RAD_STATE", 1);
perl_store_vps(request->packet, request, &request->packet->vps, rad_request_hv, "RAD_REQUEST", "request");
perl_store_vps(request->reply, request, &request->reply->vps, rad_reply_hv, "RAD_REPLY", "reply");
perl_store_vps(request, request, &request->config, rad_check_hv, "RAD_CHECK", "control");
perl_store_vps(request, request, &request->config, rad_config_hv, "RAD_CONFIG", "control");
+ perl_store_vps(request, request, &request->state, rad_state_hv, "RAD_STATE", "session-state");
#ifdef WITH_PROXY
rad_request_proxy_hv = get_hv("RAD_REQUEST_PROXY",1);
SPAGAIN;
if (SvTRUE(ERRSV)) {
- ERROR("rlm_perl: perl_embed:: module = %s , func = %s exit status= %s\n",
- inst->module,
- function_name, SvPV(ERRSV,n_a));
+ RDEBUG("perl_embed:: module = %s , func = %s exit status= %s\n",
+ inst->module, function_name, SvPV(ERRSV,n_a));
(void)POPs;
}
vp = NULL;
if ((get_hv_content(request->packet, request, rad_request_hv, &vp, "RAD_REQUEST", "request")) == 0) {
- pairfree(&request->packet->vps);
+ fr_pair_list_free(&request->packet->vps);
request->packet->vps = vp;
vp = NULL;
/*
* Update cached copies
*/
- request->username = pairfind(request->packet->vps, PW_USER_NAME, 0, TAG_ANY);
- request->password = pairfind(request->packet->vps, PW_USER_PASSWORD, 0, TAG_ANY);
+ request->username = fr_pair_find_by_num(request->packet->vps, PW_USER_NAME, 0, TAG_ANY);
+ request->password = fr_pair_find_by_num(request->packet->vps, PW_USER_PASSWORD, 0, TAG_ANY);
if (!request->password)
- request->password = pairfind(request->packet->vps, PW_CHAP_PASSWORD, 0, TAG_ANY);
+ request->password = fr_pair_find_by_num(request->packet->vps, PW_CHAP_PASSWORD, 0, TAG_ANY);
}
if ((get_hv_content(request->reply, request, rad_reply_hv, &vp, "RAD_REPLY", "reply")) == 0) {
- pairfree(&request->reply->vps);
+ fr_pair_list_free(&request->reply->vps);
request->reply->vps = vp;
vp = NULL;
}
if ((get_hv_content(request, request, rad_check_hv, &vp, "RAD_CHECK", "control")) == 0) {
- pairfree(&request->config);
+ fr_pair_list_free(&request->config);
request->config = vp;
vp = NULL;
}
+ if ((get_hv_content(request, request, rad_state_hv, &vp, "RAD_STATE", "session-state")) == 0) {
+ fr_pair_list_free(&request->state);
+ request->state = vp;
+ vp = NULL;
+ }
+
#ifdef WITH_PROXY
if (request->proxy &&
(get_hv_content(request->proxy, request, rad_request_proxy_hv, &vp,
"RAD_REQUEST_PROXY", "proxy-request") == 0)) {
- pairfree(&request->proxy->vps);
+ fr_pair_list_free(&request->proxy->vps);
request->proxy->vps = vp;
vp = NULL;
}
if (request->proxy_reply &&
(get_hv_content(request->proxy_reply, request, rad_request_proxy_reply_hv, &vp,
"RAD_REQUEST_PROXY_REPLY", "proxy-reply") == 0)) {
- pairfree(&request->proxy_reply->vps);
+ fr_pair_list_free(&request->proxy_reply->vps);
request->proxy_reply->vps = vp;
vp = NULL;
}
VALUE_PAIR *pair;
int acctstatustype=0;
- if ((pair = pairfind(request->packet->vps, PW_ACCT_STATUS_TYPE, 0, TAG_ANY)) != NULL) {
+ if ((pair = fr_pair_find_by_num(request->packet->vps, PW_ACCT_STATUS_TYPE, 0, TAG_ANY)) != NULL) {
acctstatustype = pair->vp_integer;
} else {
- ERROR("Invalid Accounting Packet");
+ RDEBUG("Invalid Accounting Packet");
return RLM_MODULE_INVALID;
}
rlm_perl_t *inst = (rlm_perl_t *) instance;
int exitstatus = 0, count = 0;
- if (inst->rad_perlconf_hv != NULL) {
- hv_undef(inst->rad_perlconf_hv);
- }
-
-#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->rad_perlconf_hv != NULL) hv_undef(inst->rad_perlconf_hv);
if (inst->perl_parsed && inst->func_detach) {
dTHXa(inst->perl);
*/
extern module_t rlm_perl;
module_t rlm_perl = {
- RLM_MODULE_INIT,
- "perl", /* Name */
+ .magic = RLM_MODULE_INIT,
+ .name = "perl",
#ifdef USE_ITHREADS
- RLM_TYPE_THREAD_SAFE, /* type */
+ .type = RLM_TYPE_THREAD_SAFE,
#else
- RLM_TYPE_THREAD_UNSAFE,
+ .type = RLM_TYPE_THREAD_UNSAFE,
#endif
- sizeof(rlm_perl_t),
- module_config,
- mod_instantiate, /* instantiation */
- mod_detach, /* detach */
- {
- mod_authenticate, /* authenticate */
- mod_authorize, /* authorize */
- mod_preacct, /* preacct */
- mod_accounting, /* accounting */
- mod_checksimul, /* check simul */
+ .inst_size = sizeof(rlm_perl_t),
+ .config = module_config,
+ .bootstrap = mod_bootstrap,
+ .instantiate = mod_instantiate,
+ .detach = mod_detach,
+ .methods = {
+ [MOD_AUTHENTICATE] = mod_authenticate,
+ [MOD_AUTHORIZE] = mod_authorize,
+ [MOD_PREACCT] = mod_preacct,
+ [MOD_ACCOUNTING] = mod_accounting,
+ [MOD_SESSION] = mod_checksimul,
#ifdef WITH_PROXY
- mod_pre_proxy, /* pre-proxy */
- mod_post_proxy, /* post-proxy */
-#else
- NULL, NULL,
+ [MOD_PRE_PROXY] = mod_pre_proxy,
+ [MOD_POST_PROXY] = mod_post_proxy,
#endif
- mod_post_auth /* post-auth */
+ [MOD_POST_AUTH] = mod_post_auth,
#ifdef WITH_COA
- , mod_recv_coa,
- mod_send_coa
+ [MOD_RECV_COA] = mod_recv_coa,
+ [MOD_SEND_COA] = mod_send_coa
#endif
},
};
projects / freeradius.git / blobdiff