*/
typedef struct rlm_perl_t {
/* Name of the perl module */
- char *module;
+ char const *module;
/* Name of the functions for each module method */
- char *func_authorize;
- char *func_authenticate;
- char *func_accounting;
- char *func_start_accounting;
- char *func_stop_accounting;
- char *func_preacct;
- char *func_checksimul;
- char *func_detach;
- char *func_xlat;
+ char const *func_authorize;
+ char const *func_authenticate;
+ char const *func_accounting;
+ char const *func_start_accounting;
+ char const *func_stop_accounting;
+ char const *func_preacct;
+ char const *func_checksimul;
+ char const *func_detach;
+ char const *func_xlat;
#ifdef WITH_PROXY
- char *func_pre_proxy;
- char *func_post_proxy;
+ char const *func_pre_proxy;
+ char const *func_post_proxy;
#endif
- char *func_post_auth;
+ char const *func_post_auth;
#ifdef WITH_COA
- char *func_recv_coa;
- char *func_send_coa;
+ char const *func_recv_coa;
+ char const *func_send_coa;
#endif
- char *xlat_name;
- char *perl_flags;
+ char const *xlat_name;
+ char const *perl_flags;
PerlInterpreter *perl;
pthread_key_t *thread_key;
/*
* A mapping of configuration file names to internal variables.
*/
-#define RLM_PERL_CONF(_x) { "func_" STRINGIFY(_x), PW_TYPE_STRING_PTR, \
+#define RLM_PERL_CONF(_x) { "func_" STRINGIFY(_x), PW_TYPE_STRING, \
offsetof(rlm_perl_t,func_##_x), NULL, STRINGIFY(_x)}
static const CONF_PARSER module_config[] = {
- { "module", PW_TYPE_FILE_INPUT | PW_TYPE_DEPRECATED,
- offsetof(rlm_perl_t,module), NULL, NULL},
- { "filename", PW_TYPE_FILE_INPUT | PW_TYPE_REQUIRED,
- offsetof(rlm_perl_t,module), NULL, NULL},
+ { "module", FR_CONF_OFFSET(PW_TYPE_FILE_INPUT | PW_TYPE_DEPRECATED, rlm_perl_t, module), NULL },
+ { "filename", FR_CONF_OFFSET(PW_TYPE_FILE_INPUT | PW_TYPE_REQUIRED, rlm_perl_t, module), NULL },
RLM_PERL_CONF(authorize),
RLM_PERL_CONF(authenticate),
RLM_PERL_CONF(recv_coa),
RLM_PERL_CONF(send_coa),
#endif
- { "perl_flags", PW_TYPE_STRING_PTR,
- offsetof(rlm_perl_t,perl_flags), NULL, NULL},
+ { "perl_flags", FR_CONF_OFFSET(PW_TYPE_STRING, rlm_perl_t, perl_flags), NULL },
- { "func_start_accounting", PW_TYPE_STRING_PTR,
- offsetof(rlm_perl_t,func_start_accounting), NULL, NULL},
+ { "func_start_accounting", FR_CONF_OFFSET(PW_TYPE_STRING, rlm_perl_t, func_start_accounting), NULL },
- { "func_stop_accounting", PW_TYPE_STRING_PTR,
- offsetof(rlm_perl_t,func_stop_accounting), NULL, 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 */
};
#endif
/*
- *
* This is wrapper for radlog
* Now users can call radiusd::radlog(level,msg) wich is the same
* calling radlog from C code.
- * Boyan
*/
static XS(XS_radiusd_radlog)
{
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;
+ rlm_perl_t *inst = (rlm_perl_t *) instance;
char *tmp;
char const *p, *q;
int count;
* 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
*
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 = talloc_zero_array(inst, char *, 4));
-
+ 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
*/
char arg[] = "0";
- embed[0] = NULL;
+ embed_c[0] = NULL;
if (inst->perl_flags) {
- embed[1] = inst->perl_flags;
- embed[2] = inst->module;
- embed[3] = arg;
+ embed_c[1] = inst->perl_flags;
+ embed_c[2] = inst->module;
+ embed_c[3] = arg;
argc = 4;
} else {
- embed[1] = inst->module;
- embed[2] = arg;
+ embed_c[1] = inst->module;
+ embed_c[2] = arg;
argc = 3;
}
* Example for this is Cisco-AVPair that holds multiple values.
* Which will be available as array_ref in $RAD_REQUEST{'Cisco-AVPair'}
*/
-static void perl_store_vps(TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR *vps, HV *rad_hv)
+static void perl_store_vps(UNUSED TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR *vps, HV *rad_hv)
{
- VALUE_PAIR *head, *sublist;
- AV *av;
- char const *name;
- char namebuf[256];
- char buffer[1024];
- size_t len;
+ VALUE_PAIR *vp;
hv_undef(rad_hv);
- /*
- * Copy the valuepair list so we can remove attributes
- * we've already processed. This is a horrible hack to
- * get around various other stupidity.
- */
- head = paircopy(ctx, vps);
+ vp_cursor_t cursor;
- while (head) {
- vp_cursor_t cursor;
+ pairsort(&vps, attrtagcmp);
+ for (vp = fr_cursor_init(&cursor, &vps);
+ vp;
+ vp = fr_cursor_next(&cursor)) {
+ VALUE_PAIR *next;
+
+ char const *name;
+ char namebuf[256];
+ char buffer[1024];
+
+ size_t len;
/*
* Tagged attributes are added to the hash with name
* <attribute>:<tag>, others just use the normal attribute
* name as the key.
*/
- if (head->da->flags.has_tag && (head->tag != 0)) {
- snprintf(namebuf, sizeof(namebuf), "%s:%d",
- head->da->name, head->tag);
+ if (vp->da->flags.has_tag && (vp->tag != TAG_ANY)) {
+ snprintf(namebuf, sizeof(namebuf), "%s:%d", vp->da->name, vp->tag);
name = namebuf;
} else {
- name = head->da->name;
+ name = vp->da->name;
}
/*
- * Create a new list with all the attributes like this one
- * which are in the same tag group.
+ * We've sorted by type, then tag, so attributes of the
+ * same type/tag should follow on from each other.
*/
- sublist = NULL;
- pairfilter(ctx, &sublist, &head, head->da->attr, head->da->vendor, head->tag);
-
- fr_cursor_init(&cursor, &sublist);
-
- /*
- * Attribute has multiple values
- */
- if (fr_cursor_next(&cursor)) {
- VALUE_PAIR *vp;
+ if ((next = fr_cursor_next_peek(&cursor)) && ATTRIBUTE_EQ(vp, next)) {
+ AV *av;
av = newAV();
- for (vp = fr_cursor_first(&cursor);
- vp;
- vp = fr_cursor_next(&cursor)) {
- if (vp->da->type != PW_TYPE_STRING) {
- len = vp_prints_value(buffer, sizeof(buffer), vp, 0);
+ for (next = fr_cursor_first(&cursor);
+ next;
+ next = fr_cursor_next_by_da(&cursor, vp->da, vp->tag)) {
+ switch (vp->da->type) {
+ case PW_TYPE_STRING:
+ av_push(av, newSVpv(next->vp_strvalue, next->length));
+ RDEBUG("<-- %s = %s", next->da->name, next->vp_strvalue);
+ break;
+
+ default:
+ len = vp_prints_value(buffer, sizeof(buffer), next, 0);
+ RDEBUG("<-- %s = %s", next->da->name, buffer);
av_push(av, newSVpv(buffer, truncate_len(len, sizeof(buffer))));
- RDEBUG("<-- %s = %s", vp->da->name, buffer);
- } else {
- av_push(av, newSVpv(vp->vp_strvalue, vp->length));
- RDEBUG("<-- %s = %s", vp->da->name, vp->vp_strvalue);
+ break;
}
}
(void)hv_store(rad_hv, name, strlen(name), newRV_noinc((SV *)av), 0);
- /*
- * Attribute has a single value, so its value just gets
- * added to the hash.
- */
- } else if (sublist) {
-
- if (sublist->da->type != PW_TYPE_STRING) {
- len = vp_prints_value(buffer, sizeof(buffer), sublist, 0);
- (void)hv_store(rad_hv, name, strlen(name), newSVpv(buffer, truncate_len(len, sizeof(buffer))), 0);
- RDEBUG("<-- %s = %s", sublist->da->name, buffer);
- } else {
- (void)hv_store(rad_hv, name, strlen(name), newSVpv(sublist->vp_strvalue, sublist->length), 0);
- RDEBUG("<-- %s = %s", sublist->da->name, sublist->vp_strvalue);
- }
+ continue;
}
- pairfree(&sublist);
+ /*
+ * It's a normal single valued attribute
+ */
+ switch (vp->da->type) {
+ case PW_TYPE_STRING:
+ RDEBUG("<-- %s = %s", next->da->name, next->vp_strvalue);
+ (void)hv_store(rad_hv, name, strlen(name), newSVpv(vp->vp_strvalue, vp->length), 0);
+ break;
+
+ default:
+ len = vp_prints_value(buffer, sizeof(buffer), next, 0);
+ RDEBUG("<-- %s = %s", next->da->name, buffer);
+ (void)hv_store(rad_hv, name, strlen(name), newSVpv(buffer, truncate_len(len, sizeof(buffer))), 0);
+ break;
+ }
}
-
- rad_assert(!head);
}
/*
}
if (vp->da->type != PW_TYPE_STRING) {
- if (!pairparsevalue(vp, val)) goto fail;
+ if (pairparsevalue(vp, val, 0) < 0) goto fail;
} else {
pairstrncpy(vp, val, len);
}
}
/*
- * Boyan :
* Gets the content from hashes
*/
static int get_hv_content(TALLOC_CTX *ctx, REQUEST *request, HV *my_hv, VALUE_PAIR **vps)
* Store all vps in hashes %RAD_CHECK %RAD_REPLY %RAD_REQUEST
*
*/
-static int do_perl(void *instance, REQUEST *request, char *function_name)
+static int do_perl(void *instance, REQUEST *request, char const *function_name)
{
rlm_perl_t *inst = instance;
projects / freeradius.git / blobdiff