/* * The xlat function */ static ssize_t perl_xlat(void *instance, REQUEST *request, char const *fmt, char *out, size_t freespace) { rlm_perl_t *inst= (rlm_perl_t *) instance; char *tmp; char const *p, *q; int count; size_t ret = 0; STRLEN n_a; #ifdef USE_ITHREADS PerlInterpreter *interp; pthread_mutex_lock(&inst->clone_mutex); interp = rlm_perl_clone(inst->perl, inst->thread_key); { dTHXa(interp); PERL_SET_CONTEXT(interp); } pthread_mutex_unlock(&inst->clone_mutex); #else PERL_SET_CONTEXT(inst->perl); #endif { dSP; ENTER;SAVETMPS; PUSHMARK(SP); p = fmt; while ((q = strchr(p, ' '))) { XPUSHs(sv_2mortal(newSVpv(p, p - q))); p = q + 1; } PUTBACK; count = call_pv(inst->func_xlat, G_SCALAR | G_EVAL); SPAGAIN; if (SvTRUE(ERRSV)) { REDEBUG("Exit %s", SvPV(ERRSV,n_a)); (void)POPs; } else if (count > 0) { tmp = POPp; strlcpy(out, tmp, freespace); ret = strlen(out); RDEBUG("Len is %zu , out is %s freespace is %zu", ret, out, freespace); } PUTBACK ; FREETMPS ; LEAVE ; } return ret; }
static POOL_HANDLE *pool_grow (PERL_INST *inst) { POOL_HANDLE *handle; time_t now; if (inst->perl_pool->max_clones == inst->perl_pool->current_clones) { return NULL; } if (inst->perl_pool->detach == yes ) { return NULL; } handle = (POOL_HANDLE *)rad_malloc(sizeof(POOL_HANDLE)); if (!handle) { radlog(L_ERR,"Could not find free memory for pool. Aborting"); return NULL; } handle->prev = NULL; handle->next = NULL; handle->status = idle; handle->clone = rlm_perl_clone(inst->perl); handle->request_count = 0; MUTEX_INIT(&handle->lock); inst->perl_pool->current_clones++; move2tail(handle, inst); now = time(NULL); inst->perl_pool->time_when_last_added = now; return handle; }
/* * Call the function_name inside the module * Store all vps in hashes %RAD_CONFIG %RAD_REPLY %RAD_REQUEST * */ static int do_perl(void *instance, REQUEST *request, char const *function_name) { rlm_perl_t *inst = instance; VALUE_PAIR *vp; int exitstatus=0, count; STRLEN n_a; HV *rad_reply_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; #endif /* * Radius has told us to call this function, but none * is defined. */ if (!function_name) return RLM_MODULE_FAIL; #ifdef USE_ITHREADS pthread_mutex_lock(&inst->clone_mutex); PerlInterpreter *interp; interp = rlm_perl_clone(inst->perl,inst->thread_key); { dTHXa(interp); PERL_SET_CONTEXT(interp); } pthread_mutex_unlock(&inst->clone_mutex); #else PERL_SET_CONTEXT(inst->perl); #endif { dSP; ENTER; SAVETMPS; rad_reply_hv = get_hv("RAD_REPLY", 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->control, rad_config_hv, "RAD_CONFIG", "control"); perl_store_vps(request->state_ctx, request, &request->state, rad_state_hv, "RAD_STATE", "session-state"); #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); if (request->proxy) { perl_store_vps(request->proxy->packet, request, &request->proxy->packet->vps, rad_request_proxy_hv, "RAD_REQUEST_PROXY", "proxy-request"); } else { hv_undef(rad_request_proxy_hv); } if (request->proxy && request->proxy->reply != NULL) { perl_store_vps(request->proxy->reply, request, &request->proxy->reply->vps, rad_request_proxy_reply_hv, "RAD_REQUEST_PROXY_REPLY", "proxy-reply"); } else { hv_undef(rad_request_proxy_reply_hv); } #endif /* * Store pointer to request structure globally so radiusd::xlat works */ rlm_perl_request = request; PUSHMARK(SP); /* * This way %RAD_xx can be pushed onto stack as sub parameters. * XPUSHs( newRV_noinc((SV *)rad_request_hv) ); * XPUSHs( newRV_noinc((SV *)rad_reply_hv) ); * XPUSHs( newRV_noinc((SV *)rad_config_hv) ); * PUTBACK; */ count = call_pv(function_name, G_SCALAR | G_EVAL | G_NOARGS); SPAGAIN; if (SvTRUE(ERRSV)) { REDEBUG("perl_embed:: module = %s , func = %s exit status= %s\n", inst->module, function_name, SvPV(ERRSV,n_a)); (void)POPs; exitstatus = RLM_MODULE_FAIL; } else if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; vp = NULL; if ((get_hv_content(request->packet, request, rad_request_hv, &vp, "RAD_REQUEST", "request")) == 0) { fr_pair_list_free(&request->packet->vps); request->packet->vps = vp; vp = NULL; /* * Update cached copies */ request->username = fr_pair_find_by_da(request->packet->vps, attr_user_name, TAG_ANY); request->password = fr_pair_find_by_da(request->packet->vps, attr_user_password, TAG_ANY); if (!request->password) request->password = fr_pair_find_by_da(request->packet->vps, attr_chap_password, TAG_ANY); } if ((get_hv_content(request->reply, request, rad_reply_hv, &vp, "RAD_REPLY", "reply")) == 0) { fr_pair_list_free(&request->reply->vps); request->reply->vps = vp; vp = NULL; } if ((get_hv_content(request, request, rad_config_hv, &vp, "RAD_CONFIG", "control")) == 0) { fr_pair_list_free(&request->control); request->control = vp; vp = NULL; } if ((get_hv_content(request->state_ctx, 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->packet, request, rad_request_proxy_hv, &vp, "RAD_REQUEST_PROXY", "proxy-request") == 0)) { fr_pair_list_free(&request->proxy->packet->vps); request->proxy->packet->vps = vp; vp = NULL; } if (request->proxy && request->proxy->reply && (get_hv_content(request->proxy->reply, request, rad_request_proxy_reply_hv, &vp, "RAD_REQUEST_PROXY_REPLY", "proxy-reply") == 0)) { fr_pair_list_free(&request->proxy->reply->vps); request->proxy->reply->vps = vp; vp = NULL; } #endif } return exitstatus; }
/* * The xlat function */ static ssize_t perl_xlat(UNUSED TALLOC_CTX *ctx, char **out, size_t outlen, void const *mod_inst, UNUSED void const *xlat_inst, REQUEST *request, char const *fmt) { rlm_perl_t *inst; char *tmp; char const *p, *q; int count; size_t ret = 0; STRLEN n_a; memcpy(&inst, &mod_inst, sizeof(inst)); #ifdef USE_ITHREADS PerlInterpreter *interp; pthread_mutex_lock(&inst->clone_mutex); interp = rlm_perl_clone(inst->perl, inst->thread_key); { dTHXa(interp); PERL_SET_CONTEXT(interp); } pthread_mutex_unlock(&inst->clone_mutex); #else PERL_SET_CONTEXT(inst->perl); #endif { dSP; ENTER;SAVETMPS; PUSHMARK(SP); p = q = fmt; while (*p == ' ') { p++; q++; } while (*q) { if (*q == ' ') { XPUSHs(sv_2mortal(newSVpvn(p, q - p))); p = q + 1; /* * Don't use an empty string */ while (*p == ' ') p++; q = p; } q++; } /* * And the last bit. */ if (*p) { XPUSHs(sv_2mortal(newSVpvn(p, strlen(p)))); } PUTBACK; count = call_pv(inst->func_xlat, G_SCALAR | G_EVAL); SPAGAIN; if (SvTRUE(ERRSV)) { REDEBUG("Exit %s", SvPV(ERRSV,n_a)); (void)POPs; } else if (count > 0) { tmp = POPp; strlcpy(*out, tmp, outlen); ret = strlen(*out); RDEBUG2("Len is %zu , out is %s freespace is %zu", ret, *out, outlen); } PUTBACK ; FREETMPS ; LEAVE ; } return ret; }
/* * Call the function_name inside the module * Store all vps in hashes %RAD_CHECK %RAD_REPLY %RAD_REQUEST * */ static int do_perl(void *instance, REQUEST *request, char *function_name) { rlm_perl_t *inst = instance; VALUE_PAIR *vp; int exitstatus=0, count; STRLEN n_a; 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 /* * Radius has told us to call this function, but none * is defined. */ if (!function_name) return RLM_MODULE_FAIL; #ifdef USE_ITHREADS pthread_mutex_lock(&inst->clone_mutex); PerlInterpreter *interp; interp = rlm_perl_clone(inst->perl,inst->thread_key); { dTHXa(interp); PERL_SET_CONTEXT(interp); } pthread_mutex_unlock(&inst->clone_mutex); #else PERL_SET_CONTEXT(inst->perl); #endif { dSP; ENTER; SAVETMPS; 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); perl_store_vps(request->reply, request->reply->vps, rad_reply_hv); perl_store_vps(request, request->config_items, rad_check_hv); perl_store_vps(request->packet, request->packet->vps, rad_request_hv); perl_store_vps(request, request->config_items, rad_config_hv); #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); if (request->proxy != NULL) { perl_store_vps(request->proxy, request->proxy->vps, rad_request_proxy_hv); } else { hv_undef(rad_request_proxy_hv); } if (request->proxy_reply !=NULL) { perl_store_vps(request->proxy_reply, request->proxy_reply->vps, rad_request_proxy_reply_hv); } else { hv_undef(rad_request_proxy_reply_hv); } #endif PUSHMARK(SP); /* * This way %RAD_xx can be pushed onto stack as sub parameters. * XPUSHs( newRV_noinc((SV *)rad_request_hv) ); * XPUSHs( newRV_noinc((SV *)rad_reply_hv) ); * XPUSHs( newRV_noinc((SV *)rad_check_hv) ); * PUTBACK; */ count = call_pv(function_name, G_SCALAR | G_EVAL | G_NOARGS); 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)); (void)POPs; } if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; vp = NULL; if ((get_hv_content(request->packet, rad_request_hv, &vp)) > 0 ) { pairfree(&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); if (!request->password) request->password = pairfind(request->packet->vps, PW_CHAP_PASSWORD, 0, TAG_ANY); } if ((get_hv_content(request->reply, rad_reply_hv, &vp)) > 0 ) { pairfree(&request->reply->vps); request->reply->vps = vp; vp = NULL; } if ((get_hv_content(request, rad_check_hv, &vp)) > 0 ) { pairfree(&request->config_items); request->config_items = vp; vp = NULL; } #ifdef WITH_PROXY if (request->proxy && (get_hv_content(request->proxy, rad_request_proxy_hv, &vp) > 0)) { pairfree(&request->proxy->vps); request->proxy->vps = vp; vp = NULL; } if (request->proxy_reply && (get_hv_content(request->proxy_reply, rad_request_proxy_reply_hv, &vp) > 0)) { pairfree(&request->proxy_reply->vps); request->proxy_reply->vps = vp; vp = NULL; } #endif } return exitstatus; }
/* * The xlat function */ static size_t perl_xlat(void *instance, REQUEST *request, const char *fmt, char *out, size_t freespace) { PERL_INST *inst= (PERL_INST *) instance; PerlInterpreter *perl; char params[1024], *ptr, *tmp; int count; size_t ret = 0; STRLEN n_a; /* * Do an xlat on the provided string (nice recursive operation). */ if (!radius_xlat(params, sizeof(params), fmt, request, NULL, NULL)) { radlog(L_ERR, "rlm_perl: xlat failed."); return 0; } #ifndef WITH_ITHREADS perl = inst->perl; #else perl = rlm_perl_clone(inst->perl,inst->thread_key); { dTHXa(perl); } #endif PERL_SET_CONTEXT(perl); { dSP; ENTER;SAVETMPS; ptr = strtok(params, " "); PUSHMARK(SP); while (ptr != NULL) { XPUSHs(sv_2mortal(newSVpv(ptr,0))); ptr = strtok(NULL, " "); } PUTBACK; count = call_pv(inst->func_xlat, G_SCALAR | G_EVAL); SPAGAIN; if (SvTRUE(ERRSV)) { radlog(L_ERR, "rlm_perl: perl_xlat exit %s\n", SvPV(ERRSV,n_a)); (void)POPs; } else if (count > 0) { tmp = POPp; strlcpy(out, tmp, freespace); ret = strlen(out); radlog(L_DBG,"rlm_perl: Len is %zu , out is %s freespace is %zu", ret, out, freespace); } PUTBACK ; FREETMPS ; LEAVE ; } return ret; }
/* * Call the function_name inside the module * Store all vps in hashes %RAD_CHECK %RAD_REPLY %RAD_REQUEST * */ static int do_perl(void *instance, REQUEST *request, char const *function_name) { rlm_perl_t *inst = instance; VALUE_PAIR *vp; int exitstatus=0, count; STRLEN n_a; HV *rad_reply_hv; 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; #endif SV *rad_requestp_sv; /* * Radius has told us to call this function, but none * is defined. */ if (!function_name) return RLM_MODULE_FAIL; #ifdef USE_ITHREADS pthread_mutex_lock(&inst->clone_mutex); PerlInterpreter *interp; interp = rlm_perl_clone(inst->perl,inst->thread_key); { dTHXa(interp); PERL_SET_CONTEXT(interp); } pthread_mutex_unlock(&inst->clone_mutex); #else PERL_SET_CONTEXT(inst->perl); #endif { dSP; ENTER; SAVETMPS; 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); rad_state_hv = get_hv("RAD_STATE", 1); rad_requestp_sv = get_sv("RAD___REQUESTP", 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->state_ctx, request, &request->state, rad_state_hv, "RAD_STATE", "session-state"); #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); if (request->proxy != NULL) { perl_store_vps(request->proxy, request, &request->proxy->vps, rad_request_proxy_hv, "RAD_REQUEST_PROXY", "proxy-request"); } else { hv_undef(rad_request_proxy_hv); } if (request->proxy_reply != NULL) { perl_store_vps(request->proxy_reply, request, &request->proxy_reply->vps, rad_request_proxy_reply_hv, "RAD_REQUEST_PROXY_REPLY", "proxy-reply"); } else { hv_undef(rad_request_proxy_reply_hv); } #endif /* * Store pointer to request structure globally so xlat works * We mark it read-only for interpreter so end users will not be * in posession to change it and crash radiusd with bogus pointer */ SvREADONLY_off(rad_requestp_sv); sv_setiv(rad_requestp_sv, PTR2IV(request)); SvREADONLY_on(rad_requestp_sv); PUSHMARK(SP); /* * This way %RAD_xx can be pushed onto stack as sub parameters. * XPUSHs( newRV_noinc((SV *)rad_request_hv) ); * XPUSHs( newRV_noinc((SV *)rad_reply_hv) ); * XPUSHs( newRV_noinc((SV *)rad_check_hv) ); * PUTBACK; */ count = call_pv(function_name, G_SCALAR | G_EVAL | G_NOARGS); SPAGAIN; if (SvTRUE(ERRSV)) { RDEBUG("perl_embed:: module = %s , func = %s exit status= %s\n", inst->module, function_name, SvPV(ERRSV,n_a)); (void)POPs; count = 0; exitstatus = RLM_MODULE_FAIL; } if (count == 1) { exitstatus = POPi; if (exitstatus >= 100 || exitstatus < 0) { exitstatus = RLM_MODULE_FAIL; } } PUTBACK; FREETMPS; LEAVE; vp = NULL; get_hv_content(request->packet, request, rad_request_hv, &vp, "RAD_REQUEST", "request"); if (vp) { fr_pair_list_free(&request->packet->vps); request->packet->vps = vp; vp = NULL; /* * Update cached copies */ 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 = fr_pair_find_by_num(request->packet->vps, PW_CHAP_PASSWORD, 0, TAG_ANY); } get_hv_content(request->reply, request, rad_reply_hv, &vp, "RAD_REPLY", "reply"); if (vp) { fr_pair_list_free(&request->reply->vps); request->reply->vps = vp; vp = NULL; } get_hv_content(request, request, rad_check_hv, &vp, "RAD_CHECK", "control"); if (vp) { fr_pair_list_free(&request->config); request->config = vp; vp = NULL; } get_hv_content(request->state_ctx, request, rad_state_hv, &vp, "RAD_STATE", "session-state"); if (vp) { 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"); if (vp) { 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"); if (vp) { fr_pair_list_free(&request->proxy_reply->vps); request->proxy_reply->vps = vp; vp = NULL; } } #endif } return exitstatus; }