rlm_perl.c File Reference

Translates requests between the server an a perl interpreter. More...

#include <freeradius-devel/server/base.h>
#include <freeradius-devel/server/module_rlm.h>
#include <freeradius-devel/util/debug.h>
#include <freeradius-devel/unlang/xlat_func.h>
#include <freeradius-devel/unlang/xlat.h>
#include <freeradius-devel/radius/radius.h>
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include <dlfcn.h>
#include <semaphore.h>

Include dependency graph for rlm_perl.c:

Go to the source code of this file.

Data Structures
struct	fr_perl_pair_s
struct	perl_call_env_t
struct	perl_func_def_t
struct	rlm_perl_t
struct	rlm_perl_thread_t

Macros
#define	dl_librefs   "DynaLoader::dl_librefs"
#define	dl_modules   "DynaLoader::dl_modules"
#define	GET_PAIR_MAGIC(count)
	Convenience macro for fetching C data associated with tied hash / array and validating stack size.
#define	LOAD_INFO(_fmt, ...)   fr_log(LOG_DST, L_INFO, __FILE__, __LINE__, "rlm_perl - " _fmt, ## __VA_ARGS__)
#define	LOAD_WARN(_fmt, ...)
#define	LOG_PREFIX   "perl"
#define	PERLINT(_size)
#define	PERLSETINT(_size)
#define	PERLSETUINT(_size)
#define	PERLUINT(_size)

Typedefs
typedef struct fr_perl_pair_s	fr_perl_pair_t

Functions
EXTERN_C void	boot_DynaLoader (pTHX_ CV *cv)
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	mod_bootstrap (module_inst_ctx_t const *mctx)
static int	mod_detach (module_detach_ctx_t const *mctx)
static int	mod_instantiate (module_inst_ctx_t const *mctx)
static int	mod_load (void)
static unlang_action_t	mod_perl (rlm_rcode_t *p_result, module_ctx_t const *mctx, request_t *request)
static int	mod_thread_detach (module_thread_inst_ctx_t const *mctx)
static int	mod_thread_instantiate (module_thread_inst_ctx_t const *mctx)
static void	mod_unload (void)
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.
static int8_t	perl_func_def_cmp (void const *one, void const *two)
	How to compare two Perl function calls.
static bool	perl_func_exists (char const *func)
	Check if a given Perl subroutine exists.
static void	perl_func_name_safe (char *name)
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 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.
static void	perl_parse_config (CONF_SECTION *cs, int lvl, HV *rad_hv)
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 int	perl_value_marshal (fr_pair_t *vp, SV **value)
	Functions to implement subroutines required for a tied array.
static int	perl_value_unmarshal (fr_pair_t *vp, SV *value)
	Convert a Perl SV to a pair value.
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 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.
static void	rlm_perl_clear_handles (pTHX)
static void	rlm_perl_close_handles (void **handles)
static void **	rlm_perl_get_handles (pTHX)
static void	rlm_perl_interp_free (PerlInterpreter *perl)
static	XS (XS_freeradius_log)
static	XS (XS_freeradius_xlat)
static	XS (XS_pairlist_DELETE)
	Called to delete a key from a tied hash.
static	XS (XS_pairlist_EXISTS)
	Called to test the existence of a key in a tied hash.
static	XS (XS_pairlist_FETCH)
	Functions to implement subroutines required for a tied hash.
static	XS (XS_pairlist_FIRSTKEY)
	Called when functions like keys() want the first key in a tied hash.
static	XS (XS_pairlist_NEXTKEY)
	Called by functions like keys() which iterate over the keys in a tied hash.
static	XS (XS_pairlist_STORE)
	Called when a hash value is set / updated.
static	XS (XS_pairs_DELETE)
	Called when an array entry is deleted.
static	XS (XS_pairs_EXISTS)
	Called when an array entry's existence is tested.
static	XS (XS_pairs_FETCH)
	Called to retrieve the value of an array entry.
static	XS (XS_pairs_FETCHSIZE)
	Called when Perl wants the size of a tied array.
static	XS (XS_pairs_POP)
	Called when values are popped off a tied array.
static	XS (XS_pairs_PUSH)
	Called when values are pushed on a tied array.
static	XS (XS_pairs_SHIFT)
	Called when values are "shifted" off a tied array.
static	XS (XS_pairs_STORE)
	Called when an array value is set / updated.
static	XS (XS_pairs_STORESIZE)
	Called when attempting to set the size of an array.
static	XS (XS_pairs_UNSHIFT)
	Called when values are "unshifted" onto a tied array.
static void	xs_init (pTHX)

Variables
static const conf_parser_t	module_config []
static void *	perl_dlhandle
	To allow us to load perl's symbols into the global symbol table.
static const call_env_method_t	perl_method_env
static xlat_arg_parser_t const	perl_xlat_args []
module_rlm_t	rlm_perl
static _Thread_local request_t *	rlm_perl_request
static MGVTBL	rlm_perl_vtbl = { 0, 0, 0, 0, 0, 0, 0, 0 }

Detailed Description

Translates requests between the server an a perl interpreter.

Id

a2274be672fffeecf13232a49d3a91a289a56d87

Copyright

2002,2006 The FreeRADIUS server project

2002 Boian Jordanov (bjord.nosp@m.anov.nosp@m.@orbi.nosp@m.tel..nosp@m.bg)

Definition in file rlm_perl.c.

---

Data Structure Documentation

fr_perl_pair_s

struct fr_perl_pair_s

Definition at line 97 of file rlm_perl.c.

Collaboration diagram for fr_perl_pair_s:

Data Fields
fr_dcursor_t	cursor	Cursor used for iterating over the keys of a tied hash.
fr_dict_attr_t const *	da	Dictionary attribute associated with hash / array.
unsigned int	idx	Instance number.
fr_perl_pair_t *	parent	Parent attribute data.
fr_pair_t *	vp	Real pair associated with the hash / array, if it exists.

perl_call_env_t

struct perl_call_env_t

Definition at line 64 of file rlm_perl.c.

Collaboration diagram for perl_call_env_t:

Data Fields
perl_func_def_t *	func

perl_func_def_t

struct perl_func_def_t

Definition at line 57 of file rlm_perl.c.

Collaboration diagram for perl_func_def_t:

Data Fields
char const *	function_name	Name of the function being called.
char *	name1	Section name1 where this is called.
char *	name2	Section name2 where this is called.
fr_rb_node_t	node	Node in tree of function calls.

rlm_perl_t

struct rlm_perl_t

Definition at line 75 of file rlm_perl.c.

Collaboration diagram for rlm_perl_t:

Data Fields
char const *	func_detach	Function to run when mod_detach is run.
char const *fr_rb_tree_t	funcs	Tree of function calls found by call_env parser.
bool	funcs_init	Has the tree been initialised.
PerlInterpreter *	perl
char const *	perl_flags
bool	perl_parsed
HV *	rad_perlconf_hv	holds "config" items (perl RAD_PERLCONF hash).

rlm_perl_thread_t

struct rlm_perl_thread_t

Definition at line 89 of file rlm_perl.c.

Data Fields
PerlInterpreter *	perl	Thread specific perl interpreter.

Macro Definition Documentation

dl_librefs

#define dl_librefs   "DynaLoader::dl_librefs"

Definition at line 148 of file rlm_perl.c.

dl_modules

#define dl_modules   "DynaLoader::dl_modules"

Definition at line 149 of file rlm_perl.c.

GET_PAIR_MAGIC

#define GET_PAIR_MAGIC

(

count

)

Value:

        MAGIC *mg = mg_findext(ST(0), PERL_MAGIC_ext, &rlm_perl_vtbl); \
        fr_perl_pair_t *pair_data; \
        if (unlikely(items < count)) { \
                croak("Expected %d stack entries, got %d", count, items); \
                XSRETURN_UNDEF; \
        } \
        if (!mg) { \
                croak("Failed to find Perl magic value"); \
                XSRETURN_UNDEF; \
        } \
        pair_data = (fr_perl_pair_t *)mg->mg_ptr;

Convenience macro for fetching C data associated with tied hash / array and validating stack size.

Definition at line 288 of file rlm_perl.c.

LOAD_INFO

#define LOAD_INFO	(		_fmt,
			...
	)		fr_log(LOG_DST, L_INFO, __FILE__, __LINE__, "rlm_perl - " _fmt, ## __VA_ARGS__)

LOAD_WARN

#define LOAD_WARN	(		_fmt,
			...
	)

Value:

                                           fr_log_perror(LOG_DST, L_WARN, __FILE__, __LINE__, \
                                           &(fr_log_perror_format_t){ \
                                                .first_prefix = "rlm_perl - ", \
                                                .subsq_prefix = "rlm_perl - ", \
                                           }, \
                                           _fmt,  ## __VA_ARGS__)

LOG_PREFIX

#define LOG_PREFIX   "perl"

Definition at line 27 of file rlm_perl.c.

PERLINT

#define PERLINT

(

_size

)

Value:

                case FR_TYPE_INT ## _size: \
                *value = sv_2mortal(newSViv(vp->vp_int ## _size)); \
                break;

PERLSETINT

#define PERLSETINT

(

_size

)

Value:

        case FR_TYPE_INT ## _size: \
        vp->vp_int ## _size = SvIV(value); \
        break;

PERLSETUINT

#define PERLSETUINT

(

_size

)

Value:

        case FR_TYPE_UINT ## _size: \
        vp->vp_uint ## _size = SvUV(value); \
        break;

PERLUINT

#define PERLUINT

(

_size

)

Value:

                case FR_TYPE_UINT ## _size: \
                *value = sv_2mortal(newSVuv(vp->vp_uint ## _size)); \
                break;

Typedef Documentation

fr_perl_pair_t

typedef struct fr_perl_pair_s fr_perl_pair_t

Definition at line 96 of file rlm_perl.c.

Function Documentation

boot_DynaLoader()

EXTERN_C void boot_DynaLoader

(

pTHX_ CV *

cv

)

Here is the caller graph for this function:

fr_perl_pair_parent_build()

static int fr_perl_pair_parent_build ( fr_perl_pair_t *  pair_data )

static

Build parent structural pairs needed when a leaf node is set.

Definition at line 653 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

mod_bootstrap()

static int mod_bootstrap ( module_inst_ctx_t const *  mctx )

static

Definition at line 1787 of file rlm_perl.c.

Here is the call graph for this function:

mod_detach()

static int mod_detach ( module_detach_ctx_t const *  mctx )

static

Definition at line 1751 of file rlm_perl.c.

Here is the call graph for this function:

mod_instantiate()

static int mod_instantiate ( module_inst_ctx_t const *  mctx )

static

Definition at line 1620 of file rlm_perl.c.

Here is the call graph for this function:

mod_load()

static int mod_load ( void  )

static

Definition at line 1797 of file rlm_perl.c.

Here is the call graph for this function:

mod_perl()

static unlang_action_t mod_perl ( rlm_rcode_t *  p_result, module_ctx_t const *  mctx, request_t *  request  )

static

Definition at line 1445 of file rlm_perl.c.

Here is the call graph for this function:

mod_thread_detach()

static int mod_thread_detach ( module_thread_inst_ctx_t const *  mctx )

static

Definition at line 1579 of file rlm_perl.c.

Here is the call graph for this function:

mod_thread_instantiate()

static int mod_thread_instantiate ( module_thread_inst_ctx_t const *  mctx )

static

Definition at line 1552 of file rlm_perl.c.

Here is the call graph for this function:

mod_unload()

static void mod_unload ( void  )

static

Definition at line 1838 of file rlm_perl.c.

perl_attr_lookup()

static fr_dict_attr_t const * perl_attr_lookup ( fr_perl_pair_t *  pair_data, char const *  attr  )

inlinestatic

Helper function for turning hash keys into dictionary attributes.

Definition at line 269 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_func_def_cmp()

static int8_t perl_func_def_cmp ( void const *  one, void const *  two  )

static

How to compare two Perl function calls.

Definition at line 128 of file rlm_perl.c.

Here is the caller graph for this function:

perl_func_exists()

static bool perl_func_exists ( char const *  func )

static

Check if a given Perl subroutine exists.

Definition at line 1591 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_func_name_safe()

static void perl_func_name_safe ( char *  name )

static

Definition at line 1848 of file rlm_perl.c.

Here is the caller graph for this function:

perl_func_parse()

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

Definition at line 1860 of file rlm_perl.c.

Here is the call graph for this function:

perl_pair_list_tie()

static void perl_pair_list_tie ( HV *  parent, HV *  frpair_stash, char const *  name, fr_pair_t *  vp, fr_dict_attr_t const *  da  )

static

Create a Perl tied hash representing a pair list.

Definition at line 1418 of file rlm_perl.c.

Here is the caller graph for this function:

perl_parse_config()

static void perl_parse_config ( CONF_SECTION *  cs, int  lvl, HV *  rad_hv  )

static

Definition at line 1356 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_sv_to_vblist()

static int perl_sv_to_vblist ( TALLOC_CTX *  ctx, fr_value_box_list_t *  list, request_t *  request, SV *  sv  )

static

Parse a Perl SV and create value boxes, appending to a list.

For parsing values passed back from a Perl subroutine

When hashes are returned, first the key is added as a value box then the value

Parameters

[in]	ctx	to allocate boxes in.
[out]	list	to append value boxes to.
[in]	request	being handled - only used for debug messages
[in]	sv	to parse

Returns

• 0 on success
• -1 on failure

Definition at line 1112 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_value_marshal()

static int perl_value_marshal ( fr_pair_t *  vp, SV **  value  )

static

Functions to implement subroutines required for a tied array.

Leaf attributes are represented by tied arrays to allow multiple instances.

Definition at line 547 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_value_unmarshal()

static int perl_value_unmarshal ( fr_pair_t *  vp, SV *  value  )

static

Convert a Perl SV to a pair value.

Definition at line 689 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

perl_vblist_to_av()

static int perl_vblist_to_av ( AV *  av, fr_value_box_list_t *  head  )

static

Convert a list of value boxes to a Perl array for passing to subroutines.

The Perl array object should be created before calling this to populate it.

Parameters

[in,out]	av	Perl array object to append values to.
[in]	head	of VB list.

Returns

• 0 on success
• -1 on failure

Definition at line 1058 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

rlm_perl_clear_handles()

static void rlm_perl_clear_handles ( pTHX  )

static

Definition at line 150 of file rlm_perl.c.

Here is the caller graph for this function:

rlm_perl_close_handles()

static void rlm_perl_close_handles ( void **  handles )

static

Definition at line 192 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

rlm_perl_get_handles()

static void ** rlm_perl_get_handles ( pTHX  )

static

Definition at line 158 of file rlm_perl.c.

Here is the caller graph for this function:

rlm_perl_interp_free()

static void rlm_perl_interp_free ( PerlInterpreter *  perl )

static

Definition at line 1524 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

XS() [1/18]

static XS ( XS_freeradius_log  )

static

Definition at line 213 of file rlm_perl.c.

Here is the call graph for this function:

XS() [2/18]

static XS ( XS_freeradius_xlat  )

static

Definition at line 241 of file rlm_perl.c.

Here is the call graph for this function:

XS() [3/18]

static XS ( XS_pairlist_DELETE  )

static

Called to delete a key from a tied hash.

The stack contains

• the tied SV
• the key being deleted

Definition at line 521 of file rlm_perl.c.

Here is the call graph for this function:

XS() [4/18]

static XS ( XS_pairlist_EXISTS  )

static

Called to test the existence of a key in a tied hash.

The stack contains

• the tied SV
• the key to check for

Definition at line 441 of file rlm_perl.c.

Here is the call graph for this function:

XS() [5/18]

static XS ( XS_pairlist_FETCH  )

static

Functions to implement subroutines required for a tied hash.

All structural components of attributes are represented by tied hashes Called when fetching hash values

The stack contains

• the tied SV
• the hash key being requested

When a numeric key is requested, we treat that as in instruction to find a specific instance of the key of the parent.

Whilst this is a bit odd, the alternative would be for every attribute to be returned as an array so you would end up with crazy syntax like p{'request'}{'Vendor-Specific'}[0]{'Cisco'}[0]{'AVPair}[0]

Definition at line 318 of file rlm_perl.c.

Here is the call graph for this function:

XS() [6/18]

static XS ( XS_pairlist_FIRSTKEY  )

static

Called when functions like keys() want the first key in a tied hash.

The stack contains just the tied SV

Definition at line 481 of file rlm_perl.c.

XS() [7/18]

static XS ( XS_pairlist_NEXTKEY  )

static

Called by functions like keys() which iterate over the keys in a tied hash.

The stack contains

• the tied SV
• the previous key

Definition at line 500 of file rlm_perl.c.

Here is the call graph for this function:

XS() [8/18]

static XS ( XS_pairlist_STORE  )

static

Called when a hash value is set / updated.

This is not allowed - only leaf node arrays can have values set

Definition at line 415 of file rlm_perl.c.

Here is the call graph for this function:

XS() [9/18]

static XS ( XS_pairs_DELETE  )

static

Called when an array entry is deleted.

Definition at line 821 of file rlm_perl.c.

Here is the call graph for this function:

XS() [10/18]

static XS ( XS_pairs_EXISTS  )

static

Called when an array entry's existence is tested.

Definition at line 801 of file rlm_perl.c.

Here is the call graph for this function:

XS() [11/18]

static XS ( XS_pairs_FETCH  )

static

Called to retrieve the value of an array entry.

In our case, retrieve the value of a specific instance of a leaf attribute

The stack contains

• the tied SV
• the index to retrieve

The magic data will hold the DA of the attribute.

Definition at line 630 of file rlm_perl.c.

Here is the call graph for this function:

XS() [12/18]

static XS ( XS_pairs_FETCHSIZE  )

static

Called when Perl wants the size of a tied array.

The stack contains just the tied SV

Definition at line 842 of file rlm_perl.c.

Here is the call graph for this function:

XS() [13/18]

static XS ( XS_pairs_POP  )

static

Called when values are popped off a tied array.

The stack contains just the tied SV

Definition at line 929 of file rlm_perl.c.

Here is the call graph for this function:

XS() [14/18]

static XS ( XS_pairs_PUSH  )

static

Called when values are pushed on a tied array.

The stack contains

• the tied SV
• one or more values being pushed onto the array

Definition at line 901 of file rlm_perl.c.

Here is the call graph for this function:

XS() [15/18]

static XS ( XS_pairs_SHIFT  )

static

Called when values are "shifted" off a tied array.

The stack contains just the tied SV

Definition at line 955 of file rlm_perl.c.

Here is the call graph for this function:

XS() [16/18]

static XS ( XS_pairs_STORE  )

static

Called when an array value is set / updated.

The stack contains

• the tied SV
• the index being updated
• the value being assigned

Definition at line 755 of file rlm_perl.c.

Here is the call graph for this function:

XS() [17/18]

static XS ( XS_pairs_STORESIZE  )

static

Called when attempting to set the size of an array.

We don't allow expanding the array this way, but will allow deleting pairs

The stack contains

• the tied SV
• the requested size of the array

Definition at line 859 of file rlm_perl.c.

Here is the call graph for this function:

XS() [18/18]

static XS ( XS_pairs_UNSHIFT  )

static

Called when values are "unshifted" onto a tied array.

The stack contains

• the tied SV
• one or more values being shifted onto the array

Definition at line 983 of file rlm_perl.c.

Here is the call graph for this function:

xs_init()

static void xs_init ( pTHX  )

static

Definition at line 1010 of file rlm_perl.c.

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

module_config

const conf_parser_t module_config[]

static

Initial value:

= {
        { FR_CONF_OFFSET_FLAGS("filename", CONF_FLAG_FILE_INPUT | CONF_FLAG_REQUIRED, rlm_perl_t, module) },
 
        { FR_CONF_OFFSET("func_detach", rlm_perl_t, func_detach), .data = NULL, .dflt = "detach", .quote = T_INVALID },
 
        { FR_CONF_OFFSET("perl_flags", rlm_perl_t, perl_flags) },
 
        CONF_PARSER_TERMINATOR
}

Definition at line 115 of file rlm_perl.c.

perl_dlhandle

void* perl_dlhandle

static

To allow us to load perl's symbols into the global symbol table.

Definition at line 110 of file rlm_perl.c.

perl_method_env

const call_env_method_t perl_method_env

static

Initial value:

= {
        FR_CALL_ENV_METHOD_OUT(perl_call_env_t),
        .env = (call_env_parser_t[]) {
                { FR_CALL_ENV_SUBSECTION_FUNC(CF_IDENT_ANY, CF_IDENT_ANY, CALL_ENV_FLAG_PARSE_MISSING, perl_func_parse) },
                CALL_ENV_TERMINATOR
        }
}

Definition at line 1909 of file rlm_perl.c.

perl_xlat_args

xlat_arg_parser_t const perl_xlat_args[]

static

Initial value:

= {
        { .required = true, .single = true, .type = FR_TYPE_STRING },
        { .variadic = XLAT_ARG_VARIADIC_EMPTY_KEEP, .type = FR_TYPE_VOID },
        XLAT_ARG_PARSER_TERMINATOR
}

Definition at line 1219 of file rlm_perl.c.

rlm_perl

module_rlm_t rlm_perl

Initial value:

= {
        .common = {
                .magic                  = MODULE_MAGIC_INIT,
                .name                   = "perl",
                .inst_size              = sizeof(rlm_perl_t),
 
                .config                 = module_config,
                .onload                 = mod_load,
                .unload                 = mod_unload,
                .bootstrap              = mod_bootstrap,
                .instantiate            = mod_instantiate,
                .detach                 = mod_detach,
 
                .thread_inst_size       = sizeof(rlm_perl_thread_t),
                .thread_instantiate     = mod_thread_instantiate,
                .thread_detach          = mod_thread_detach,
        },
        .method_group = {
                .bindings = (module_method_binding_t[]){
                        { .section = SECTION_NAME(CF_IDENT_ANY, CF_IDENT_ANY), .method = mod_perl, .method_env = &perl_method_env },
                        MODULE_BINDING_TERMINATOR
                }
        }
}

Definition at line 1927 of file rlm_perl.c.

rlm_perl_request

_Thread_local request_t* rlm_perl_request

static

Definition at line 146 of file rlm_perl.c.

rlm_perl_vtbl

MGVTBL rlm_perl_vtbl = { 0, 0, 0, 0, 0, 0, 0, 0 }

static

Definition at line 108 of file rlm_perl.c.