All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Macros Groups Pages
rlm_perl.c
Go to the documentation of this file.
1 /*
2  * This program is is free software; you can redistribute it and/or modify
3  * it under the terms of the GNU General Public License as published by
4  * the Free Software Foundation; either version 2 of the License, or (at
5  * your option) any later version.
6  *
7  * This program is distributed in the hope that it will be useful,
8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10  * GNU General Public License for more details.
11  *
12  * You should have received a copy of the GNU General Public License
13  * along with this program; if not, write to the Free Software
14  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
15  */
16 
17 /**
18  * $Id: 5c0f89825deb3ba0fed1852efff8ec395894ef79 $
19  * @file rlm_perl.c
20  * @brief Translates requests between the server an a perl interpreter.
21  *
22  * @copyright 2002,2006 The FreeRADIUS server project
23  * @copyright 2002 Boian Jordanov <bjordanov@orbitel.bg>
24  */
25 RCSID("$Id: 5c0f89825deb3ba0fed1852efff8ec395894ef79 $")
26 
27 #include <freeradius-devel/radiusd.h>
28 #include <freeradius-devel/modules.h>
29 #include <freeradius-devel/rad_assert.h>
30 
31 #ifdef INADDR_ANY
32 # undef INADDR_ANY
33 #endif
34 #include <EXTERN.h>
35 #include <perl.h>
36 #include <XSUB.h>
37 #include <dlfcn.h>
38 #include <semaphore.h>
39 
40 #ifdef __APPLE__
41 extern char **environ;
42 #endif
43 
44 /*
45  * Define a structure for our module configuration.
46  *
47  * These variables do not need to be in a structure, but it's
48  * a lot cleaner to do so, and a pointer to the structure can
49  * be used as the instance handle.
50  */
51 typedef struct rlm_perl_t {
52  /* Name of the perl module */
53  char const *module;
54 
55  /* Name of the functions for each module method */
56  char const *func_authorize;
57  char const *func_authenticate;
58  char const *func_accounting;
59  char const *func_start_accounting;
60  char const *func_stop_accounting;
61  char const *func_preacct;
62  char const *func_checksimul;
63  char const *func_detach;
64  char const *func_xlat;
65 #ifdef WITH_PROXY
66  char const *func_pre_proxy;
67  char const *func_post_proxy;
68 #endif
69  char const *func_post_auth;
70 #ifdef WITH_COA
71  char const *func_recv_coa;
72  char const *func_send_coa;
73 #endif
74  char const *xlat_name;
75  char const *perl_flags;
76  PerlInterpreter *perl;
78  pthread_key_t *thread_key;
79 
80 #ifdef USE_ITHREADS
81  pthread_mutex_t clone_mutex;
82 #endif
83 
84  HV *rad_perlconf_hv; //!< holds "config" items (perl %RAD_PERLCONF hash).
85 
86 } rlm_perl_t;
87 /*
88  * A mapping of configuration file names to internal variables.
89  */
90 #define RLM_PERL_CONF(_x) { "func_" STRINGIFY(_x), PW_TYPE_STRING, \
91  offsetof(rlm_perl_t,func_##_x), NULL, STRINGIFY(_x), T_INVALID }
92 
93 static const CONF_PARSER module_config[] = {
95 
96  RLM_PERL_CONF(authorize),
97  RLM_PERL_CONF(authenticate),
98  RLM_PERL_CONF(post_auth),
99  RLM_PERL_CONF(accounting),
100  RLM_PERL_CONF(preacct),
101  RLM_PERL_CONF(checksimul),
102  RLM_PERL_CONF(detach),
103  RLM_PERL_CONF(xlat),
104 
105 #ifdef WITH_PROXY
106  RLM_PERL_CONF(pre_proxy),
107  RLM_PERL_CONF(post_proxy),
108 #endif
109 #ifdef WITH_COA
110  RLM_PERL_CONF(recv_coa),
111  RLM_PERL_CONF(send_coa),
112 #endif
113  { FR_CONF_OFFSET("perl_flags", PW_TYPE_STRING, rlm_perl_t, perl_flags) },
114 
115  { FR_CONF_OFFSET("func_start_accounting", PW_TYPE_STRING, rlm_perl_t, func_start_accounting) },
116 
117  { FR_CONF_OFFSET("func_stop_accounting", PW_TYPE_STRING, rlm_perl_t, func_stop_accounting) },
119 };
120 
121 /*
122  * man perlembed
123  */
124 EXTERN_C void boot_DynaLoader(pTHX_ CV* cv);
125 
126 #ifdef USE_ITHREADS
127 # define dl_librefs "DynaLoader::dl_librefs"
128 # define dl_modules "DynaLoader::dl_modules"
129 static void rlm_perl_clear_handles(pTHX)
130 {
131  AV *librefs = get_av(dl_librefs, false);
132  if (librefs) {
133  av_clear(librefs);
134  }
135 }
136 
137 static void **rlm_perl_get_handles(pTHX)
138 {
139  I32 i;
140  AV *librefs = get_av(dl_librefs, false);
141  AV *modules = get_av(dl_modules, false);
142  void **handles;
143 
144  if (!librefs) return NULL;
145 
146  if (!(AvFILL(librefs) >= 0)) {
147  return NULL;
148  }
149 
150  handles = (void **)rad_malloc(sizeof(void *) * (AvFILL(librefs)+2));
151 
152  for (i = 0; i <= AvFILL(librefs); i++) {
153  void *handle;
154  SV *handle_sv = *av_fetch(librefs, i, false);
155  if (!handle_sv) {
156  ERROR("Could not fetch $%s[%d]!", dl_librefs, (int)i);
157  continue;
158  }
159  handle = (void *)SvIV(handle_sv);
160 
161  if (handle) handles[i] = handle;
162  }
163 
164  av_clear(modules);
165  av_clear(librefs);
166 
167  handles[i] = (void *)0;
168 
169  return handles;
170 }
171 
172 static void rlm_perl_close_handles(void **handles)
173 {
174  int i;
175 
176  if (!handles) {
177  return;
178  }
179 
180  for (i = 0; handles[i]; i++) {
181  DEBUG("Close %p", handles[i]);
182  dlclose(handles[i]);
183  }
184 
185  free(handles);
186 }
187 
188 DIAG_OFF(shadow)
189 static void rlm_perl_destruct(PerlInterpreter *perl)
190 {
191  dTHXa(perl);
192 
193  PERL_SET_CONTEXT(perl);
194 
195  PL_perl_destruct_level = 2;
196 
197  PL_origenviron = environ;
198 
199 
200  {
201  dTHXa(perl);
202  }
203  /*
204  * FIXME: This shouldn't happen
205  *
206  */
207  while (PL_scopestack_ix > 1) {
208  LEAVE;
209  }
210 
211  perl_destruct(perl);
212  perl_free(perl);
213 }
214 DIAG_ON(shadow)
215 
216 static void rlm_destroy_perl(PerlInterpreter *perl)
217 {
218  void **handles;
219 
220  dTHXa(perl);
221  PERL_SET_CONTEXT(perl);
222 
223  handles = rlm_perl_get_handles(aTHX);
224  if (handles) rlm_perl_close_handles(handles);
225  rlm_perl_destruct(perl);
226 }
227 
228 /* Create Key */
229 static void rlm_perl_make_key(pthread_key_t *key)
230 {
231  pthread_key_create(key, (void (*)(void *))rlm_destroy_perl);
232 }
233 
234 static PerlInterpreter *rlm_perl_clone(PerlInterpreter *perl, pthread_key_t *key)
235 {
236  int ret;
237 
238  PerlInterpreter *interp;
239  UV clone_flags = 0;
240 
241  PERL_SET_CONTEXT(perl);
242 
243  interp = pthread_getspecific(*key);
244  if (interp) return interp;
245 
246  interp = perl_clone(perl, clone_flags);
247  {
248  dTHXa(interp);
249  }
250 # if PERL_REVISION >= 5 && PERL_VERSION <8
251  call_pv("CLONE",0);
252 # endif
253  ptr_table_free(PL_ptr_table);
254  PL_ptr_table = NULL;
255 
256  PERL_SET_CONTEXT(aTHX);
257  rlm_perl_clear_handles(aTHX);
258 
259  ret = pthread_setspecific(*key, interp);
260  if (ret != 0) {
261  DEBUG("rlm_perl: Failed associating interpretor with thread %s", fr_syserror(ret));
262 
263  rlm_perl_destruct(interp);
264  return NULL;
265  }
266 
267  return interp;
268 }
269 #endif
270 
271 /*
272  * This is wrapper for radlog
273  * Now users can call radiusd::radlog(level,msg) wich is the same
274  * calling radlog from C code.
275  */
276 static XS(XS_radiusd_radlog)
277 {
278  dXSARGS;
279  if (items !=2)
280  croak("Usage: radiusd::radlog(level, message)");
281  {
282  int level;
283  char *msg;
284 
285  level = (int) SvIV(ST(0));
286  msg = (char *) SvPV(ST(1), PL_na);
287 
288  /*
289  * Because 'msg' is a 'char *', we don't want '%s', etc.
290  * in it to give us printf-style vulnerabilities.
291  */
292  radlog(level, "rlm_perl: %s", msg);
293  }
294  XSRETURN_NO;
295 }
296 
297 static void xs_init(pTHX)
298 {
299  char const *file = __FILE__;
300 
301  /* DynaLoader is a special case */
302  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
303 
304  newXS("radiusd::radlog",XS_radiusd_radlog, "rlm_perl");
305 }
306 
307 /*
308  * The xlat function
309  */
310 static ssize_t perl_xlat(char **out, size_t outlen,
311  void const *mod_inst, UNUSED void const *xlat_inst,
312  REQUEST *request, char const *fmt)
313 {
314 
315  rlm_perl_t *inst;
316  char *tmp;
317  char const *p, *q;
318  int count;
319  size_t ret = 0;
320  STRLEN n_a;
321 
322  memcpy(&inst, &mod_inst, sizeof(inst));
323 
324 #ifdef USE_ITHREADS
325  PerlInterpreter *interp;
326 
327  pthread_mutex_lock(&inst->clone_mutex);
328  interp = rlm_perl_clone(inst->perl, inst->thread_key);
329  {
330  dTHXa(interp);
331  PERL_SET_CONTEXT(interp);
332  }
333  pthread_mutex_unlock(&inst->clone_mutex);
334 #else
335  PERL_SET_CONTEXT(inst->perl);
336 #endif
337  {
338  dSP;
339  ENTER;SAVETMPS;
340 
341  PUSHMARK(SP);
342 
343  p = q = fmt;
344  while (*p == ' ') {
345  p++;
346  q++;
347  }
348  while (*q) {
349  if (*q == ' ') {
350  XPUSHs(sv_2mortal(newSVpvn(p, q - p)));
351  p = q + 1;
352 
353  /*
354  * Don't use an empty string
355  */
356  while (*p == ' ') p++;
357  q = p;
358  }
359  q++;
360  }
361 
362  /*
363  * And the last bit.
364  */
365  if (*p) {
366  XPUSHs(sv_2mortal(newSVpvn(p, strlen(p))));
367  }
368 
369  PUTBACK;
370 
371  count = call_pv(inst->func_xlat, G_SCALAR | G_EVAL);
372 
373  SPAGAIN;
374  if (SvTRUE(ERRSV)) {
375  REDEBUG("Exit %s", SvPV(ERRSV,n_a));
376  (void)POPs;
377  } else if (count > 0) {
378  tmp = POPp;
379  strlcpy(*out, tmp, outlen);
380  ret = strlen(*out);
381 
382  RDEBUG("Len is %zu , out is %s freespace is %zu", ret, *out, outlen);
383  }
384 
385  PUTBACK ;
386  FREETMPS ;
387  LEAVE ;
388 
389  }
390 
391  return ret;
392 }
393 
394 /*
395  * Parse a configuration section, and populate a HV.
396  * This function is recursively called (allows to have nested hashes.)
397  */
398 static void perl_parse_config(CONF_SECTION *cs, int lvl, HV *rad_hv)
399 {
400  if (!cs || !rad_hv) return;
401 
402  int indent_section = (lvl + 1) * 4;
403  int indent_item = (lvl + 2) * 4;
404 
405  DEBUG("%*s%s {", indent_section, " ", cf_section_name1(cs));
406 
407  CONF_ITEM *ci = NULL;
408 
409  while ((ci = cf_item_find_next(cs, ci))) {
410  /*
411  * This is a section.
412  * Create a new HV, store it as a reference in current HV,
413  * Then recursively call perl_parse_config with this section and the new HV.
414  */
415  if (cf_item_is_section(ci)) {
416  CONF_SECTION *sub_cs = cf_item_to_section(ci);
417  char const *key = cf_section_name1(sub_cs); /* hash key */
418  HV *sub_hv;
419  SV *ref;
420 
421  if (!key) continue;
422 
423  if (hv_exists(rad_hv, key, strlen(key))) {
424  WARN("rlm_perl: Ignoring duplicate config section '%s'", key);
425  continue;
426  }
427 
428  sub_hv = newHV();
429  ref = newRV_inc((SV*) sub_hv);
430 
431  (void)hv_store(rad_hv, key, strlen(key), ref, 0);
432 
433  perl_parse_config(sub_cs, lvl + 1, sub_hv);
434  } else if (cf_item_is_pair(ci)){
435  CONF_PAIR *cp = cf_item_to_pair(ci);
436  char const *key = cf_pair_attr(cp); /* hash key */
437  char const *value = cf_pair_value(cp); /* hash value */
438 
439  if (!key || !value) continue;
440 
441  /*
442  * This is an item.
443  * Store item attr / value in current HV.
444  */
445  if (hv_exists(rad_hv, key, strlen(key))) {
446  WARN("rlm_perl: Ignoring duplicate config item '%s'", key);
447  continue;
448  }
449 
450  (void)hv_store(rad_hv, key, strlen(key), newSVpvn(value, strlen(value)), 0);
451 
452  DEBUG("%*s%s = %s", indent_item, " ", key, value);
453  }
454  }
455 
456  DEBUG("%*s}", indent_section, " ");
457 }
458 
459 static int mod_bootstrap(CONF_SECTION *conf, void *instance)
460 {
461  rlm_perl_t *inst = instance;
462 
463  char const *xlat_name;
464 
465  xlat_name = cf_section_name2(conf);
466  if (!xlat_name) xlat_name = cf_section_name1(conf);
467 
468  xlat_register(inst, xlat_name, perl_xlat, NULL, NULL, 0, XLAT_DEFAULT_BUF_LEN);
469 
470  return 0;
471 }
472 
473 /*
474  * Do any per-module initialization that is separate to each
475  * configured instance of the module. e.g. set up connections
476  * to external databases, read configuration files, set up
477  * dictionary entries, etc.
478  *
479  * If configuration information is given in the config section
480  * that must be referenced in later calls, store a handle to it
481  * in *instance otherwise put a null pointer there.
482  *
483  * Setup a hashes wich we will use later
484  * parse a module and give him a chance to live
485  *
486  */
487 static int mod_instantiate(CONF_SECTION *conf, void *instance)
488 {
489  rlm_perl_t *inst = instance;
490  AV *end_AV;
491 
492  char const **embed_c; /* Stupid Perl and lack of const consistency */
493  char **embed;
494  char **envp = NULL;
495  int exitstatus = 0, argc=0;
496  char arg[] = "0";
497 
498  CONF_SECTION *cs;
499 
500 #ifdef USE_ITHREADS
501  /*
502  * Create pthread key. This key will be stored in instance
503  */
504  pthread_mutex_init(&inst->clone_mutex, NULL);
505 
506  inst->thread_key = rad_malloc(sizeof(*inst->thread_key));
507  memset(inst->thread_key,0,sizeof(*inst->thread_key));
508 
509  rlm_perl_make_key(inst->thread_key);
510 #endif
511 
512  /*
513  * Setup the argument array we pass to the perl interpreter
514  */
515  MEM(embed_c = talloc_zero_array(inst, char const *, 4));
516  memcpy(&embed, &embed_c, sizeof(embed));
517  embed_c[0] = NULL;
518  if (inst->perl_flags) {
519  embed_c[1] = inst->perl_flags;
520  embed_c[2] = inst->module;
521  embed_c[3] = arg;
522  argc = 4;
523  } else {
524  embed_c[1] = inst->module;
525  embed_c[2] = arg;
526  argc = 3;
527  }
528 
529  /*
530  * Create tweak the server's environment to support
531  * perl. Docs say only call this once... Oops.
532  */
533  PERL_SYS_INIT3(&argc, &embed, &envp);
534 
535  /*
536  * Allocate a new perl interpreter to do the parsing
537  */
538  if ((inst->perl = perl_alloc()) == NULL) {
539  ERROR("rlm_perl: No memory for allocating new perl !");
540  return -1;
541  }
542  perl_construct(inst->perl); /* ...and initialise it */
543 
544 #ifdef USE_ITHREADS
545  PL_perl_destruct_level = 2;
546 
547  {
548  dTHXa(inst->perl);
549  }
550  PERL_SET_CONTEXT(inst->perl);
551 #endif
552 
553 #if PERL_REVISION >= 5 && PERL_VERSION >=8
554  PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
555 #endif
556 
557  exitstatus = perl_parse(inst->perl, xs_init, argc, embed, NULL);
558 
559  end_AV = PL_endav;
560  PL_endav = (AV *)NULL;
561 
562  if (exitstatus) {
563  ERROR("rlm_perl: perl_parse failed: %s not found or has syntax errors", inst->module);
564  return -1;
565  }
566 
567  /* parse perl configuration sub-section */
568  cs = cf_section_sub_find(conf, "config");
569  if (cs) {
570  inst->rad_perlconf_hv = get_hv("RAD_PERLCONF", 1);
571  perl_parse_config(cs, 0, inst->rad_perlconf_hv);
572  }
573 
574  inst->perl_parsed = true;
575  perl_run(inst->perl);
576 
577  PL_endav = end_AV;
578 
579  return 0;
580 }
581 
582 static void perl_vp_to_svpvn_element(REQUEST *request, AV *av, VALUE_PAIR const *vp,
583  int *i, const char *hash_name, const char *list_name)
584 {
585  size_t len;
586 
587  char buffer[1024];
588 
589  switch (vp->da->type) {
590  case PW_TYPE_STRING:
591  RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i,
592  list_name, vp->da->name, vp->vp_strvalue);
593  av_push(av, newSVpvn(vp->vp_strvalue, vp->vp_length));
594  break;
595 
596  case PW_TYPE_OCTETS:
597  if (RDEBUG_ENABLED) {
598  char *hex;
599 
600  hex = fr_abin2hex(request, vp->vp_octets, vp->vp_length);
601  RDEBUG("$%s{'%s'}[%i] = &%s:%s -> 0x%s", hash_name, vp->da->name, *i,
602  list_name, vp->da->name, hex);
603  talloc_free(hex);
604  }
605  av_push(av, newSVpvn((char const *)vp->vp_octets, vp->vp_length));
606  break;
607 
608  default:
609  len = fr_pair_value_snprint(buffer, sizeof(buffer), vp, 0);
610  RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i,
611  list_name, vp->da->name, buffer);
612  av_push(av, newSVpvn(buffer, truncate_len(len, sizeof(buffer))));
613  break;
614  }
615  (*i)++;
616 }
617 
618 /*
619  * get the vps and put them in perl hash
620  * If one VP have multiple values it is added as array_ref
621  * Example for this is Cisco-AVPair that holds multiple values.
622  * Which will be available as array_ref in $RAD_REQUEST{'Cisco-AVPair'}
623  */
624 static void perl_store_vps(UNUSED TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR **vps, HV *rad_hv,
625  const char *hash_name, const char *list_name)
626 {
627  VALUE_PAIR *vp;
628 
629  hv_undef(rad_hv);
630 
631  vp_cursor_t cursor;
632 
633  RINDENT();
635  for (vp = fr_cursor_init(&cursor, vps);
636  vp;
637  vp = fr_cursor_next(&cursor)) {
638  VALUE_PAIR *next;
639 
640  char const *name;
641  char namebuf[256];
642  char buffer[1024];
643 
644  size_t len;
645 
646  /*
647  * Tagged attributes are added to the hash with name
648  * <attribute>:<tag>, others just use the normal attribute
649  * name as the key.
650  */
651  if (vp->da->flags.has_tag && (vp->tag != TAG_ANY)) {
652  snprintf(namebuf, sizeof(namebuf), "%s:%d", vp->da->name, vp->tag);
653  name = namebuf;
654  } else {
655  name = vp->da->name;
656  }
657 
658  /*
659  * We've sorted by type, then tag, so attributes of the
660  * same type/tag should follow on from each other.
661  */
662  if ((next = fr_cursor_next_peek(&cursor)) && ATTRIBUTE_EQ(vp, next)) {
663  int i = 0;
664  AV *av;
665 
666  av = newAV();
667  perl_vp_to_svpvn_element(request, av, vp, &i, hash_name, list_name);
668  do {
669  perl_vp_to_svpvn_element(request, av, next, &i, hash_name, list_name);
670  fr_cursor_next(&cursor);
671  } while ((next = fr_cursor_next_peek(&cursor)) && ATTRIBUTE_EQ(vp, next));
672  (void)hv_store(rad_hv, name, strlen(name), newRV_noinc((SV *)av), 0);
673 
674  continue;
675  }
676 
677  /*
678  * It's a normal single valued attribute
679  */
680  switch (vp->da->type) {
681  case PW_TYPE_STRING:
682  RDEBUG("$%s{'%s'} = &%s:%s -> '%s'", hash_name, vp->da->name, list_name,
683  vp->da->name, vp->vp_strvalue);
684  (void)hv_store(rad_hv, name, strlen(name), newSVpvn(vp->vp_strvalue, vp->vp_length), 0);
685  break;
686 
687  case PW_TYPE_OCTETS:
688  if (RDEBUG_ENABLED) {
689  char *hex;
690 
691  hex = fr_abin2hex(request, vp->vp_octets, vp->vp_length);
692  RDEBUG("$%s{'%s'} = &%s:%s -> 0x%s", hash_name, vp->da->name,
693  list_name, vp->da->name, hex);
694  talloc_free(hex);
695  }
696  (void)hv_store(rad_hv, name, strlen(name),
697  newSVpvn((char const *)vp->vp_octets, vp->vp_length), 0);
698  break;
699 
700  default:
701  len = fr_pair_value_snprint(buffer, sizeof(buffer), vp, 0);
702  RDEBUG("$%s{'%s'} = &%s:%s -> '%s'", hash_name, vp->da->name,
703  list_name, vp->da->name, buffer);
704  (void)hv_store(rad_hv, name, strlen(name),
705  newSVpvn(buffer, truncate_len(len, sizeof(buffer))), 0);
706  break;
707  }
708  }
709  REXDENT();
710 }
711 
712 /*
713  *
714  * Verify that a Perl SV is a string and save it in FreeRadius
715  * Value Pair Format
716  *
717  */
718 static int pairadd_sv(TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR **vps, char *key, SV *sv, FR_TOKEN op,
719  const char *hash_name, const char *list_name)
720 {
721  char *val;
722  VALUE_PAIR *vp;
723 
724  if (SvOK(sv)) {
725  STRLEN len;
726  val = SvPV(sv, len);
727  vp = fr_pair_make(ctx, vps, key, NULL, op);
728  if (!vp) {
729  fail:
730  REDEBUG("Failed to create pair %s:%s %s %s", list_name, key,
731  fr_int2str(fr_tokens_table, op, "<INVALID>"), val);
732  return -1;
733  }
734 
735  switch (vp->da->type) {
736  case PW_TYPE_STRING:
737  fr_pair_value_bstrncpy(vp, val, len);
738  break;
739 
740  case PW_TYPE_OCTETS:
741  fr_pair_value_memcpy(vp, (uint8_t const *)val, len);
742  break;
743 
744  default:
745  if (fr_pair_value_from_str(vp, val, len) < 0) goto fail;
746  }
747 
748  RDEBUG("&%s:%s %s $%s{'%s'} -> '%s'", list_name, key, fr_int2str(fr_tokens_table, op, "<INVALID>"),
749  hash_name, key, val);
750  return 0;
751  }
752  return -1;
753 }
754 
755 /*
756  * Gets the content from hashes
757  */
758 static int get_hv_content(TALLOC_CTX *ctx, REQUEST *request, HV *my_hv, VALUE_PAIR **vps,
759  const char *hash_name, const char *list_name)
760 {
761  SV *res_sv, **av_sv;
762  AV *av;
763  char *key;
764  I32 key_len, len, i, j;
765  int ret = 0;
766 
767  *vps = NULL;
768  for (i = hv_iterinit(my_hv); i > 0; i--) {
769  res_sv = hv_iternextsv(my_hv,&key,&key_len);
770  if (SvROK(res_sv) && (SvTYPE(SvRV(res_sv)) == SVt_PVAV)) {
771  av = (AV*)SvRV(res_sv);
772  len = av_len(av);
773  for (j = 0; j <= len; j++) {
774  av_sv = av_fetch(av, j, 0);
775  ret = pairadd_sv(ctx, request, vps, key, *av_sv, T_OP_ADD, hash_name, list_name) + ret;
776  }
777  } else ret = pairadd_sv(ctx, request, vps, key, res_sv, T_OP_EQ, hash_name, list_name) + ret;
778  }
779 
780  return ret;
781 }
782 
783 /*
784  * Call the function_name inside the module
785  * Store all vps in hashes %RAD_CONFIG %RAD_REPLY %RAD_REQUEST
786  *
787  */
788 static int do_perl(void *instance, REQUEST *request, char const *function_name)
789 {
790 
791  rlm_perl_t *inst = instance;
792  VALUE_PAIR *vp;
793  int exitstatus=0, count;
794  STRLEN n_a;
795 
796  HV *rad_reply_hv;
797  HV *rad_config_hv;
798  HV *rad_request_hv;
799  HV *rad_state_hv;
800 #ifdef WITH_PROXY
801  HV *rad_request_proxy_hv;
802  HV *rad_request_proxy_reply_hv;
803 #endif
804 
805  /*
806  * Radius has told us to call this function, but none
807  * is defined.
808  */
809  if (!function_name) return RLM_MODULE_FAIL;
810 
811 #ifdef USE_ITHREADS
812  pthread_mutex_lock(&inst->clone_mutex);
813 
814  PerlInterpreter *interp;
815 
816  interp = rlm_perl_clone(inst->perl,inst->thread_key);
817  {
818  dTHXa(interp);
819  PERL_SET_CONTEXT(interp);
820  }
821 
822  pthread_mutex_unlock(&inst->clone_mutex);
823 #else
824  PERL_SET_CONTEXT(inst->perl);
825 #endif
826 
827  {
828  dSP;
829 
830  ENTER;
831  SAVETMPS;
832 
833  rad_reply_hv = get_hv("RAD_REPLY", 1);
834  rad_config_hv = get_hv("RAD_CONFIG", 1);
835  rad_request_hv = get_hv("RAD_REQUEST", 1);
836  rad_state_hv = get_hv("RAD_STATE", 1);
837 
838  perl_store_vps(request->packet, request, &request->packet->vps, rad_request_hv, "RAD_REQUEST", "request");
839  perl_store_vps(request->reply, request, &request->reply->vps, rad_reply_hv, "RAD_REPLY", "reply");
840  perl_store_vps(request, request, &request->config, rad_config_hv, "RAD_CONFIG", "control");
841  perl_store_vps(request->state_ctx, request, &request->state, rad_state_hv, "RAD_STATE", "session-state");
842 
843 #ifdef WITH_PROXY
844  rad_request_proxy_hv = get_hv("RAD_REQUEST_PROXY",1);
845  rad_request_proxy_reply_hv = get_hv("RAD_REQUEST_PROXY_REPLY",1);
846 
847  if (request->proxy != NULL) {
848  perl_store_vps(request->proxy, request, &request->proxy->vps, rad_request_proxy_hv,
849  "RAD_REQUEST_PROXY", "proxy-request");
850  } else {
851  hv_undef(rad_request_proxy_hv);
852  }
853 
854  if (request->proxy_reply != NULL) {
855  perl_store_vps(request->proxy_reply, request, &request->proxy_reply->vps,
856  rad_request_proxy_reply_hv, "RAD_REQUEST_PROXY_REPLY", "proxy-reply");
857  } else {
858  hv_undef(rad_request_proxy_reply_hv);
859  }
860 #endif
861 
862  PUSHMARK(SP);
863  /*
864  * This way %RAD_xx can be pushed onto stack as sub parameters.
865  * XPUSHs( newRV_noinc((SV *)rad_request_hv) );
866  * XPUSHs( newRV_noinc((SV *)rad_reply_hv) );
867  * XPUSHs( newRV_noinc((SV *)rad_config_hv) );
868  * PUTBACK;
869  */
870 
871  count = call_pv(function_name, G_SCALAR | G_EVAL | G_NOARGS);
872 
873  SPAGAIN;
874 
875  if (SvTRUE(ERRSV)) {
876  RDEBUG("perl_embed:: module = %s , func = %s exit status= %s\n",
877  inst->module, function_name, SvPV(ERRSV,n_a));
878  (void)POPs;
879  }
880 
881  if (count == 1) {
882  exitstatus = POPi;
883  if (exitstatus >= 100 || exitstatus < 0) {
884  exitstatus = RLM_MODULE_FAIL;
885  }
886  }
887 
888 
889  PUTBACK;
890  FREETMPS;
891  LEAVE;
892 
893  vp = NULL;
894  if ((get_hv_content(request->packet, request, rad_request_hv, &vp, "RAD_REQUEST", "request")) == 0) {
895  fr_pair_list_free(&request->packet->vps);
896  request->packet->vps = vp;
897  vp = NULL;
898 
899  /*
900  * Update cached copies
901  */
902  request->username = fr_pair_find_by_num(request->packet->vps, 0, PW_USER_NAME, TAG_ANY);
903  request->password = fr_pair_find_by_num(request->packet->vps, 0, PW_USER_PASSWORD, TAG_ANY);
904  if (!request->password)
905  request->password = fr_pair_find_by_num(request->packet->vps, 0, PW_CHAP_PASSWORD,
906  TAG_ANY);
907  }
908 
909  if ((get_hv_content(request->reply, request, rad_reply_hv, &vp, "RAD_REPLY", "reply")) == 0) {
910  fr_pair_list_free(&request->reply->vps);
911  request->reply->vps = vp;
912  vp = NULL;
913  }
914 
915  if ((get_hv_content(request, request, rad_config_hv, &vp, "RAD_CONFIG", "control")) == 0) {
916  fr_pair_list_free(&request->config);
917  request->config = vp;
918  vp = NULL;
919  }
920 
921  if ((get_hv_content(request->state_ctx, request, rad_state_hv, &vp, "RAD_STATE", "session-state")) == 0) {
922  fr_pair_list_free(&request->state);
923  request->state = vp;
924  vp = NULL;
925  }
926 
927 #ifdef WITH_PROXY
928  if (request->proxy &&
929  (get_hv_content(request->proxy, request, rad_request_proxy_hv, &vp,
930  "RAD_REQUEST_PROXY", "proxy-request") == 0)) {
931  fr_pair_list_free(&request->proxy->vps);
932  request->proxy->vps = vp;
933  vp = NULL;
934  }
935 
936  if (request->proxy_reply &&
937  (get_hv_content(request->proxy_reply, request, rad_request_proxy_reply_hv, &vp,
938  "RAD_REQUEST_PROXY_REPLY", "proxy-reply") == 0)) {
939  fr_pair_list_free(&request->proxy_reply->vps);
940  request->proxy_reply->vps = vp;
941  vp = NULL;
942  }
943 #endif
944 
945  }
946  return exitstatus;
947 }
948 
949 #define RLM_PERL_FUNC(_x) static rlm_rcode_t CC_HINT(nonnull) mod_##_x(void *instance, REQUEST *request) \
950  { \
951  return do_perl(instance, request, \
952  ((rlm_perl_t *)instance)->func_##_x); \
953  }
954 
955 RLM_PERL_FUNC(authorize)
956 RLM_PERL_FUNC(authenticate)
957 RLM_PERL_FUNC(post_auth)
958 
959 RLM_PERL_FUNC(checksimul)
960 
961 #ifdef WITH_PROXY
962 RLM_PERL_FUNC(pre_proxy)
963 RLM_PERL_FUNC(post_proxy)
964 #endif
965 
966 #ifdef WITH_COA
967 RLM_PERL_FUNC(recv_coa)
968 RLM_PERL_FUNC(send_coa)
969 #endif
970 
971 RLM_PERL_FUNC(preacct)
972 
973 /*
974  * Write accounting information to this modules database.
975  */
976 static rlm_rcode_t CC_HINT(nonnull) mod_accounting(void *instance, REQUEST *request)
977 {
978  VALUE_PAIR *pair;
979  int acctstatustype=0;
980 
981  if ((pair = fr_pair_find_by_num(request->packet->vps, 0, PW_ACCT_STATUS_TYPE, TAG_ANY)) != NULL) {
982  acctstatustype = pair->vp_integer;
983  } else {
984  RDEBUG("Invalid Accounting Packet");
985  return RLM_MODULE_INVALID;
986  }
987 
988  switch (acctstatustype) {
989  case PW_STATUS_START:
990  if (((rlm_perl_t *)instance)->func_start_accounting) {
991  return do_perl(instance, request,
992  ((rlm_perl_t *)instance)->func_start_accounting);
993  } else {
994  return do_perl(instance, request,
995  ((rlm_perl_t *)instance)->func_accounting);
996  }
997 
998  case PW_STATUS_STOP:
999  if (((rlm_perl_t *)instance)->func_stop_accounting) {
1000  return do_perl(instance, request,
1001  ((rlm_perl_t *)instance)->func_stop_accounting);
1002  } else {
1003  return do_perl(instance, request,
1004  ((rlm_perl_t *)instance)->func_accounting);
1005  }
1006 
1007  default:
1008  return do_perl(instance, request,
1009  ((rlm_perl_t *)instance)->func_accounting);
1010  }
1011 }
1012 
1013 
1014 /*
1015  * Detach a instance give a chance to a module to make some internal setup ...
1016  */
1017 DIAG_OFF(nested-externs)
1018 static int mod_detach(void *instance)
1019 {
1020  rlm_perl_t *inst = (rlm_perl_t *) instance;
1021  int exitstatus = 0, count = 0;
1022 
1023  if (inst->rad_perlconf_hv != NULL) hv_undef(inst->rad_perlconf_hv);
1024 
1025  if (inst->perl_parsed && inst->func_detach) {
1026  dTHXa(inst->perl);
1027  PERL_SET_CONTEXT(inst->perl);
1028  {
1029  dSP; ENTER; SAVETMPS;
1030  PUSHMARK(SP);
1031 
1032  count = call_pv(inst->func_detach, G_SCALAR | G_EVAL );
1033  SPAGAIN;
1034 
1035  if (count == 1) {
1036  exitstatus = POPi;
1037  if (exitstatus >= 100 || exitstatus < 0) {
1038  exitstatus = RLM_MODULE_FAIL;
1039  }
1040  }
1041  PUTBACK;
1042  FREETMPS;
1043  LEAVE;
1044  }
1045  }
1046 
1047 #ifdef USE_ITHREADS
1048  rlm_perl_destruct(inst->perl);
1049  pthread_mutex_destroy(&inst->clone_mutex);
1050 #else
1051  perl_destruct(inst->perl);
1052  perl_free(inst->perl);
1053 #endif
1054 
1055  PERL_SYS_TERM();
1056  return exitstatus;
1057 }
1058 DIAG_ON(nested-externs)
1059 
1060 /*
1061  * The module name should be the only globally exported symbol.
1062  * That is, everything else should be 'static'.
1063  *
1064  * If the module needs to temporarily modify it's instantiation
1065  * data, the type should be changed to RLM_TYPE_THREAD_UNSAFE.
1066  * The server will then take care of ensuring that the module
1067  * is single-threaded.
1068  */
1069 extern module_t rlm_perl;
1070 module_t rlm_perl = {
1072  .name = "perl",
1073 #ifdef USE_ITHREADS
1074  .type = RLM_TYPE_THREAD_SAFE,
1075 #else
1076  .type = RLM_TYPE_THREAD_UNSAFE,
1077 #endif
1078  .inst_size = sizeof(rlm_perl_t),
1079  .config = module_config,
1080  .bootstrap = mod_bootstrap,
1081  .instantiate = mod_instantiate,
1082  .detach = mod_detach,
1083  .methods = {
1086  [MOD_PREACCT] = mod_preacct,
1089 #ifdef WITH_PROXY
1090  [MOD_PRE_PROXY] = mod_pre_proxy,
1091  [MOD_POST_PROXY] = mod_post_proxy,
1092 #endif
1094 #ifdef WITH_COA
1095  [MOD_RECV_COA] = mod_recv_coa,
1096  [MOD_SEND_COA] = mod_send_coa
1097 #endif
1098  },
1099 };
void fr_pair_list_free(VALUE_PAIR **)
Free memory used by a valuepair list.
Definition: pair.c:544
5 methods index for preproxy section.
Definition: modules.h:46
char const * module
Definition: rlm_perl.c:53
#define PW_TYPE_FILE_INPUT
File matching value must exist, and must be readable.
Definition: conffile.h:204
#define pthread_mutex_init(_x, _y)
Definition: rlm_eap.h:75
VALUE_PAIR * config
VALUE_PAIR (s) used to set per request parameters for modules and the server core at runtime...
Definition: radiusd.h:227
#define RINDENT()
Indent R* messages by one level.
Definition: log.h:265
char const * func_pre_proxy
Definition: rlm_perl.c:66
#define DIAG_ON(_x)
Definition: build.h:103
int xlat_register(void *mod_inst, char const *name, xlat_func_t func, xlat_escape_t escape, xlat_instantiate_t instantiate, size_t inst_size, size_t buf_len)
Register an xlat function.
Definition: xlat.c:717
static XS(XS_radiusd_radlog)
Definition: rlm_perl.c:276
static rlm_rcode_t mod_accounting(void *instance, REQUEST *request)
Write accounting data to Couchbase documents.
RADIUS_PACKET * proxy_reply
Incoming response from proxy server.
Definition: radiusd.h:238
EXTERN_C void boot_DynaLoader(pTHX_ CV *cv)
static rlm_rcode_t mod_post_auth(void *instance, REQUEST *request) CC_HINT(nonnull)
Metadata exported by the module.
Definition: modules.h:134
int radlog(log_type_t lvl, char const *fmt,...) CC_HINT(format(printf
#define RLM_TYPE_THREAD_UNSAFE
Module is not threadsafe.
Definition: modules.h:76
pthread_key_t * thread_key
Definition: rlm_perl.c:78
void * rad_malloc(size_t size)
Definition: util.c:411
#define MEM(x)
Definition: radiusd.h:396
7 methods index for postauth section.
Definition: modules.h:48
#define DIAG_OFF(_x)
Definition: build.h:102
static char const * name
#define RLM_PERL_FUNC(_x)
Definition: rlm_perl.c:949
static rlm_rcode_t mod_authorize(void *instance, REQUEST *request)
Handle authorization requests using Couchbase document data.
#define RLM_TYPE_THREAD_SAFE
Module is threadsafe.
Definition: modules.h:75
#define RDEBUG_ENABLED
True if request debug level 1 messages are enabled.
Definition: log.h:237
VALUE_PAIR * username
Cached username VALUE_PAIR from request RADIUS_PACKET.
Definition: radiusd.h:222
#define UNUSED
Definition: libradius.h:134
#define RLM_MODULE_INIT
Definition: modules.h:86
int8_t tag
Tag value used to group valuepairs.
Definition: pair.h:121
void size_t fr_pair_value_snprint(char *out, size_t outlen, VALUE_PAIR const *vp, char quote)
Print the value of an attribute to a string.
Definition: pair.c:2107
VALUE_PAIR * vps
Result of decoding the packet into VALUE_PAIRs.
Definition: libradius.h:162
#define CONF_PARSER_TERMINATOR
Definition: conffile.h:289
const FR_NAME_NUMBER fr_tokens_table[]
Definition: token.c:30
char * fr_abin2hex(TALLOC_CTX *ctx, uint8_t const *bin, size_t inlen)
Convert binary data to a hex string.
Definition: misc.c:278
VALUE_PAIR * fr_cursor_init(vp_cursor_t *cursor, VALUE_PAIR *const *node)
Setup a cursor to iterate over attribute pairs.
Definition: cursor.c:60
PUBLIC int snprintf(char *string, size_t length, char *format, va_alist)
Definition: snprintf.c:686
struct rlm_perl_t rlm_perl_t
VALUE_PAIR * password
Cached password VALUE_PAIR from request RADIUS_PACKET.
Definition: radiusd.h:223
#define PW_STATUS_START
Definition: radius.h:191
#define inst
Definition: token.h:46
The module considers the request invalid.
Definition: radiusd.h:93
#define XLAT_DEFAULT_BUF_LEN
Definition: xlat.h:89
bool perl_parsed
Definition: rlm_perl.c:77
CONF_SECTION * cf_item_to_section(CONF_ITEM const *item)
Cast a CONF_ITEM to a CONF_SECTION.
Definition: conffile.c:196
static rlm_rcode_t mod_authenticate(void *instance, REQUEST *request) CC_HINT(nonnull)
PerlInterpreter * perl
Definition: rlm_perl.c:76
Defines a CONF_PAIR to C data type mapping.
Definition: conffile.h:267
static int do_perl(void *instance, REQUEST *request, char const *function_name)
Definition: rlm_perl.c:788
Abstraction to allow iterating over different configurations of VALUE_PAIRs.
Definition: pair.h:144
fr_dict_attr_flags_t flags
Flags.
Definition: dict.h:88
char const * cf_pair_value(CONF_PAIR const *pair)
Definition: conffile.c:3506
#define RLM_PERL_CONF(_x)
Definition: rlm_perl.c:90
static void perl_vp_to_svpvn_element(REQUEST *request, AV *av, VALUE_PAIR const *vp, int *i, const char *hash_name, const char *list_name)
Definition: rlm_perl.c:582
static int pairadd_sv(TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR **vps, char *key, SV *sv, FR_TOKEN op, const char *hash_name, const char *list_name)
Definition: rlm_perl.c:718
RADIUS_PACKET * proxy
Outgoing request to proxy server.
Definition: radiusd.h:237
char const * perl_flags
Definition: rlm_perl.c:75
static void perl_store_vps(UNUSED TALLOC_CTX *ctx, REQUEST *request, VALUE_PAIR **vps, HV *rad_hv, const char *hash_name, const char *list_name)
Definition: rlm_perl.c:624
module_t rlm_perl
Definition: rlm_perl.c:1070
char const * func_xlat
Definition: rlm_perl.c:64
char const * fr_syserror(int num)
Guaranteed to be thread-safe version of strerror.
Definition: log.c:238
#define pthread_mutex_unlock(_x)
Definition: rlm_eap.h:78
static void xs_init(pTHX)
Definition: rlm_perl.c:297
char const * func_accounting
Definition: rlm_perl.c:58
char const * cf_pair_attr(CONF_PAIR const *pair)
Definition: conffile.c:3497
#define DEBUG(fmt,...)
Definition: log.h:175
bool cf_item_is_section(CONF_ITEM const *item)
Definition: conffile.c:3923
char const * func_detach
Definition: rlm_perl.c:63
CONF_PAIR * cf_item_to_pair(CONF_ITEM const *item)
Cast a CONF_ITEM to a CONF_PAIR.
Definition: conffile.c:181
4 methods index for checksimul section.
Definition: modules.h:45
TALLOC_CTX * state_ctx
for request->state
Definition: radiusd.h:230
Definition: token.h:43
HV * rad_perlconf_hv
holds "config" items (perl RAD_PERLCONF hash).
Definition: rlm_perl.c:84
3 methods index for accounting section.
Definition: modules.h:44
static int mod_detach(void *instance)
Definition: rlm_perl.c:1018
Stores an attribute, a value and various bits of other data.
Definition: pair.h:112
char const * xlat_name
Definition: rlm_perl.c:74
static rlm_rcode_t mod_checksimul(void *instance, REQUEST *request)
Check if a given user is already logged in.
RADIUS_PACKET * reply
Outgoing response.
Definition: radiusd.h:225
char const * func_stop_accounting
Definition: rlm_perl.c:60
int8_t fr_pair_cmp_by_da_tag(void const *a, void const *b)
Definition: pair.c:815
0 methods index for authenticate section.
Definition: modules.h:41
char const * func_post_proxy
Definition: rlm_perl.c:67
bool cf_item_is_pair(CONF_ITEM const *item)
Definition: conffile.c:3928
#define REXDENT()
Exdent (unindent) R* messages by one level.
Definition: log.h:272
Configuration AVP similar to a VALUE_PAIR.
Definition: conffile.c:82
enum rlm_rcodes rlm_rcode_t
Return codes indicating the result of the module call.
int fr_pair_value_from_str(VALUE_PAIR *vp, char const *value, size_t len)
Convert string value to native attribute value.
Definition: pair.c:1840
static rs_t * conf
Definition: radsniff.c:46
char const * func_preacct
Definition: rlm_perl.c:61
CONF_SECTION * cf_section_sub_find(CONF_SECTION const *, char const *name)
Find a sub-section in a section.
Definition: conffile.c:3708
char const * cf_section_name1(CONF_SECTION const *cs)
Definition: conffile.c:3592
#define val(x)
Definition: timestr.c:37
char const * func_checksimul
Definition: rlm_perl.c:62
static int mod_bootstrap(CONF_SECTION *conf, void *instance)
Definition: rlm_perl.c:459
char name[1]
Attribute name.
Definition: dict.h:89
#define ATTRIBUTE_EQ(_x, _y)
Definition: pair.h:199
uint64_t magic
Used to validate module struct.
Definition: modules.h:135
Module failed, don't reply.
Definition: radiusd.h:90
static void perl_parse_config(CONF_SECTION *cs, int lvl, HV *rad_hv)
Definition: rlm_perl.c:398
#define TAG_ANY
Definition: pair.h:191
void fr_pair_list_sort(VALUE_PAIR **vps, fr_cmp_t cmp)
Sort a linked list of VALUE_PAIRs using merge sort.
Definition: pair.c:1036
static rlm_rcode_t CC_HINT(nonnull)
Definition: rlm_perl.c:976
#define FR_CONF_OFFSET(_n, _t, _s, _f)
Definition: conffile.h:168
char const * func_authorize
Definition: rlm_perl.c:56
VALUE_PAIR * fr_cursor_next(vp_cursor_t *cursor)
Advanced the cursor to the next VALUE_PAIR.
Definition: cursor.c:263
VALUE_PAIR * state
VALUE_PAIR (s) available over the lifetime of the authentication attempt.
Definition: radiusd.h:231
RADIUS_PACKET * packet
Incoming request.
Definition: radiusd.h:221
#define WARN(fmt,...)
Definition: log.h:144
#define REDEBUG(fmt,...)
Definition: log.h:254
unsigned int has_tag
Tagged attribute.
Definition: dict.h:46
CONF_ITEM * cf_item_find_next(CONF_SECTION const *section, CONF_ITEM const *item)
Return the next item after a CONF_ITEM.
Definition: conffile.c:3850
#define truncate_len(_ret, _max)
Definition: libradius.h:205
6 methods index for postproxy section.
Definition: modules.h:47
2 methods index for preacct section.
Definition: modules.h:43
char const * func_start_accounting
Definition: rlm_perl.c:59
#define PW_TYPE_REQUIRED
Error out if no matching CONF_PAIR is found, and no dflt value is set.
Definition: conffile.h:200
VALUE_PAIR * fr_pair_find_by_num(VALUE_PAIR *head, unsigned int vendor, unsigned int attr, int8_t tag)
Find the pair with the matching attribute.
Definition: pair.c:639
8 methods index for recvcoa section.
Definition: modules.h:50
#define PW_STATUS_STOP
Definition: radius.h:192
static int get_hv_content(TALLOC_CTX *ctx, REQUEST *request, HV *my_hv, VALUE_PAIR **vps, const char *hash_name, const char *list_name)
Definition: rlm_perl.c:758
enum fr_token FR_TOKEN
VALUE_PAIR * fr_cursor_next_peek(vp_cursor_t *cursor)
Return the next VALUE_PAIR without advancing the cursor.
Definition: cursor.c:294
#define pthread_mutex_lock(_x)
Definition: rlm_eap.h:77
size_t strlcpy(char *dst, char const *src, size_t siz)
Definition: strlcpy.c:38
char const * fr_int2str(FR_NAME_NUMBER const *table, int number, char const *def)
Definition: token.c:506
static const CONF_PARSER module_config[]
Definition: rlm_perl.c:93
fr_dict_attr_t const * da
Dictionary attribute defines the attribute.
Definition: pair.h:113
void fr_pair_value_bstrncpy(VALUE_PAIR *vp, void const *src, size_t len)
Copy data into an "string" data type.
Definition: pair.c:2043
9 methods index for sendcoa section.
Definition: modules.h:51
static char const hex[]
Definition: smbencrypt.c:34
String of printable characters.
Definition: radius.h:33
PW_TYPE type
Value type.
Definition: dict.h:80
1 methods index for authorize section.
Definition: modules.h:42
#define pthread_mutex_destroy(_x)
Definition: rlm_eap.h:76
#define RCSID(id)
Definition: build.h:135
char const * func_send_coa
Definition: rlm_perl.c:72
VALUE_PAIR * fr_pair_make(TALLOC_CTX *ctx, VALUE_PAIR **vps, char const *attribute, char const *value, FR_TOKEN op)
Create a VALUE_PAIR from ASCII strings.
Definition: pair.c:338
#define RDEBUG(fmt,...)
Definition: log.h:243
#define ERROR(fmt,...)
Definition: log.h:145
Raw octets.
Definition: radius.h:38
void fr_pair_value_memcpy(VALUE_PAIR *vp, uint8_t const *src, size_t len)
Copy data into an "octets" data type.
Definition: pair.c:1905
char const * cf_section_name2(CONF_SECTION const *cs)
Definition: conffile.c:3601
char const * func_recv_coa
Definition: rlm_perl.c:71
char const * func_authenticate
Definition: rlm_perl.c:57
static int mod_instantiate(CONF_SECTION *conf, void *instance)
Definition: rlm_perl.c:487
char const * func_post_auth
Definition: rlm_perl.c:69
static ssize_t perl_xlat(char **out, size_t outlen, void const *mod_inst, UNUSED void const *xlat_inst, REQUEST *request, char const *fmt)
Definition: rlm_perl.c:310