25RCSID(
"$Id: bdc32e5faae45a8bb3d58c3fabf64b1486629fef $")
27#define LOG_PREFIX "perl"
29#include <freeradius-devel/server/base.h>
30#include <freeradius-devel/server/module_rlm.h>
31#include <freeradius-devel/util/debug.h>
32#include <freeradius-devel/unlang/xlat_func.h>
33#include <freeradius-devel/unlang/xlat.h>
34#include <freeradius-devel/radius/radius.h>
49#if defined(__APPLE__) || defined(__FreeBSD__)
54# error perl must be compiled with USE_ITHREADS
138 ret = strcmp(a->
name1, b->name1);
139 if (ret != 0)
return CMP(ret, 0);
140 if (!a->
name2 && !b->name2)
return 0;
141 if (!a->
name2 || !b->name2)
return a->
name2 ? 1 : -1;
142 ret = strcmp(a->
name2, b->name2);
153# define dl_librefs "DynaLoader::dl_librefs"
154# define dl_modules "DynaLoader::dl_modules"
170 if (!librefs)
return NULL;
172 if (!(AvFILL(librefs) >= 0)) {
176 MEM(handles = talloc_array(NULL,
void *, AvFILL(librefs) + 2));
177 for (i = 0; i <= AvFILL(librefs); i++) {
179 SV *handle_sv = *av_fetch(librefs, i,
false);
184 handle = (
void *)SvIV(handle_sv);
186 if (handle) handles[i] = handle;
192 handles[i] = (
void *)0;
205 for (i = 0; handles[i]; i++) {
206 DEBUG(
"Close %p", handles[i]);
218static XS(XS_freeradius_log)
222 croak(
"Usage: radiusd::log(level, message)");
227 level = (int) SvIV(ST(0));
228 msg = (
char *) SvPV(ST(1), PL_na);
246static XS(XS_freeradius_xlat)
254 if (items != 1) croak(
"Usage: radiusd::xlat(string)");
258 in_str = (
char *) SvPV(ST(0), PL_na);
260 slen =
xlat_aeval(request, &expanded, request, in_str, NULL, NULL);
262 REDEBUG(
"Error parsing xlat '%s'", in_str);
266 XST_mPV(0, expanded);
285 if (!da) croak(
"Unknown or invalid attribute name \"%s\"", attr);
293#define GET_PAIR_MAGIC(count) MAGIC *mg = mg_findext(ST(0), PERL_MAGIC_ext, &rlm_perl_vtbl); \
294 fr_perl_pair_t *pair_data; \
295 if (unlikely(items < count)) { \
296 croak("Expected %d stack entries, got %d", count, items); \
300 croak("Failed to find Perl magic value"); \
303 pair_data = (fr_perl_pair_t *)mg->mg_ptr;
323static XS(XS_pairlist_FETCH)
334 attr = (
char *) SvPV(ST(1), len);
340 if (!isdigit(attr[i]))
break;
349 if (!da) XSRETURN_UNDEF;
364 frpair_stash = gv_stashpv(
"freeradiuspairs", GV_ADD);
366 pair_tie = newRV_noinc((SV *)newAV());
367 sv_bless(pair_tie, frpair_stash);
368 sv_magic(MUTABLE_SV(pair_av), MUTABLE_SV((GV *)pair_tie), PERL_MAGIC_tied, NULL, 0);
369 SvREFCNT_dec(pair_tie);
376 sv_magicext((SV *)pair_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&child_pair_data,
sizeof(child_pair_data));
377 ST(0) = sv_2mortal(newRV((SV *)pair_av));
391 frpair_stash = gv_stashpv(
"freeradiuspairlist", GV_ADD);
393 struct_tie = newRV_noinc((SV *)newHV());
394 sv_bless(struct_tie, frpair_stash);
395 hv_magic(struct_hv, (GV *)struct_tie, PERL_MAGIC_tied);
396 SvREFCNT_dec(struct_tie);
404 sv_magicext((SV *)struct_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&child_pair_data,
sizeof(child_pair_data));
405 ST(0) = sv_2mortal(newRV((SV *)struct_hv));
420static XS(XS_pairlist_STORE)
428 attr = (
char *) SvPV(ST(1), PL_na);
430 if (!da) XSRETURN(0);
433 croak(
"Cannot set value of array of \"%s\" values. Use array index to set a specific instance.", da->name);
435 croak(
"Cannot set values of structural object %s", da->name);
446static XS(XS_pairlist_EXISTS)
455 attr = (
char *) SvPV(ST(1), len);
457 if (!isdigit(attr[i]))
break;
465 unsigned int idx = SvIV(ST(1));
466 if (pair_data->parent->vp) {
472 if (!pair_data->vp) XSRETURN_NO;
475 if (!da) XSRETURN_NO;
486static XS(XS_pairlist_FIRSTKEY)
492 if (!pair_data->vp) XSRETURN_EMPTY;
495 ST(0) = sv_2mortal(newSVpv(
vp->
da->name,
vp->
da->name_len));
505static XS(XS_pairlist_NEXTKEY)
511 if (!pair_data->vp) XSRETURN_EMPTY;
514 if (!
vp) XSRETURN_EMPTY;
516 ST(0) = sv_2mortal(newSVpv(
vp->
da->name,
vp->
da->name_len));
526static XS(XS_pairlist_DELETE)
534 attr = SvPV(ST(1), PL_na);
537 if (!da) XSRETURN(0);
538 if (!pair_data->vp) XSRETURN(0);
554 switch(
vp->vp_type) {
556 *
value = sv_2mortal(newSVpvn(
vp->vp_strvalue,
vp->vp_length));
560 *
value = sv_2mortal(newSVpvn((
char const *)
vp->vp_octets,
vp->vp_length));
563#define PERLUINT(_size) case FR_TYPE_UINT ## _size: \
564 *value = sv_2mortal(newSVuv(vp->vp_uint ## _size)); \
571#define PERLINT(_size) case FR_TYPE_INT ## _size: \
572 *value = sv_2mortal(newSViv(vp->vp_int ## _size)); \
580 *
value = sv_2mortal(newSVuv(
vp->vp_bool));
584 *
value = sv_2mortal(newSVnv(
vp->vp_float32));
588 *
value = sv_2mortal(newSVnv(
vp->vp_float64));
607 croak(
"Cannot convert %s to Perl type, insufficient buffer space",
612 *
value = sv_2mortal(newSVpv(
buff, slen));
635static XS(XS_pairs_FETCH)
638 unsigned int idx = SvUV(ST(1));
645 if (!
parent->vp) XSRETURN_UNDEF;
647 if (idx == 0)
vp = pair_data->vp;
649 if (!
vp) XSRETURN_UNDEF;
667 if (pair_data->
idx > 0) {
669 croak(
"Attempt to set instance %d when none exist", pair_data->
idx);
675 if (pair_data->
idx > 0) {
678 if (!
parent->parent->vp)
goto none_exist;
680 if (count < pair_data->idx) {
681 croak(
"Attempt to set instance %d when only %d exist", pair_data->
idx,
count);
699 switch (
vp->vp_type) {
701 val = SvPV(
value, len);
707 val = SvPV(
value, len);
712#define PERLSETUINT(_size) case FR_TYPE_UINT ## _size: \
713 vp->vp_uint ## _size = SvUV(value); \
720#define PERLSETINT(_size) case FR_TYPE_INT ## _size: \
721 vp->vp_int ## _size = SvIV(value); \
738 val = SvPV(
value, len);
740 croak(
"Failed populating pair");
760static XS(XS_pairs_STORE)
763 unsigned int idx = SvUV(ST(1));
771 parent = pair_data->parent;
779 croak(
"Attempting to set instance %d when none exist", idx);
791 croak(
"Attempt to set instance %d when only %d exist", idx,
count);
806static XS(XS_pairs_EXISTS)
809 unsigned int idx = SvUV(ST(1));
816 if (!
parent->vp) XSRETURN_NO;
819 if (
vp) XSRETURN_YES;
826static XS(XS_pairs_DELETE)
829 unsigned int idx = SvUV(ST(1));
836 if (!
parent->vp) XSRETURN(0);
847static XS(XS_pairs_FETCHSIZE)
852 if (!pair_data->parent->vp) XSRETURN_UV(0);
864static XS(XS_pairs_STORESIZE)
867 unsigned int count, req_size = SvUV(ST(1));
875 croak(
"Unable to set attribute instance count");
881 if (req_size >
count) {
882 croak(
"Increasing attribute instance count not supported");
906static XS(XS_pairs_PUSH)
917 parent = pair_data->parent;
934static XS(XS_pairs_POP)
944 parent = pair_data->parent;
945 if (!
parent->vp) XSRETURN(0);
948 if (!
vp) XSRETURN(0);
960static XS(XS_pairs_SHIFT)
970 parent = pair_data->parent;
971 if (!
parent->vp) XSRETURN(0);
974 if (!
vp) XSRETURN(0);
988static XS(XS_pairs_UNSHIFT)
999 parent = pair_data->parent;
1006 croak(
"Failed adding attribute %s", pair_data->da->name);
1017 char const *
file = __FILE__;
1022 newXS(
"freeradius::log",XS_freeradius_log,
"rlm_perl");
1023 newXS(
"freeradius::xlat",XS_freeradius_xlat,
"rlm_perl");
1029 newXS(
"freeradiuspairlist::FETCH", XS_pairlist_FETCH,
"rlm_perl");
1030 newXS(
"freeradiuspairlist::STORE", XS_pairlist_STORE,
"rlm_perl");
1031 newXS(
"freeradiuspairlist::EXISTS", XS_pairlist_EXISTS,
"rlm_perl");
1032 newXS(
"freeradiuspairlist::FIRSTKEY", XS_pairlist_FIRSTKEY,
"rlm_perl");
1033 newXS(
"freeradiuspairlist::NEXTKEY", XS_pairlist_NEXTKEY,
"rlm_perl");
1034 newXS(
"freeradiuspairlist::DELETE", XS_pairlist_DELETE,
"rlm_perl");
1040 newXS(
"freeradiuspairs::FETCH", XS_pairs_FETCH,
"rlm_perl");
1041 newXS(
"freeradiuspairs::STORE", XS_pairs_STORE,
"rlm_perl");
1042 newXS(
"freeradiuspairs::EXISTS", XS_pairs_EXISTS,
"rlm_perl");
1043 newXS(
"freeradiuspairs::DELETE", XS_pairs_DELETE,
"rlm_perl");
1044 newXS(
"freeradiuspairs::FETCHSIZE", XS_pairs_FETCHSIZE,
"rlm_perl");
1045 newXS(
"freeradiuspairs::STORESIZE", XS_pairs_STORESIZE,
"rlm_perl");
1046 newXS(
"freeradiuspairs::PUSH", XS_pairs_PUSH,
"rlm_perl");
1047 newXS(
"freeradiuspairs::POP", XS_pairs_POP,
"rlm_perl");
1048 newXS(
"freeradiuspairs::SHIFT", XS_pairs_SHIFT,
"rlm_perl");
1049 newXS(
"freeradiuspairs::UNSHIFT", XS_pairs_UNSHIFT,
"rlm_perl");
1067 while ((vb = fr_value_box_list_next(
head, vb))) {
1070 sv = newSVpvn(vb->vb_strvalue, vb->vb_length);
1074 sv = newSVpvn((
char const *)vb->vb_octets, vb->vb_length);
1082 sv = newRV_inc((SV *)sub_av);
1091 if (slen < 0)
return -1;
1092 sv = newSVpvn(
buffer, (
size_t)slen);
1097 if (vb->tainted) SvTAINT(sv);
1132 RDEBUG3(
"Reference returned");
1138 vb->vb_int32 = SvIV(sv);
1145 vb->vb_float64 = SvNV(sv);
1151 tmp = SvPVutf8(sv, len);
1155 RPEDEBUG(
"Failed to allocate %ld for output", len);
1166 sv_len = av_len(av);
1167 for (i = 0; i <= sv_len; i++) {
1168 av_sv = av_fetch(av, i, 0);
1182 for (i = hv_iterinit(hv); i > 0; i--) {
1183 hv_sv = hv_iternextsv(hv, &tmp, &sv_len);
1190 RPEDEBUG(
"Failed to allocate %d for output", sv_len);
1193 fr_value_box_list_insert_tail(list, vb);
1211 RPEDEBUG(
"Perl returned unsupported data type %d",
type);
1217 vb->tainted = SvTAINTED(sv);
1218 fr_value_box_list_insert_tail(list, vb);
1246 fr_value_box_list_t list, sub_list;
1249 fr_value_box_list_init(&list);
1250 fr_value_box_list_init(&sub_list);
1254 PERL_SET_CONTEXT(t->
perl);
1271 if (fr_value_box_list_empty(&arg->vb_group))
continue;
1273 if (fr_value_box_list_num_elements(&arg->vb_group) == 1) {
1274 child = fr_value_box_list_head(&arg->vb_group);
1276 switch (child->type) {
1278 if (child->vb_length == 0)
continue;
1280 RDEBUG3(
"Passing single value %pV", child);
1281 sv = newSVpvn(child->vb_strvalue, child->vb_length);
1285 RDEBUG3(
"Ignoring nested group");
1298 RDEBUG3(
"Passing single value %pV", child);
1300 fr_sbuff_set_to_start(sbuff);
1304 if (child->tainted) SvTAINT(sv);
1305 XPUSHs(sv_2mortal(sv));
1314 RDEBUG3(
"Passing list as array %pM", &arg->vb_group);
1315 sv = newRV_inc((SV *)av);
1316 XPUSHs(sv_2mortal(sv));
1321 count = call_pv(func->vb_strvalue, G_ARRAY | G_EVAL);
1324 if (SvTRUE(ERRSV)) {
1325 REDEBUG(
"Exit %s", SvPV(ERRSV,n_a));
1335 for (i = 0; i <
count; i++) {
1338 fr_value_box_list_move_head(&list, &sub_list);
1363 int indent_section = (lvl + 1) * 4;
1364 int indent_item = (lvl + 2) * 4;
1366 if (!cs || !rad_hv)
return;
1384 if (hv_exists(rad_hv, key, strlen(key))) {
1385 WARN(
"Ignoring duplicate config section '%s'", key);
1390 ref = newRV_inc((SV*) sub_hv);
1392 (void)hv_store(rad_hv, key, strlen(key), ref, 0);
1400 if (!key || !
value)
continue;
1406 if (hv_exists(rad_hv, key, strlen(key))) {
1407 WARN(
"Ignoring duplicate config item '%s'", key);
1411 (void)hv_store(rad_hv, key, strlen(key), newSVpvn(
value, strlen(
value)), 0);
1413 DEBUG(
"%*s%s = %s", indent_item,
" ", key,
value);
1417 DEBUG(
"%*s}", indent_section,
" ");
1430 list_tie = newRV_noinc((SV *)newHV());
1431 sv_bless(list_tie, frpair_stash);
1432 hv_magic(list_hv, (GV *)list_tie, PERL_MAGIC_tied);
1433 SvREFCNT_dec(list_tie);
1440 sv_magicext((SV *)list_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&pair_data,
sizeof(pair_data));
1442 (void)hv_store(
parent,
name, strlen(
name), newRV_inc((SV *)list_hv), 0);
1468 PERL_SET_CONTEXT(interp);
1478 frpair_stash = gv_stashpv(
"freeradiuspairlist", GV_ADD);
1481 fr_packet = newHV();
1498 XPUSHs( sv_2mortal(newRV((SV *)fr_packet)) );
1507 if (SvTRUE(ERRSV)) {
1508 REDEBUG(
"perl_embed:: module = %s , func = %s exit status= %s\n",
1512 }
else if (
count == 1) {
1514 if (ret >= 100 || ret < 0) {
1535 PERL_SET_CONTEXT(perl);
1541 PL_perl_destruct_level = 2;
1543 PL_origenviron = environ;
1549 while (PL_scopestack_ix > 1) LEAVE;
1551 perl_destruct(perl);
1561 PerlInterpreter *interp;
1564 PERL_SET_CONTEXT(
inst->perl);
1572 pthread_mutex_lock(&
inst->mutable->mutex);
1573 interp = perl_clone(
inst->perl, clone_flags);
1574 pthread_mutex_unlock(&
inst->mutable->mutex);
1578# if PERL_REVISION >= 5 && PERL_VERSION <8
1579 call_pv(
"CLONE", 0);
1581 ptr_table_free(PL_ptr_table);
1582 PL_ptr_table = NULL;
1584 PERL_SET_CONTEXT(aTHX);
1613 eval_str = talloc_asprintf(NULL,
"(main->can('%s') ? 1 : 0)", func);
1614 val = eval_pv(eval_str, TRUE);
1616 return SvIV(val) ? true :
false;
1644 char const **embed_c;
1646 int ret = 0, argc = 0;
1654 MEM(embed_c = talloc_zero_array(
inst,
char const *, 4));
1655 memcpy(&embed, &embed_c,
sizeof(embed));
1657 if (
inst->perl_flags) {
1658 embed_c[1] =
inst->perl_flags;
1659 embed_c[2] =
inst->module;
1663 embed_c[1] =
inst->module;
1671 if ((
inst->perl = perl_alloc()) == NULL) {
1672 ERROR(
"No memory for allocating new perl interpreter!");
1675 perl_construct(
inst->perl);
1677 PL_perl_destruct_level = 2;
1681 PERL_SET_CONTEXT(
inst->perl);
1683#if PERL_REVISION >= 5 && PERL_VERSION >=8
1684 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1687 ret = perl_parse(
inst->perl,
xs_init, argc, embed, NULL);
1690 PL_endav = (AV *)NULL;
1693 ERROR(
"Perl_parse failed: %s not found or has syntax errors",
inst->module);
1700 inst->rad_perlconf_hv = get_hv(
"RAD_PERLCONF", 1);
1704 inst->perl_parsed =
true;
1705 perl_run(
inst->perl);
1719 pair_name = talloc_asprintf(func,
"func_%s_%s", func->
name1, func->
name2);
1722 if (cp)
goto found_func;
1724 pair_name = talloc_asprintf(func,
"func_%s", func->
name1);
1737 }
else if (func->
name2) {
1758 pthread_mutex_init(&
inst->mutable->mutex, NULL);
1770 int ret = 0,
count = 0;
1773 if (
inst->perl_parsed) {
1775 PERL_SET_CONTEXT(
inst->perl);
1776 if (
inst->rad_perlconf_hv != NULL) hv_undef(
inst->rad_perlconf_hv);
1778 if (
inst->func_detach) {
1779 dSP;
ENTER; SAVETMPS;
1782 count = call_pv(
inst->func_detach, G_SCALAR | G_EVAL );
1787 if (ret >= 100 || ret < 0) {
1816 char const **embed_c;
1821#define LOAD_INFO(_fmt, ...) fr_log(LOG_DST, L_INFO, __FILE__, __LINE__, "rlm_perl - " _fmt, ## __VA_ARGS__)
1822#define LOAD_WARN(_fmt, ...) fr_log_perror(LOG_DST, L_WARN, __FILE__, __LINE__, \
1823 &(fr_log_perror_format_t){ \
1824 .first_prefix = "rlm_perl - ", \
1825 .subsq_prefix = "rlm_perl - ", \
1827 _fmt, ## __VA_ARGS__)
1829 LOAD_INFO(
"Perl version: %s", PERL_API_VERSION_STRING);
1843 MEM(embed_c = talloc_zero_array(NULL,
char const *, 1));
1844 memcpy(&embed, &embed_c,
sizeof(embed));
1848 PERL_SYS_INIT3(&argc, &embed, &envp);
1870 for (i = 0; i < talloc_array_length(
name); i++) {
1872 if (!strchr(
"abcdefghijklmnopqrstuvwxyz1234567890", *p)) *p =
'_';
1885 if (!
inst->funcs_init) {
1887 inst->funcs_init =
true;
1896 .offset = rule->pair.offset,
unlang_action_t
Returned by unlang_op_t calls, determine the next action of the interpreter.
static int const char char buffer[256]
#define DIAG_UNKNOWN_PRAGMAS
#define CMP(_a, _b)
Same as CMP_PREFER_SMALLER use when you don't really care about ordering, you just want an ordering.
call_env_parsed_t * call_env_parsed_add(TALLOC_CTX *ctx, call_env_parsed_head_t *head, call_env_parser_t const *rule)
Allocate a new call_env_parsed_t structure and add it to the list of parsed call envs.
void call_env_parsed_set_data(call_env_parsed_t *parsed, void const *data)
Assign data to a call_env_parsed_t.
#define CALL_ENV_TERMINATOR
#define FR_CALL_ENV_METHOD_OUT(_inst)
Helper macro for populating the size/type fields of a call_env_method_t from the output structure typ...
call_env_parser_t const * env
Parsing rules for call method env.
section_name_t const * asked
The actual name1/name2 that resolved to a module_method_binding_t.
@ CALL_ENV_FLAG_PARSE_ONLY
The result of parsing will not be evaluated at runtime.
@ CALL_ENV_FLAG_PARSE_MISSING
If this subsection is missing, still parse it.
@ CALL_ENV_PARSE_TYPE_VOID
Output of the parsing phase is undefined (a custom structure).
module_instance_t const * mi
Module instance that the callenv is registered to.
#define FR_CALL_ENV_SUBSECTION_FUNC(_name, _name2, _flags, _func)
Specify a call_env_parser_t which parses a subsection using a callback function.
#define CONF_PARSER_TERMINATOR
void * data
Pointer to a static variable to write the parsed value to.
#define FR_CONF_OFFSET(_name, _struct, _field)
conf_parser_t which parses a single CONF_PAIR, writing the result to a field in a struct
#define FR_CONF_OFFSET_FLAGS(_name, _flags, _struct, _field)
conf_parser_t which parses a single CONF_PAIR, writing the result to a field in a struct
@ CONF_FLAG_REQUIRED
Error out if no matching CONF_PAIR is found, and no dflt value is set.
@ CONF_FLAG_FILE_INPUT
File matching value must exist, and must be readable.
Defines a CONF_PAIR to C data type mapping.
Common header for all CONF_* types.
Configuration AVP similar to a fr_pair_t.
A section grouping multiple CONF_PAIR.
bool cf_item_is_pair(CONF_ITEM const *ci)
Determine if CONF_ITEM is a CONF_PAIR.
char const * cf_section_name1(CONF_SECTION const *cs)
Return the second identifier of a CONF_SECTION.
CONF_SECTION * cf_section_find(CONF_SECTION const *cs, char const *name1, char const *name2)
Find a CONF_SECTION with name1 and optionally name2.
CONF_SECTION * cf_item_to_section(CONF_ITEM const *ci)
Cast a CONF_ITEM to a CONF_SECTION.
CONF_PAIR * cf_pair_find(CONF_SECTION const *cs, char const *attr)
Search for a CONF_PAIR with a specific name.
bool cf_item_is_section(CONF_ITEM const *ci)
Determine if CONF_ITEM is a CONF_SECTION.
CONF_PAIR * cf_item_to_pair(CONF_ITEM const *ci)
Cast a CONF_ITEM to a CONF_PAIR.
char const * cf_pair_value(CONF_PAIR const *pair)
Return the value of a CONF_PAIR.
char const * cf_pair_attr(CONF_PAIR const *pair)
Return the attr of a CONF_PAIR.
#define cf_log_err(_cf, _fmt,...)
#define cf_item_next(_parent, _curr)
static int split(char **input, char **output, bool syntax_string)
static void * fr_dcursor_next(fr_dcursor_t *cursor)
Advanced the cursor to the next item.
static int fr_dcursor_append(fr_dcursor_t *cursor, void *v)
Insert a single item at the end of the list.
int dependency_version_number_add(CONF_SECTION *cs, char const *name, char const *version)
Add a library/server version pair to the main configuration.
fr_dict_attr_t const * fr_dict_attr_by_name(fr_dict_attr_err_t *err, fr_dict_attr_t const *parent, char const *attr))
Locate a fr_dict_attr_t by its name.
fr_dict_attr_t const * fr_dict_root(fr_dict_t const *dict)
Return the root attribute of a dictionary.
fr_dict_t const * fr_dict_internal(void)
void * dl_open_by_sym(char const *sym_name, int flags)
Utility function to dlopen the library containing a particular symbol.
#define MODULE_MAGIC_INIT
Stop people using different module/library/server versions together.
static xlat_action_t perl_xlat(TALLOC_CTX *ctx, fr_dcursor_t *out, xlat_ctx_t const *xctx, request_t *request, fr_value_box_list_t *in)
Call perl code using an xlat.
#define RPEDEBUG(fmt,...)
void fr_log(fr_log_t const *log, fr_log_type_t type, char const *file, int line, char const *fmt,...)
Send a server log message to its destination.
@ FR_TYPE_TIME_DELTA
A period of time measured in nanoseconds.
@ FR_TYPE_FLOAT32
Single precision floating point.
@ FR_TYPE_IPV4_ADDR
32 Bit IPv4 Address.
@ FR_TYPE_ETHERNET
48 Bit Mac-Address.
@ FR_TYPE_IPV6_PREFIX
IPv6 Prefix.
@ FR_TYPE_STRING
String of printable characters.
@ FR_TYPE_DATE
Unix time stamp, always has value >2^31.
@ FR_TYPE_COMBO_IP_PREFIX
IPv4 or IPv6 address prefix depending on length.
@ FR_TYPE_INT32
32 Bit signed integer.
@ FR_TYPE_IPV6_ADDR
128 Bit IPv6 Address.
@ FR_TYPE_IPV4_PREFIX
IPv4 Prefix.
@ FR_TYPE_BOOL
A truth value.
@ FR_TYPE_COMBO_IP_ADDR
IPv4 or IPv6 address depending on length.
@ FR_TYPE_IFID
Interface ID.
@ FR_TYPE_OCTETS
Raw octets.
@ FR_TYPE_GROUP
A grouping of other attributes.
@ FR_TYPE_FLOAT64
Double precision floating point.
void * env_data
Per call environment data.
module_instance_t const * mi
Instance of the module being instantiated.
void * thread
Thread specific instance data.
void * thread
Thread instance data.
module_instance_t * mi
Instance of the module being instantiated.
Temporary structure to hold arguments for module calls.
Temporary structure to hold arguments for detach calls.
Temporary structure to hold arguments for instantiation calls.
Temporary structure to hold arguments for thread_instantiation calls.
xlat_t * module_rlm_xlat_register(TALLOC_CTX *ctx, module_inst_ctx_t const *mctx, char const *name, xlat_func_t func, fr_type_t return_type)
module_t common
Common fields presented by all modules.
fr_pair_t * fr_pair_list_parent(fr_pair_list_t const *list)
Return a pointer to the parent pair which contains this list.
unsigned int fr_pair_count_by_da(fr_pair_list_t const *list, fr_dict_attr_t const *da)
Return the number of instances of a given da in the specified list.
int fr_pair_append_by_da(TALLOC_CTX *ctx, fr_pair_t **out, fr_pair_list_t *list, fr_dict_attr_t const *da)
Alloc a new fr_pair_t (and append)
int fr_pair_value_memdup(fr_pair_t *vp, uint8_t const *src, size_t len, bool tainted)
Copy data into an "octets" data type.
int fr_pair_value_from_str(fr_pair_t *vp, char const *value, size_t inlen, fr_sbuff_unescape_rules_t const *uerules, UNUSED bool tainted)
Convert string value to native attribute value.
fr_pair_t * fr_pair_find_by_da(fr_pair_list_t const *list, fr_pair_t const *prev, fr_dict_attr_t const *da)
Find the first pair with a matching da.
fr_pair_t * fr_pair_find_by_da_idx(fr_pair_list_t const *list, fr_dict_attr_t const *da, unsigned int idx)
Find a pair with a matching da at a given index.
int fr_pair_value_bstrndup(fr_pair_t *vp, char const *src, size_t len, bool tainted)
Copy data into a "string" type value pair.
void fr_pair_value_clear(fr_pair_t *vp)
Free/zero out value (or children) of a given VP.
int fr_pair_delete(fr_pair_list_t *list, fr_pair_t *vp)
Remove fr_pair_t from a list and free.
int fr_pair_prepend_by_da(TALLOC_CTX *ctx, fr_pair_t **out, fr_pair_list_t *list, fr_dict_attr_t const *da)
Alloc a new fr_pair_t (and prepend)
fr_pair_t * fr_pair_find_last_by_da(fr_pair_list_t const *list, fr_pair_t const *prev, fr_dict_attr_t const *da)
Find the last pair with a matching da.
static const conf_parser_t config[]
void * fr_rb_iter_init_inorder(fr_rb_iter_inorder_t *iter, fr_rb_tree_t *tree)
Initialise an in-order iterator.
int fr_rb_find_or_insert(void **found, fr_rb_tree_t *tree, void const *data)
Attempt to find current data in the tree, if it does not exist insert it.
void * fr_rb_iter_next_inorder(fr_rb_iter_inorder_t *iter)
Return the next node.
#define fr_rb_inline_init(_tree, _type, _field, _data_cmp, _data_free)
Initialises a red black tree.
Iterator structure for in-order traversal of an rbtree.
The main red black tree structure.
#define RETURN_UNLANG_RCODE(_rcode)
@ RLM_MODULE_FAIL
Module failed, don't reply.
static int perl_sv_to_vblist(TALLOC_CTX *ctx, fr_value_box_list_t *list, request_t *request, SV *sv)
Parse a Perl SV and create value boxes, appending to a list.
static fr_dict_attr_t const * perl_attr_lookup(fr_perl_pair_t *pair_data, char const *attr)
Helper function for turning hash keys into dictionary attributes.
fr_rb_node_t node
Node in tree of function calls.
static int mod_detach(module_detach_ctx_t const *mctx)
static int mod_load(void)
PerlInterpreter * perl
Thread specific perl interpreter.
static bool perl_func_exists(char const *func)
Check if a given Perl subroutine exists.
HV * rad_perlconf_hv
holds "config" items (perl RAD_PERLCONF hash).
#define PERLSETINT(_size)
static XS(XS_freeradius_log)
static void perl_func_name_safe(char *name)
static xlat_arg_parser_t const perl_xlat_args[]
char const * func_detach
Function to run when mod_detach is run.
char const * function_name
Name of the function being called.
static void ** rlm_perl_get_handles(pTHX)
fr_perl_pair_t * parent
Parent attribute data.
static int perl_value_marshal(fr_pair_t *vp, SV **value)
Functions to implement subroutines required for a tied array.
EXTERN_C void boot_DynaLoader(pTHX_ CV *cv)
static void perl_parse_config(CONF_SECTION *cs, int lvl, HV *rad_hv)
#define PERLSETUINT(_size)
static int mod_bootstrap(module_inst_ctx_t const *mctx)
char * name1
Section name1 where this is called.
static void rlm_perl_interp_free(PerlInterpreter *perl)
static int perl_value_unmarshal(fr_pair_t *vp, SV *value)
Convert a Perl SV to a pair value.
char const *fr_rb_tree_t funcs
Tree of function calls found by call_env parser.
static MGVTBL rlm_perl_vtbl
static void mod_unload(void)
static void xs_init(pTHX)
fr_dict_attr_t const * da
Dictionary attribute associated with hash / array.
struct fr_perl_pair_s fr_perl_pair_t
static int8_t perl_func_def_cmp(void const *one, void const *two)
How to compare two Perl function calls.
#define LOAD_WARN(_fmt,...)
static void rlm_perl_close_handles(void **handles)
static int mod_thread_instantiate(module_thread_inst_ctx_t const *mctx)
fr_dcursor_t cursor
Cursor used for iterating over the keys of a tied hash.
static void perl_pair_list_tie(HV *parent, HV *frpair_stash, char const *name, fr_pair_t *vp, fr_dict_attr_t const *da)
Create a Perl tied hash representing a pair list.
#define GET_PAIR_MAGIC(count)
Convenience macro for fetching C data associated with tied hash / array and validating stack size.
unsigned int idx
Instance number.
static unlang_action_t mod_perl(unlang_result_t *p_result, module_ctx_t const *mctx, request_t *request)
char * name2
Section name2 where this is called.
static int perl_vblist_to_av(AV *av, fr_value_box_list_t *head)
Convert a list of value boxes to a Perl array for passing to subroutines.
static void * perl_dlhandle
To allow us to load perl's symbols into the global symbol table.
#define LOAD_INFO(_fmt,...)
static const conf_parser_t module_config[]
static _Thread_local request_t * rlm_perl_request
static const call_env_method_t perl_method_env
bool funcs_init
Has the tree been initialised.
static int mod_thread_detach(module_thread_inst_ctx_t const *mctx)
static int mod_instantiate(module_inst_ctx_t const *mctx)
fr_pair_t * vp
Real pair associated with the hash / array, if it exists.
static void rlm_perl_clear_handles(pTHX)
static int fr_perl_pair_parent_build(fr_perl_pair_t *pair_data)
Build parent structural pairs needed when a leaf node is set.
static int perl_func_parse(TALLOC_CTX *ctx, call_env_parsed_head_t *out, UNUSED tmpl_rules_t const *t_rules, UNUSED CONF_ITEM *ci, call_env_ctx_t const *cec, UNUSED call_env_parser_t const *rule)
static int instantiate(module_inst_ctx_t const *mctx)
#define fr_sbuff_start(_sbuff_or_marker)
#define FR_SBUFF_OUT(_start, _len_or_end)
#define fr_sbuff_used(_sbuff_or_marker)
#define FR_SBUFF_TALLOC_THREAD_LOCAL(_out, _init, _max)
#define SECTION_NAME(_name1, _name2)
Define a section name consisting of a verb and a noun.
char const * name2
Second section name. Usually a packet type like 'access-request', 'access-accept',...
char const * name1
First section name. Usually a verb like 'recv', 'send', etc...
CONF_SECTION * conf
Module's instance configuration.
size_t inst_size
Size of the module's instance data.
void * data
Module's instance data.
#define MODULE_BINDING_TERMINATOR
Terminate a module binding list.
Named methods exported by a module.
Optional arguments passed to vp_tmpl functions.
static char buff[sizeof("18446744073709551615")+3]
eap_aka_sim_process_conf_t * inst
fr_aka_sim_id_type_t type
Stores an attribute, a value and various bits of other data.
fr_dict_attr_t const *_CONST da
Dictionary attribute defines the attribute number, vendor and type of the pair.
#define talloc_get_type_abort_const
static int talloc_const_free(void const *ptr)
Free const'd memory.
@ XLAT_ARG_VARIADIC_EMPTY_KEEP
Empty argument groups are left alone, and either passed through as empty groups or null boxes.
uint8_t required
Argument must be present, and non-empty.
#define XLAT_ARG_PARSER_TERMINATOR
@ XLAT_ACTION_FAIL
An xlat function failed.
@ XLAT_ACTION_DONE
We're done evaluating this level of nesting.
ssize_t xlat_aeval(TALLOC_CTX *ctx, char **out, request_t *request, char const *fmt, xlat_escape_legacy_t escape, void const *escape_ctx))
Definition for a single argument consumend by an xlat function.
fr_pair_t * fr_pair_remove(fr_pair_list_t *list, fr_pair_t *vp)
Remove fr_pair_t from a list without freeing.
ssize_t fr_pair_print_value_quoted(fr_sbuff_t *out, fr_pair_t const *vp, fr_token_t quote)
Print the value of an attribute to a string.
#define fr_pair_dcursor_init(_cursor, _list)
Initialises a special dcursor with callbacks that will maintain the attr sublists correctly.
fr_pair_t * fr_pair_list_prev(fr_pair_list_t const *list, fr_pair_t const *item))
Get the previous item in a valuepair list before a specific entry.
#define fr_type_is_group(_x)
#define FR_TYPE_STRUCTURAL
#define fr_type_is_leaf(_x)
static char const * fr_type_to_str(fr_type_t type)
Return a static string containing the type name.
ssize_t fr_value_box_print(fr_sbuff_t *out, fr_value_box_t const *data, fr_sbuff_escape_rules_t const *e_rules)
Print one boxed value to a string.
int fr_value_box_bstrndup(TALLOC_CTX *ctx, fr_value_box_t *dst, fr_dict_attr_t const *enumv, char const *src, size_t len, bool tainted)
Copy a string to to a fr_value_box_t.
#define fr_value_box_alloc(_ctx, _type, _enumv)
Allocate a value box of a specific type.
#define fr_value_box_alloc_null(_ctx)
Allocate a value box for later use with a value assignment function.
#define fr_value_box_list_foreach(_list_head, _iter)
static size_t char ** out
module_ctx_t const * mctx
Synthesised module calling ctx.
int xlat_func_args_set(xlat_t *x, xlat_arg_parser_t const args[])
Register the arguments of an xlat.