25RCSID(
"$Id: a2274be672fffeecf13232a49d3a91a289a56d87 $")
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
133 ret = strcmp(a->
name1, b->name1);
134 if (ret != 0)
return CMP(ret, 0);
135 if (!a->
name2 && !b->name2)
return 0;
136 if (!a->
name2 || !b->name2)
return a->
name2 ? 1 : -1;
137 ret = strcmp(a->
name2, b->name2);
148# define dl_librefs "DynaLoader::dl_librefs"
149# define dl_modules "DynaLoader::dl_modules"
165 if (!librefs)
return NULL;
167 if (!(AvFILL(librefs) >= 0)) {
171 MEM(handles = talloc_array(NULL,
void *, AvFILL(librefs) + 2));
172 for (i = 0; i <= AvFILL(librefs); i++) {
174 SV *handle_sv = *av_fetch(librefs, i,
false);
179 handle = (
void *)SvIV(handle_sv);
181 if (handle) handles[i] = handle;
187 handles[i] = (
void *)0;
200 for (i = 0; handles[i]; i++) {
201 DEBUG(
"Close %p", handles[i]);
213static XS(XS_freeradius_log)
217 croak(
"Usage: radiusd::log(level, message)");
222 level = (int) SvIV(ST(0));
223 msg = (
char *) SvPV(ST(1), PL_na);
241static XS(XS_freeradius_xlat)
249 if (items != 1) croak(
"Usage: radiusd::xlat(string)");
253 in_str = (
char *) SvPV(ST(0), PL_na);
255 slen =
xlat_aeval(request, &expanded, request, in_str, NULL, NULL);
257 REDEBUG(
"Error parsing xlat '%s'", in_str);
261 XST_mPV(0, expanded);
280 if (!da) croak(
"Unknown or invalid attribute name \"%s\"", attr);
288#define GET_PAIR_MAGIC(count) MAGIC *mg = mg_findext(ST(0), PERL_MAGIC_ext, &rlm_perl_vtbl); \
289 fr_perl_pair_t *pair_data; \
290 if (unlikely(items < count)) { \
291 croak("Expected %d stack entries, got %d", count, items); \
295 croak("Failed to find Perl magic value"); \
298 pair_data = (fr_perl_pair_t *)mg->mg_ptr;
318static XS(XS_pairlist_FETCH)
329 attr = (
char *) SvPV(ST(1), len);
335 if (!isdigit(attr[i]))
break;
344 if (!da) XSRETURN_UNDEF;
359 frpair_stash = gv_stashpv(
"freeradiuspairs", GV_ADD);
361 pair_tie = newRV_noinc((SV *)newAV());
362 sv_bless(pair_tie, frpair_stash);
363 sv_magic(MUTABLE_SV(pair_av), MUTABLE_SV((GV *)pair_tie), PERL_MAGIC_tied, NULL, 0);
364 SvREFCNT_dec(pair_tie);
371 sv_magicext((SV *)pair_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&child_pair_data,
sizeof(child_pair_data));
372 ST(0) = sv_2mortal(newRV((SV *)pair_av));
386 frpair_stash = gv_stashpv(
"freeradiuspairlist", GV_ADD);
388 struct_tie = newRV_noinc((SV *)newHV());
389 sv_bless(struct_tie, frpair_stash);
390 hv_magic(struct_hv, (GV *)struct_tie, PERL_MAGIC_tied);
391 SvREFCNT_dec(struct_tie);
399 sv_magicext((SV *)struct_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&child_pair_data,
sizeof(child_pair_data));
400 ST(0) = sv_2mortal(newRV((SV *)struct_hv));
415static XS(XS_pairlist_STORE)
423 attr = (
char *) SvPV(ST(1), PL_na);
425 if (!da) XSRETURN(0);
428 croak(
"Cannot set value of array of \"%s\" values. Use array index to set a specific instance.", da->name);
430 croak(
"Cannot set values of structural object %s", da->name);
441static XS(XS_pairlist_EXISTS)
450 attr = (
char *) SvPV(ST(1), len);
452 if (!isdigit(attr[i]))
break;
460 unsigned int idx = SvIV(ST(1));
461 if (pair_data->parent->vp) {
467 if (!pair_data->vp) XSRETURN_NO;
470 if (!da) XSRETURN_NO;
481static XS(XS_pairlist_FIRSTKEY)
487 if (!pair_data->vp) XSRETURN_EMPTY;
490 ST(0) = sv_2mortal(newSVpv(
vp->
da->name,
vp->
da->name_len));
500static XS(XS_pairlist_NEXTKEY)
506 if (!pair_data->vp) XSRETURN_EMPTY;
509 if (!
vp) XSRETURN_EMPTY;
511 ST(0) = sv_2mortal(newSVpv(
vp->
da->name,
vp->
da->name_len));
521static XS(XS_pairlist_DELETE)
529 attr = SvPV(ST(1), PL_na);
532 if (!da) XSRETURN(0);
533 if (!pair_data->vp) XSRETURN(0);
549 switch(
vp->vp_type) {
551 *
value = sv_2mortal(newSVpvn(
vp->vp_strvalue,
vp->vp_length));
555 *
value = sv_2mortal(newSVpvn((
char const *)
vp->vp_octets,
vp->vp_length));
558#define PERLUINT(_size) case FR_TYPE_UINT ## _size: \
559 *value = sv_2mortal(newSVuv(vp->vp_uint ## _size)); \
566#define PERLINT(_size) case FR_TYPE_INT ## _size: \
567 *value = sv_2mortal(newSViv(vp->vp_int ## _size)); \
575 *
value = sv_2mortal(newSVuv(
vp->vp_bool));
579 *
value = sv_2mortal(newSVnv(
vp->vp_float32));
583 *
value = sv_2mortal(newSVnv(
vp->vp_float64));
602 croak(
"Cannot convert %s to Perl type, insufficient buffer space",
607 *
value = sv_2mortal(newSVpv(
buff, slen));
630static XS(XS_pairs_FETCH)
633 unsigned int idx = SvUV(ST(1));
640 if (!
parent->vp) XSRETURN_UNDEF;
642 if (idx == 0)
vp = pair_data->vp;
644 if (!
vp) XSRETURN_UNDEF;
662 if (pair_data->
idx > 0) {
664 croak(
"Attempt to set instance %d when none exist", pair_data->
idx);
670 if (pair_data->
idx > 0) {
673 if (!
parent->parent->vp)
goto none_exist;
675 if (count < pair_data->idx) {
676 croak(
"Attempt to set instance %d when only %d exist", pair_data->
idx,
count);
694 switch (
vp->vp_type) {
696 val = SvPV(
value, len);
702 val = SvPV(
value, len);
707#define PERLSETUINT(_size) case FR_TYPE_UINT ## _size: \
708 vp->vp_uint ## _size = SvUV(value); \
715#define PERLSETINT(_size) case FR_TYPE_INT ## _size: \
716 vp->vp_int ## _size = SvIV(value); \
733 val = SvPV(
value, len);
735 croak(
"Failed populating pair");
755static XS(XS_pairs_STORE)
758 unsigned int idx = SvUV(ST(1));
766 parent = pair_data->parent;
774 croak(
"Attempting to set instance %d when none exist", idx);
786 croak(
"Attempt to set instance %d when only %d exist", idx,
count);
801static XS(XS_pairs_EXISTS)
804 unsigned int idx = SvUV(ST(1));
811 if (!
parent->vp) XSRETURN_NO;
814 if (
vp) XSRETURN_YES;
821static XS(XS_pairs_DELETE)
824 unsigned int idx = SvUV(ST(1));
831 if (!
parent->vp) XSRETURN(0);
842static XS(XS_pairs_FETCHSIZE)
847 if (!pair_data->parent->vp) XSRETURN_UV(0);
859static XS(XS_pairs_STORESIZE)
862 unsigned int count, req_size = SvUV(ST(1));
870 croak(
"Unable to set attribute instance count");
876 if (req_size >
count) {
877 croak(
"Increasing attribute instance count not supported");
901static XS(XS_pairs_PUSH)
912 parent = pair_data->parent;
929static XS(XS_pairs_POP)
939 parent = pair_data->parent;
940 if (!
parent->vp) XSRETURN(0);
943 if (!
vp) XSRETURN(0);
955static XS(XS_pairs_SHIFT)
965 parent = pair_data->parent;
966 if (!
parent->vp) XSRETURN(0);
969 if (!
vp) XSRETURN(0);
983static XS(XS_pairs_UNSHIFT)
994 parent = pair_data->parent;
1001 croak(
"Failed adding attribute %s", pair_data->da->name);
1012 char const *
file = __FILE__;
1017 newXS(
"freeradius::log",XS_freeradius_log,
"rlm_perl");
1018 newXS(
"freeradius::xlat",XS_freeradius_xlat,
"rlm_perl");
1024 newXS(
"freeradiuspairlist::FETCH", XS_pairlist_FETCH,
"rlm_perl");
1025 newXS(
"freeradiuspairlist::STORE", XS_pairlist_STORE,
"rlm_perl");
1026 newXS(
"freeradiuspairlist::EXISTS", XS_pairlist_EXISTS,
"rlm_perl");
1027 newXS(
"freeradiuspairlist::FIRSTKEY", XS_pairlist_FIRSTKEY,
"rlm_perl");
1028 newXS(
"freeradiuspairlist::NEXTKEY", XS_pairlist_NEXTKEY,
"rlm_perl");
1029 newXS(
"freeradiuspairlist::DELETE", XS_pairlist_DELETE,
"rlm_perl");
1035 newXS(
"freeradiuspairs::FETCH", XS_pairs_FETCH,
"rlm_perl");
1036 newXS(
"freeradiuspairs::STORE", XS_pairs_STORE,
"rlm_perl");
1037 newXS(
"freeradiuspairs::EXISTS", XS_pairs_EXISTS,
"rlm_perl");
1038 newXS(
"freeradiuspairs::DELETE", XS_pairs_DELETE,
"rlm_perl");
1039 newXS(
"freeradiuspairs::FETCHSIZE", XS_pairs_FETCHSIZE,
"rlm_perl");
1040 newXS(
"freeradiuspairs::STORESIZE", XS_pairs_STORESIZE,
"rlm_perl");
1041 newXS(
"freeradiuspairs::PUSH", XS_pairs_PUSH,
"rlm_perl");
1042 newXS(
"freeradiuspairs::POP", XS_pairs_POP,
"rlm_perl");
1043 newXS(
"freeradiuspairs::SHIFT", XS_pairs_SHIFT,
"rlm_perl");
1044 newXS(
"freeradiuspairs::UNSHIFT", XS_pairs_UNSHIFT,
"rlm_perl");
1062 while ((vb = fr_value_box_list_next(
head, vb))) {
1065 sv = newSVpvn(vb->vb_strvalue, vb->vb_length);
1069 sv = newSVpvn((
char const *)vb->vb_octets, vb->vb_length);
1077 sv = newRV_inc((SV *)sub_av);
1086 if (slen < 0)
return -1;
1087 sv = newSVpvn(
buffer, (
size_t)slen);
1092 if (vb->tainted) SvTAINT(sv);
1127 RDEBUG3(
"Reference returned");
1133 vb->vb_int32 = SvIV(sv);
1140 vb->vb_float64 = SvNV(sv);
1146 tmp = SvPVutf8(sv, len);
1150 RPEDEBUG(
"Failed to allocate %ld for output", len);
1161 sv_len = av_len(av);
1162 for (i = 0; i <= sv_len; i++) {
1163 av_sv = av_fetch(av, i, 0);
1177 for (i = hv_iterinit(hv); i > 0; i--) {
1178 hv_sv = hv_iternextsv(hv, &tmp, &sv_len);
1185 RPEDEBUG(
"Failed to allocate %d for output", sv_len);
1188 fr_value_box_list_insert_tail(list, vb);
1206 RPEDEBUG(
"Perl returned unsupported data type %d",
type);
1212 vb->tainted = SvTAINTED(sv);
1213 fr_value_box_list_insert_tail(list, vb);
1241 fr_value_box_list_t list, sub_list;
1244 fr_value_box_list_init(&list);
1245 fr_value_box_list_init(&sub_list);
1249 PERL_SET_CONTEXT(t->
perl);
1266 if (fr_value_box_list_empty(&arg->vb_group))
continue;
1268 if (fr_value_box_list_num_elements(&arg->vb_group) == 1) {
1269 child = fr_value_box_list_head(&arg->vb_group);
1271 switch (child->type) {
1273 if (child->vb_length == 0)
continue;
1275 RDEBUG3(
"Passing single value %pV", child);
1276 sv = newSVpvn(child->vb_strvalue, child->vb_length);
1280 RDEBUG3(
"Ignoring nested group");
1293 RDEBUG3(
"Passing single value %pV", child);
1295 fr_sbuff_set_to_start(sbuff);
1299 if (child->tainted) SvTAINT(sv);
1300 XPUSHs(sv_2mortal(sv));
1309 RDEBUG3(
"Passing list as array %pM", &arg->vb_group);
1310 sv = newRV_inc((SV *)av);
1311 XPUSHs(sv_2mortal(sv));
1316 count = call_pv(func->vb_strvalue, G_ARRAY | G_EVAL);
1319 if (SvTRUE(ERRSV)) {
1320 REDEBUG(
"Exit %s", SvPV(ERRSV,n_a));
1330 for (i = 0; i <
count; i++) {
1333 fr_value_box_list_move_head(&list, &sub_list);
1358 int indent_section = (lvl + 1) * 4;
1359 int indent_item = (lvl + 2) * 4;
1361 if (!cs || !rad_hv)
return;
1379 if (hv_exists(rad_hv, key, strlen(key))) {
1380 WARN(
"Ignoring duplicate config section '%s'", key);
1385 ref = newRV_inc((SV*) sub_hv);
1387 (void)hv_store(rad_hv, key, strlen(key), ref, 0);
1395 if (!key || !
value)
continue;
1401 if (hv_exists(rad_hv, key, strlen(key))) {
1402 WARN(
"Ignoring duplicate config item '%s'", key);
1406 (void)hv_store(rad_hv, key, strlen(key), newSVpvn(
value, strlen(
value)), 0);
1408 DEBUG(
"%*s%s = %s", indent_item,
" ", key,
value);
1412 DEBUG(
"%*s}", indent_section,
" ");
1425 list_tie = newRV_noinc((SV *)newHV());
1426 sv_bless(list_tie, frpair_stash);
1427 hv_magic(list_hv, (GV *)list_tie, PERL_MAGIC_tied);
1428 SvREFCNT_dec(list_tie);
1435 sv_magicext((SV *)list_tie, 0, PERL_MAGIC_ext, &
rlm_perl_vtbl, (
char *)&pair_data,
sizeof(pair_data));
1437 (void)hv_store(
parent,
name, strlen(
name), newRV_inc((SV *)list_hv), 0);
1463 PERL_SET_CONTEXT(interp);
1473 frpair_stash = gv_stashpv(
"freeradiuspairlist", GV_ADD);
1476 fr_packet = newHV();
1493 XPUSHs( sv_2mortal(newRV((SV *)fr_packet)) );
1502 if (SvTRUE(ERRSV)) {
1503 REDEBUG(
"perl_embed:: module = %s , func = %s exit status= %s\n",
1507 }
else if (
count == 1) {
1509 if (ret >= 100 || ret < 0) {
1530 PERL_SET_CONTEXT(perl);
1536 PL_perl_destruct_level = 2;
1538 PL_origenviron = environ;
1544 while (PL_scopestack_ix > 1) LEAVE;
1546 perl_destruct(perl);
1556 PerlInterpreter *interp;
1559 PERL_SET_CONTEXT(
inst->perl);
1561 interp = perl_clone(
inst->perl, clone_flags);
1565# if PERL_REVISION >= 5 && PERL_VERSION <8
1566 call_pv(
"CLONE", 0);
1568 ptr_table_free(PL_ptr_table);
1569 PL_ptr_table = NULL;
1571 PERL_SET_CONTEXT(aTHX);
1600 eval_str = talloc_asprintf(NULL,
"(main->can('%s') ? 1 : 0)", func);
1601 val = eval_pv(eval_str, TRUE);
1603 return SvIV(val) ? true :
false;
1631 char const **embed_c;
1633 int ret = 0, argc = 0;
1641 MEM(embed_c = talloc_zero_array(
inst,
char const *, 4));
1642 memcpy(&embed, &embed_c,
sizeof(embed));
1644 if (
inst->perl_flags) {
1645 embed_c[1] =
inst->perl_flags;
1646 embed_c[2] =
inst->module;
1650 embed_c[1] =
inst->module;
1658 if ((
inst->perl = perl_alloc()) == NULL) {
1659 ERROR(
"No memory for allocating new perl interpreter!");
1662 perl_construct(
inst->perl);
1664 PL_perl_destruct_level = 2;
1668 PERL_SET_CONTEXT(
inst->perl);
1670#if PERL_REVISION >= 5 && PERL_VERSION >=8
1671 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1674 ret = perl_parse(
inst->perl,
xs_init, argc, embed, NULL);
1677 PL_endav = (AV *)NULL;
1680 ERROR(
"Perl_parse failed: %s not found or has syntax errors",
inst->module);
1687 inst->rad_perlconf_hv = get_hv(
"RAD_PERLCONF", 1);
1691 inst->perl_parsed =
true;
1692 perl_run(
inst->perl);
1706 pair_name = talloc_asprintf(func,
"func_%s_%s", func->
name1, func->
name2);
1709 if (cp)
goto found_func;
1711 pair_name = talloc_asprintf(func,
"func_%s", func->
name1);
1724 }
else if (func->
name2) {
1754 int ret = 0,
count = 0;
1757 if (
inst->perl_parsed) {
1759 PERL_SET_CONTEXT(
inst->perl);
1760 if (
inst->rad_perlconf_hv != NULL) hv_undef(
inst->rad_perlconf_hv);
1762 if (
inst->func_detach) {
1763 dSP;
ENTER; SAVETMPS;
1766 count = call_pv(
inst->func_detach, G_SCALAR | G_EVAL );
1771 if (ret >= 100 || ret < 0) {
1799 char const **embed_c;
1804#define LOAD_INFO(_fmt, ...) fr_log(LOG_DST, L_INFO, __FILE__, __LINE__, "rlm_perl - " _fmt, ## __VA_ARGS__)
1805#define LOAD_WARN(_fmt, ...) fr_log_perror(LOG_DST, L_WARN, __FILE__, __LINE__, \
1806 &(fr_log_perror_format_t){ \
1807 .first_prefix = "rlm_perl - ", \
1808 .subsq_prefix = "rlm_perl - ", \
1810 _fmt, ## __VA_ARGS__)
1812 LOAD_INFO(
"Perl version: %s", PERL_API_VERSION_STRING);
1826 MEM(embed_c = talloc_zero_array(NULL,
char const *, 1));
1827 memcpy(&embed, &embed_c,
sizeof(embed));
1831 PERL_SYS_INIT3(&argc, &embed, &envp);
1853 for (i = 0; i < talloc_array_length(
name); i++) {
1855 if (!strchr(
"abcdefghijklmnopqrstuvwxyz1234567890", *p)) *p =
'_';
1868 if (!
inst->funcs_init) {
1870 inst->funcs_init =
true;
1879 .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_MODULE_RCODE(_rcode)
rlm_rcode_t
Return codes indicating the result of the module call.
@ 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.
char * name2
Section name2 where this is called.
static unlang_action_t mod_perl(rlm_rcode_t *p_result, module_ctx_t const *mctx, request_t *request)
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.