X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=src%2Fperl.c;h=1ed9d003d12ad84d3ce105fd18bdca70f8c6931d;hb=bc6790409971d84b1c8aa7201667c869e155e03b;hp=0c5e8829556c17b70a1e62ca4604ba454f4de7cd;hpb=06adec208286b5a136ffa5c5f3832c35e9f62844;p=collectd.git diff --git a/src/perl.c b/src/perl.c index 0c5e8829..1ed9d003 100644 --- a/src/perl.c +++ b/src/perl.c @@ -25,8 +25,6 @@ */ #include "collectd.h" -#include "common.h" -#include "plugin.h" #include "configfile.h" @@ -35,6 +33,15 @@ #include +/* Some versions of Perl define their own version of DEBUG... :-/ */ +#ifdef DEBUG +# undef DEBUG +#endif /* DEBUG */ + +/* ... while we want the definition found in plugin.h. */ +#include "plugin.h" +#include "common.h" + #define PLUGIN_INIT 0 #define PLUGIN_READ 1 #define PLUGIN_WRITE 2 @@ -46,64 +53,61 @@ #define PLUGIN_DATASET 255 #define log_debug(...) DEBUG ("perl: " __VA_ARGS__) +#define log_info(...) INFO ("perl: " __VA_ARGS__) #define log_warn(...) WARNING ("perl: " __VA_ARGS__) #define log_err(...) ERROR ("perl: " __VA_ARGS__) - /* this is defined in DynaLoader.a */ void boot_DynaLoader (PerlInterpreter *, CV *); -static XS (Collectd_plugin_register); -static XS (Collectd_plugin_unregister); +static XS (Collectd_plugin_register_ds); +static XS (Collectd_plugin_unregister_ds); static XS (Collectd_plugin_dispatch_values); - - -/* - * private data types - */ - -typedef struct { - int len; - int *values; -} ds_types_t; - -typedef struct { - int wait_time; - int wait_left; - - SV *sub; -} pplugin_t; - +static XS (Collectd_plugin_log); /* * private variables */ -/* valid configuration file keys */ -static const char *config_keys[] = -{ - "LoadPlugin", - NULL -}; -static int config_keys_num = 1; - static PerlInterpreter *perl = NULL; -static char *plugin_types[] = { "init", "read", "write", "shutdown" }; -static HV *plugins[PLUGIN_TYPES]; -static HV *data_sets; +static int perl_argc = 0; +static char **perl_argv = NULL; + +static char base_name[DATA_MAX_NAME_LEN] = ""; static struct { char name[64]; XS ((*f)); } api[] = { - { "Collectd::plugin_register", Collectd_plugin_register }, - { "Collectd::plugin_unregister", Collectd_plugin_unregister }, - { "Collectd::plugin_dispatch_values", Collectd_plugin_dispatch_values }, + { "Collectd::plugin_register_data_set", Collectd_plugin_register_ds }, + { "Collectd::plugin_unregister_data_set", Collectd_plugin_unregister_ds }, + { "Collectd::plugin_dispatch_values", Collectd_plugin_dispatch_values }, + { "Collectd::plugin_log", Collectd_plugin_log }, { "", NULL } }; +struct { + char name[64]; + int value; +} constants[] = +{ + { "Collectd::TYPE_INIT", PLUGIN_INIT }, + { "Collectd::TYPE_READ", PLUGIN_READ }, + { "Collectd::TYPE_WRITE", PLUGIN_WRITE }, + { "Collectd::TYPE_SHUTDOWN", PLUGIN_SHUTDOWN }, + { "Collectd::TYPE_LOG", PLUGIN_LOG }, + { "Collectd::TYPE_DATASET", PLUGIN_DATASET }, + { "Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER }, + { "Collectd::DS_TYPE_GAUGE", DS_TYPE_GAUGE }, + { "Collectd::LOG_ERR", LOG_ERR }, + { "Collectd::LOG_WARNING", LOG_WARNING }, + { "Collectd::LOG_NOTICE", LOG_NOTICE }, + { "Collectd::LOG_INFO", LOG_INFO }, + { "Collectd::LOG_DEBUG", LOG_DEBUG }, + { "", 0 } +}; /* * Helper functions for data type conversion. @@ -163,9 +167,7 @@ static int hv2data_source (HV *hash, data_source_t *ds) static int av2value (char *name, AV *array, value_t *value, int len) { - SV **tmp = NULL; - - ds_types_t *ds = NULL; + const data_set_t *ds; int i = 0; @@ -178,23 +180,22 @@ static int av2value (char *name, AV *array, value_t *value, int len) if (0 >= len) return -1; - tmp = Perl_hv_fetch (perl, data_sets, name, strlen (name), 0); - if (NULL == tmp) { - log_err ("av2value: No dataset for \"%s\".", name); + ds = plugin_get_ds (name); + if (NULL == ds) { + log_err ("av2value: Unknown dataset \"%s\"", name); return -1; } - ds = (ds_types_t *)SvIV ((SV *)SvRV (*tmp)); - if (ds->len < len) { + if (ds->ds_num < len) { log_warn ("av2value: Value length exceeds data set length."); - len = ds->len; + len = ds->ds_num; } for (i = 0; i < len; ++i) { SV **tmp = Perl_av_fetch (perl, array, i, 0); if (NULL != tmp) { - if (DS_TYPE_COUNTER == ds->values[i]) + if (DS_TYPE_COUNTER == ds->ds[i].type) value[i].counter = SvIV (*tmp); else value[i].gauge = SvNV (*tmp); @@ -308,66 +309,21 @@ static int value_list2hv (value_list_t *vl, data_set_t *ds, HV *hash) return 0; } /* static int value2av (value_list_t *, data_set_t *, HV *) */ - /* * Internal functions. */ -/* - * Add a new plugin with the given name. - */ -static int pplugin_register (int type, const char *name, SV *sub) -{ - pplugin_t *p = NULL; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (NULL == name) - return -1; - - p = (pplugin_t *)smalloc (sizeof (pplugin_t)); - /* this happens during parsing of config file, - * thus interval_g is not set correctly */ - p->wait_time = 10; - p->wait_left = 0; - p->sub = Perl_newSVsv (perl, sub); - - if (NULL == Perl_hv_store (perl, plugins[type], name, strlen (name), - Perl_sv_setref_pv (perl, Perl_newSV (perl, 0), 0, p), 0)) { - log_debug ("pplugin_register: Failed to add plugin \"%s\" (\"%s\")", - name, SvPV_nolen (sub)); - Perl_sv_free (perl, p->sub); - sfree (p); - return -1; - } - return 0; -} /* static int pplugin_register (int, char *, SV *) */ - -/* - * Removes the plugin with the given name and frees any ressources. - */ -static int pplugin_unregister (int type, char *name) -{ - SV *tmp = NULL; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (NULL == name) - return -1; - - /* freeing the allocated memory of the element itself (pplugin_t *) causes - * a segfault during perl_destruct () thus I assume perl somehow takes - * care of this... */ - - tmp = Perl_hv_delete (perl, plugins[type], name, strlen (name), 0); - if (NULL != tmp) { - pplugin_t *p = (pplugin_t *)SvIV ((SV *)SvRV (tmp)); - Perl_sv_free (perl, p->sub); - } - return 0; -} /* static int pplugin_unregister (char *) */ +static char *get_module_name (char *buf, size_t buf_len, const char *module) { + int status = 0; + if (base_name[0] == '\0') + status = snprintf (buf, buf_len, "%s", module); + else + status = snprintf (buf, buf_len, "%s::%s", base_name, module); + if ((status < 0) || (status >= buf_len)) + return (NULL); + buf[buf_len - 1] = '\0'; + return (buf); +} /* char *get_module_name */ /* * Add a plugin's data set definition. @@ -380,8 +336,6 @@ static int pplugin_register_data_set (char *name, AV *dataset) data_source_t *ds = NULL; data_set_t *set = NULL; - ds_types_t *types = NULL; - if ((NULL == name) || (NULL == dataset)) return -1; @@ -393,10 +347,6 @@ static int pplugin_register_data_set (char *name, AV *dataset) ds = (data_source_t *)smalloc ((len + 1) * sizeof (data_source_t)); set = (data_set_t *)smalloc (sizeof (data_set_t)); - types = (ds_types_t *)smalloc (sizeof (ds_types_t)); - types->len = len + 1; - types->values = (int *)smalloc ((types->len) * sizeof (int)); - for (i = 0; i <= len; ++i) { SV **elem = Perl_av_fetch (perl, dataset, i, 0); @@ -411,16 +361,11 @@ static int pplugin_register_data_set (char *name, AV *dataset) if (-1 == hv2data_source ((HV *)SvRV (*elem), &ds[i])) return -1; - types->values[i] = ds[i].type; log_debug ("pplugin_register_data_set: " "DS.name = \"%s\", DS.type = %i, DS.min = %f, DS.max = %f", ds[i].name, ds[i].type, ds[i].min, ds[i].max); } - if (NULL == Perl_hv_store (perl, data_sets, name, strlen (name), - Perl_sv_setref_pv (perl, Perl_newSV (perl, 0), 0, types), 0)) - return -1; - strncpy (set->type, name, DATA_MAX_NAME_LEN); set->type[DATA_MAX_NAME_LEN - 1] = '\0'; @@ -434,20 +379,8 @@ static int pplugin_register_data_set (char *name, AV *dataset) */ static int pplugin_unregister_data_set (char *name) { - SV *tmp = NULL; - if (NULL == name) return 0; - - /* freeing the allocated memory of the element itself (ds_types_t *) - * causes a segfault during perl_destruct () thus I assume perl somehow - * takes care of this... */ - - tmp = Perl_hv_delete (perl, data_sets, name, strlen (name), 0); - if (NULL != tmp) { - ds_types_t *ds = (ds_types_t *)SvIV ((SV *)SvRV (tmp)); - sfree (ds->values); - } return plugin_unregister_data_set (name); } /* static int pplugin_unregister_data_set (char *) */ @@ -486,6 +419,9 @@ static int pplugin_dispatch_values (char *name, HV *values) AV *array = (AV *)SvRV (*tmp); int len = Perl_av_len (perl, array) + 1; + if (len <= 0) + return -1; + val = (value_t *)smalloc (len * sizeof (value_t)); list.values_len = av2value (name, (AV *)SvRV (*tmp), val, len); @@ -506,6 +442,7 @@ static int pplugin_dispatch_values (char *name, HV *values) if (NULL != (tmp = Perl_hv_fetch (perl, values, "host", 4, 0))) { strncpy (list.host, SvPV_nolen (*tmp), DATA_MAX_NAME_LEN); + list.host[DATA_MAX_NAME_LEN - 1] = '\0'; } else { strcpy (list.host, hostname_g); @@ -534,13 +471,13 @@ static int pplugin_dispatch_values (char *name, HV *values) } /* static int pplugin_dispatch_values (char *, HV *) */ /* - * Call a plugin's working function. + * Call all working functions of the given type. */ -static int pplugin_call (int type, char *name, SV *sub, va_list ap) +static int pplugin_call_all (int type, ...) { int retvals = 0; - I32 xflags = G_NOARGS; + va_list ap; int ret = 0; dSP; @@ -548,11 +485,15 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) if ((type < 0) || (type >= PLUGIN_TYPES)) return -1; + va_start (ap, type); + ENTER; SAVETMPS; PUSHMARK (SP); + XPUSHs (sv_2mortal (Perl_newSViv (perl, (IV)type))); + if (PLUGIN_WRITE == type) { /* * $_[0] = $plugin_type; @@ -596,8 +537,6 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) XPUSHs (sv_2mortal (Perl_newSVpv (perl, ds->type, 0))); XPUSHs (sv_2mortal (Perl_newRV_noinc (perl, (SV *)pds))); XPUSHs (sv_2mortal (Perl_newRV_noinc (perl, (SV *)pvl))); - - xflags = 0; } else if (PLUGIN_LOG == type) { /* @@ -607,27 +546,14 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) */ XPUSHs (sv_2mortal (Perl_newSViv (perl, va_arg (ap, int)))); XPUSHs (sv_2mortal (Perl_newSVpv (perl, va_arg (ap, char *), 0))); - - xflags = 0; } PUTBACK; - /* prevent an endless loop */ - if (PLUGIN_LOG != type) - log_debug ("pplugin_call: executing Collectd::plugin::%s->%s()", - name, plugin_types[type]); - - retvals = Perl_call_sv (perl, sub, G_SCALAR | xflags); + retvals = Perl_call_pv (perl, "Collectd::plugin_call_all", G_SCALAR); SPAGAIN; - if (1 > retvals) { - if (PLUGIN_LOG != type) - log_warn ("pplugin_call: " - "Collectd::plugin::%s->%s() returned void - assuming true", - name, plugin_types[type]); - } - else { + if (0 < retvals) { SV *tmp = POPs; if (! SvTRUE (tmp)) ret = -1; @@ -636,126 +562,48 @@ static int pplugin_call (int type, char *name, SV *sub, va_list ap) PUTBACK; FREETMPS; LEAVE; - return ret; -} /* static int pplugin_call (int, char *, SV *, va_list) */ - -/* - * Call all working functions of the given type. - */ -static int pplugin_call_all (int type, ...) -{ - SV *tmp = NULL; - - char *plugin; - I32 len; - - if ((type < 0) || (type >= PLUGIN_TYPES)) - return -1; - - if (0 == Perl_hv_iterinit (perl, plugins[type])) - return 0; - - while (NULL != (tmp = Perl_hv_iternextsv (perl, plugins[type], - &plugin, &len))) { - pplugin_t *p; - va_list ap; - - int status; - - va_start (ap, type); - - p = (pplugin_t *)SvIV ((SV *)SvRV (tmp)); - - if (p->wait_left > 0) - p->wait_left -= interval_g; - - if (p->wait_left > 0) - continue; - - if (0 == (status = pplugin_call (type, plugin, p->sub, ap))) { - p->wait_left = 0; - p->wait_time = interval_g; - } - else if (PLUGIN_READ == type) { - p->wait_left = p->wait_time; - p->wait_time <<= 1; - - if (p->wait_time > 86400) - p->wait_time = 86400; - - log_warn ("Collectd::plugin::%s->read() failed. " - "Will suspend it for %i seconds.", - plugin, p->wait_left); - } - else if (PLUGIN_INIT == type) { - int i = 0; - - log_err ("Collectd::plugin::%s->init() failed. " - "Plugin will be disabled.", plugin, status); - - for (i = 0; i < PLUGIN_TYPES; ++i) - pplugin_unregister (i, plugin); - } - else if (PLUGIN_LOG != type) { - log_warn ("Collectd::plugin::%s->%s() failed with status %i.", - plugin, plugin_types[type], status); - } - va_end (ap); - } - return 0; + va_end (ap); + return ret; } /* static int pplugin_call_all (int, ...) */ - /* * Exported Perl API. */ /* - * Collectd::plugin_register (type, name, data). + * Collectd::plugin_register_data_set (type, dataset). * * type: - * init, read, write, shutdown, data set - * - * name: - * name of the plugin + * type of the dataset * - * data: - * reference to the plugin's subroutine that does the work or the data set - * definition + * dataset: + * dataset to be registered */ -static XS (Collectd_plugin_register) +static XS (Collectd_plugin_register_ds) { - int type = 0; SV *data = NULL; - - int ret = 0; + int ret = 0; dXSARGS; - if (3 != items) { - log_err ("Usage: Collectd::plugin_register(type, name, data)"); + if (2 != items) { + log_err ("Usage: Collectd::plugin_register_data_set(type, dataset)"); XSRETURN_EMPTY; } - log_debug ("Collectd::plugin_register: " - "type = \"%i\", name = \"%s\", \"%s\"", - (int)SvIV (ST (0)), SvPV_nolen (ST (1)), SvPV_nolen (ST (2))); + log_debug ("Collectd::plugin_register_data_set: " + "type = \"%s\", dataset = \"%s\"", + SvPV_nolen (ST (0)), SvPV_nolen (ST (1))); - type = (int)SvIV (ST (0)); - data = ST (2); + data = ST (1); - if ((type >= 0) && (type < PLUGIN_TYPES) - && SvROK (data) && (SVt_PVCV == SvTYPE (SvRV (data)))) { - ret = pplugin_register (type, SvPV_nolen (ST (1)), data); - } - else if ((type == PLUGIN_DATASET) - && SvROK (data) && (SVt_PVAV == SvTYPE (SvRV (data)))) { - ret = pplugin_register_data_set (SvPV_nolen (ST (1)), + if (SvROK (data) && (SVt_PVAV == SvTYPE (SvRV (data)))) { + ret = pplugin_register_data_set (SvPV_nolen (ST (0)), (AV *)SvRV (data)); } else { - log_err ("Collectd::plugin_register: Invalid data."); + log_err ("Collectd::plugin_register_data_set: Invalid data."); XSRETURN_EMPTY; } @@ -763,50 +611,31 @@ static XS (Collectd_plugin_register) XSRETURN_YES; else XSRETURN_EMPTY; -} /* static XS (Collectd_plugin_register) */ +} /* static XS (Collectd_plugin_register_ds) */ /* - * Collectd::plugin_unregister (type, name). + * Collectd::plugin_unregister_data_set (type). * * type: - * init, read, write, shutdown, data set - * - * name: - * name of the plugin + * type of the dataset */ -static XS (Collectd_plugin_unregister) +static XS (Collectd_plugin_unregister_ds) { - int type = 0; - int ret = 0; - dXSARGS; - if (2 != items) { - log_err ("Usage: Collectd::plugin_unregister(type, name)"); + if (1 != items) { + log_err ("Usage: Collectd::plugin_unregister_data_set(type)"); XSRETURN_EMPTY; } - log_debug ("Collectd::plugin_unregister: type = \"%i\", name = \"%s\"", - (int)SvIV (ST (0)), SvPV_nolen (ST (1))); - - type = (int)SvIV (ST (0)); - - if ((type >= 0) && (type < PLUGIN_TYPES)) { - ret = pplugin_unregister (type, SvPV_nolen (ST (1))); - } - else if (type == PLUGIN_DATASET) { - ret = pplugin_unregister_data_set (SvPV_nolen (ST (1))); - } - else { - log_err ("Collectd::plugin_unregister: Invalid type."); - XSRETURN_EMPTY; - } + log_debug ("Collectd::plugin_unregister_data_set: type = \"%s\"", + SvPV_nolen (ST (0))); - if (0 == ret) + if (0 == pplugin_unregister_data_set (SvPV_nolen (ST (1)))) XSRETURN_YES; else XSRETURN_EMPTY; -} /* static XS (Collectd_plugin_unregister) */ +} /* static XS (Collectd_plugin_register_ds) */ /* * Collectd::plugin_dispatch_values (name, values). @@ -825,7 +654,6 @@ static XS (Collectd_plugin_dispatch_values) dXSARGS; - items = 2; if (2 != items) { log_err ("Usage: Collectd::plugin_dispatch_values(name, values)"); XSRETURN_EMPTY; @@ -854,99 +682,63 @@ static XS (Collectd_plugin_dispatch_values) } /* static XS (Collectd_plugin_dispatch_values) */ /* - * Collectd::bootstrap (). + * Collectd::plugin_log (level, message). + * + * level: + * log level (LOG_DEBUG, ... LOG_ERR) + * + * message: + * log message */ -static XS (boot_Collectd) +static XS (Collectd_plugin_log) { - HV *stash = NULL; - char *file = __FILE__; - - struct { - char name[64]; - SV *value; - } consts[] = - { - { "Collectd::TYPE_INIT", Perl_newSViv (perl, PLUGIN_INIT) }, - { "Collectd::TYPE_READ", Perl_newSViv (perl, PLUGIN_READ) }, - { "Collectd::TYPE_WRITE", Perl_newSViv (perl, PLUGIN_WRITE) }, - { "Collectd::TYPE_SHUTDOWN", Perl_newSViv (perl, PLUGIN_SHUTDOWN) }, - { "Collectd::TYPE_LOG", Perl_newSViv (perl, PLUGIN_LOG) }, - { "Collectd::TYPE_DATASET", Perl_newSViv (perl, PLUGIN_DATASET) }, - { "Collectd::DS_TYPE_COUNTER", Perl_newSViv (perl, DS_TYPE_COUNTER) }, - { "Collectd::DS_TYPE_GAUGE", Perl_newSViv (perl, DS_TYPE_GAUGE) }, - { "Collectd::LOG_ERR", Perl_newSViv (perl, LOG_ERR) }, - { "Collectd::LOG_WARNING", Perl_newSViv (perl, LOG_WARNING) }, - { "Collectd::LOG_NOTICE", Perl_newSViv (perl, LOG_NOTICE) }, - { "Collectd::LOG_INFO", Perl_newSViv (perl, LOG_INFO) }, - { "Collectd::LOG_DEBUG", Perl_newSViv (perl, LOG_DEBUG) }, - { "", NULL } - }; - - int i = 0; - dXSARGS; - if ((1 > items) || (2 < items)) { - log_err ("Usage: Collectd::bootstrap(name[, version])"); + if (2 != items) { + log_err ("Usage: Collectd::plugin_log(level, message)"); XSRETURN_EMPTY; } - XS_VERSION_BOOTCHECK; - - /* register API */ - for (i = 0; NULL != api[i].f; ++i) - Perl_newXS (perl, api[i].name, api[i].f, file); - - stash = Perl_gv_stashpv (perl, "Collectd", 1); - - /* export "constants" */ - for (i = 0; NULL != consts[i].value; ++i) - Perl_newCONSTSUB (perl, stash, consts[i].name, consts[i].value); + plugin_log (SvIV (ST (0)), SvPV_nolen (ST (1))); XSRETURN_YES; -} /* static XS (boot_Collectd) */ - +} /* static XS (Collectd_plugin_log) */ /* * Interface to collectd. */ -static int perl_config (const char *key, const char *value) -{ - log_debug ("perl_config: key = \"%s\", value=\"%s\"", key, value); - - if (0 == strcasecmp (key, "LoadPlugin")) { - log_debug ("perl_config: loading perl plugin \"%s\"", value); - - Perl_load_module (perl, PERL_LOADMOD_NOIMPORT, - Perl_newSVpvf (perl, "Collectd::plugin::%s", value), - Nullsv); - } - else { - return -1; - } - return 0; -} /* static int perl_config (char *, char *) */ - static int perl_init (void) { + if (NULL == perl) + return 0; + PERL_SET_CONTEXT (perl); return pplugin_call_all (PLUGIN_INIT); } /* static int perl_init (void) */ static int perl_read (void) { + if (NULL == perl) + return 0; + PERL_SET_CONTEXT (perl); return pplugin_call_all (PLUGIN_READ); } /* static int perl_read (void) */ static int perl_write (const data_set_t *ds, const value_list_t *vl) { + if (NULL == perl) + return 0; + PERL_SET_CONTEXT (perl); return pplugin_call_all (PLUGIN_WRITE, ds, vl); } /* static int perl_write (const data_set_t *, const value_list_t *) */ static void perl_log (int level, const char *msg) { + if (NULL == perl) + return; + PERL_SET_CONTEXT (perl); pplugin_call_all (PLUGIN_LOG, level, msg); return; @@ -954,35 +746,20 @@ static void perl_log (int level, const char *msg) static int perl_shutdown (void) { - int i = 0; int ret = 0; - PERL_SET_CONTEXT (perl); - ret = pplugin_call_all (PLUGIN_SHUTDOWN); + plugin_unregister_complex_config ("perl"); - for (i = 0; i < PLUGIN_TYPES; ++i) { - if (0 < Perl_hv_iterinit (perl, plugins[i])) { - char *k = NULL; - I32 l = 0; - - while (NULL != Perl_hv_iternextsv (perl, plugins[i], &k, &l)) { - pplugin_unregister (i, k); - } - } - - Perl_hv_undef (perl, plugins[i]); - } + if (NULL == perl) + return 0; - if (0 < Perl_hv_iterinit (perl, data_sets)) { - char *k = NULL; - I32 l = 0; + plugin_unregister_log ("perl"); + plugin_unregister_init ("perl"); + plugin_unregister_read ("perl"); + plugin_unregister_write ("perl"); - while (NULL != Perl_hv_iternextsv (perl, data_sets, &k, &l)) { - pplugin_unregister_data_set (k); - } - } - - Perl_hv_undef (perl, data_sets); + PERL_SET_CONTEXT (perl); + ret = pplugin_call_all (PLUGIN_SHUTDOWN); #if COLLECT_DEBUG Perl_sv_report_used (perl); @@ -990,36 +767,55 @@ static int perl_shutdown (void) perl_destruct (perl); perl_free (perl); + perl = NULL; PERL_SYS_TERM (); + + plugin_unregister_shutdown ("perl"); return ret; } /* static void perl_shutdown (void) */ +/* bootstrap the Collectd module */ static void xs_init (pTHX) { - char *file = __FILE__; + HV *stash = NULL; + char *file = __FILE__; - dXSUB_SYS; + int i = 0; - /* build the Collectd module into the perl interpreter */ - Perl_newXS (perl, "Collectd::bootstrap", boot_Collectd, file); + dXSUB_SYS; /* enable usage of Perl modules using shared libraries */ Perl_newXS (perl, "DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + + /* register API */ + for (i = 0; NULL != api[i].f; ++i) + Perl_newXS (perl, api[i].name, api[i].f, file); + + stash = Perl_gv_stashpv (perl, "Collectd", 1); + + /* export "constants" */ + for (i = 0; '\0' != constants[i].name[0]; ++i) + Perl_newCONSTSUB (perl, stash, constants[i].name, + Perl_newSViv (perl, constants[i].value)); return; } /* static void xs_init (pTHX) */ -/* - * Create the perl interpreter and register it with collectd. - */ -void module_register (void) +/* Initialize the global Perl interpreter. */ +static int init_pi (int argc, char **argv) { - char *embed_argv[] = { "", "-e", "bootstrap Collectd \""VERSION"\"", NULL }; - int embed_argc = 3; + if (NULL != perl) + return 0; - int i = 0; + log_info ("Initializing Perl interpreter..."); +#if COLLECT_DEBUG + { + int i = 0; - log_debug ("module_register: Registering perl plugin..."); + for (i = 0; i < argc; ++i) + log_debug ("argv[%i] = \"%s\"", i, argv[i]); + } +#endif /* COLLECT_DEBUG */ PERL_SYS_INIT3 (&argc, &argv, &environ); @@ -1031,23 +827,179 @@ void module_register (void) PL_exit_flags |= PERL_EXIT_DESTRUCT_END; - if (0 != perl_parse (perl, xs_init, embed_argc, embed_argv, NULL)) { + if (0 != perl_parse (perl, xs_init, argc, argv, NULL)) { log_err ("module_register: Unable to bootstrap Collectd."); exit (1); } - perl_run (perl); - for (i = 0; i < PLUGIN_TYPES; ++i) - plugins[i] = Perl_newHV (perl); + /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */ + Perl_sv_setpv (perl, Perl_get_sv (perl, "0", 0), "collectd"); - data_sets = Perl_newHV (perl); + perl_run (perl); plugin_register_log ("perl", perl_log); - plugin_register_config ("perl", perl_config, config_keys, config_keys_num); plugin_register_init ("perl", perl_init); + plugin_register_read ("perl", perl_read); + plugin_register_write ("perl", perl_write); plugin_register_shutdown ("perl", perl_shutdown); + return 0; +} /* static int init_pi (const char **, const int) */ + +/* + * LoadPlugin "" + */ +static int perl_config_loadplugin (oconfig_item_t *ci) +{ + char module_name[DATA_MAX_NAME_LEN]; + + char *value = NULL; + + if ((0 != ci->children_num) || (1 != ci->values_num) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) + return 1; + + value = ci->values[0].value.string; + + if (NULL == get_module_name (module_name, sizeof (module_name), value)) { + log_err ("Invalid module name %s", value); + return (1); + } + + init_pi (perl_argc, perl_argv); + + log_debug ("perl_config: loading perl plugin \"%s\"", value); + Perl_load_module (perl, PERL_LOADMOD_NOIMPORT, + Perl_newSVpv (perl, module_name, strlen (module_name)), + Nullsv); + return 0; +} /* static int perl_config_loadplugin (oconfig_item_it *) */ + +/* + * BaseName "" + */ +static int perl_config_basename (oconfig_item_t *ci) +{ + char *value = NULL; + + if ((0 != ci->children_num) || (1 != ci->values_num) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) + return 1; + + value = ci->values[0].value.string; + + log_debug ("perl_config: Setting plugin basename to \"%s\"", value); + strncpy (base_name, value, sizeof (base_name)); + base_name[sizeof (base_name) - 1] = '\0'; + return 0; +} /* static int perl_config_basename (oconfig_item_it *) */ + +/* + * EnableDebugger ""|"" + */ +static int perl_config_enabledebugger (oconfig_item_t *ci) +{ + char *value = NULL; + + if ((0 != ci->children_num) || (1 != ci->values_num) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) + return 1; + + value = ci->values[0].value.string; + + perl_argv = (char **)realloc (perl_argv, + (++perl_argc + 1) * sizeof (char *)); + + if (NULL == perl_argv) { + log_err ("perl_config: Not enough memory."); + exit (3); + } + + if ('\0' == value[0]) { + perl_argv[perl_argc - 1] = "-d"; + } + else { + perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 4); + sstrncpy (perl_argv[perl_argc - 1], "-d:", 4); + sstrncpy (perl_argv[perl_argc - 1] + 3, value, strlen (value) + 1); + } + + perl_argv[perl_argc] = NULL; + return 0; +} /* static int perl_config_enabledebugger (oconfig_item_it *) */ + +/* + * IncludeDir "" + */ +static int perl_config_includedir (oconfig_item_t *ci) +{ + char *value = NULL; + + if ((0 != ci->children_num) || (1 != ci->values_num) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) + return 1; + + value = ci->values[0].value.string; + + if (NULL == perl) { + perl_argv = (char **)realloc (perl_argv, + (++perl_argc + 1) * sizeof (char *)); + + if (NULL == perl_argv) { + log_err ("perl_config: Not enough memory."); + exit (3); + } + + perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 3); + sstrncpy(perl_argv[perl_argc - 1], "-I", 3); + sstrncpy(perl_argv[perl_argc - 1] + 2, value, strlen (value) + 1); + + perl_argv[perl_argc] = NULL; + } + else { + /* prepend the directory to @INC */ + Perl_av_unshift (perl, GvAVn (PL_incgv), 1); + Perl_av_store (perl, GvAVn (PL_incgv), + 0, Perl_newSVpv (perl, value, strlen (value))); + } + return 0; +} /* static int perl_config_includedir (oconfig_item_it *) */ + +static int perl_config (oconfig_item_t *ci) +{ + int i = 0; + + for (i = 0; i < ci->children_num; ++i) { + oconfig_item_t *c = ci->children + i; + + if (0 == strcasecmp (c->key, "LoadPlugin")) + perl_config_loadplugin (c); + else if (0 == strcasecmp (c->key, "BaseName")) + perl_config_basename (c); + else if (0 == strcasecmp (c->key, "EnableDebugger")) + perl_config_enabledebugger (c); + else if (0 == strcasecmp (c->key, "IncludeDir")) + perl_config_includedir (c); + else + log_warn ("Ignoring unknown config key \"%s\".", c->key); + } + return 0; +} /* static int perl_config (oconfig_item_t *) */ + +void module_register (void) +{ + perl_argc = 4; + perl_argv = (char **)smalloc ((perl_argc + 1) * sizeof (char *)); + + /* default options for the Perl interpreter */ + perl_argv[0] = ""; + perl_argv[1] = "-MCollectd"; + perl_argv[2] = "-e"; + perl_argv[3] = "1"; + perl_argv[4] = NULL; + + plugin_register_complex_config ("perl", perl_config); return; } /* void module_register (void) */