X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=src%2Fperl.c;h=84dd5372758474cbc6321bdb1ebce5971b681f2e;hb=3f2f61c7d74d9204405a4b0c21390451c98665a7;hp=889ab561f2a3b73f4179d5c53261adae79458ac1;hpb=c4bc5aa6fe93b7113f649869d9bf3e9fd7b12ff2;p=collectd.git diff --git a/src/perl.c b/src/perl.c index 889ab561..84dd5372 100644 --- a/src/perl.c +++ b/src/perl.c @@ -1,6 +1,6 @@ /** * collectd - src/perl.c - * Copyright (C) 2007 Sebastian Harl + * Copyright (C) 2007, 2008 Sebastian Harl * * This program is free software; you can redistribute it and/or modify it * under the terms of the GNU General Public License as published by the @@ -27,13 +27,19 @@ /* do not automatically get the thread specific perl interpreter */ #define PERL_NO_GET_CONTEXT +#define DONT_POISON_SPRINTF_YET 1 #include "collectd.h" +#undef DONT_POISON_SPRINTF_YET #include "configfile.h" #include #include +#if __GNUC__ +# pragma GCC poison sprintf +#endif + #include /* Some versions of Perl define their own version of DEBUG... :-/ */ @@ -51,13 +57,19 @@ # error "Perl does not support ithreads!" #endif /* !defined(USE_ITHREADS) */ +/* clear the Perl sub's stack frame + * (this should only be used inside an XSUB) */ +#define CLEAR_STACK_FRAME PL_stack_sp = PL_stack_base + *PL_markstack_ptr + #define PLUGIN_INIT 0 #define PLUGIN_READ 1 #define PLUGIN_WRITE 2 #define PLUGIN_SHUTDOWN 3 #define PLUGIN_LOG 4 +#define PLUGIN_NOTIF 5 +#define PLUGIN_FLUSH 6 -#define PLUGIN_TYPES 5 +#define PLUGIN_TYPES 7 #define PLUGIN_DATASET 255 @@ -72,7 +84,11 @@ void boot_DynaLoader (PerlInterpreter *, CV *); static XS (Collectd_plugin_register_ds); static XS (Collectd_plugin_unregister_ds); static XS (Collectd_plugin_dispatch_values); +static XS (Collectd_plugin_flush_one); +static XS (Collectd_plugin_flush_all); +static XS (Collectd_plugin_dispatch_notification); static XS (Collectd_plugin_log); +static XS (Collectd_call_by_name); /* * private data types @@ -91,6 +107,11 @@ typedef struct { c_ithread_t *head; c_ithread_t *tail; +#if COLLECT_DEBUG + /* some usage stats */ + int number_of_threads; +#endif /* COLLECT_DEBUG */ + pthread_mutex_t mutex; } c_ithread_list_t; @@ -102,6 +123,9 @@ typedef struct { * point to the "base" thread */ static c_ithread_list_t *perl_threads = NULL; +/* the key used to store each pthread's ithread */ +static pthread_key_t perl_thr_key; + static int perl_argc = 0; static char **perl_argv = NULL; @@ -115,7 +139,12 @@ static struct { { "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_flush_one", Collectd_plugin_flush_one }, + { "Collectd::plugin_flush_all", Collectd_plugin_flush_all }, + { "Collectd::plugin_dispatch_notification", + Collectd_plugin_dispatch_notification }, { "Collectd::plugin_log", Collectd_plugin_log }, + { "Collectd::call_by_name", Collectd_call_by_name }, { "", NULL } }; @@ -129,6 +158,8 @@ struct { { "Collectd::TYPE_WRITE", PLUGIN_WRITE }, { "Collectd::TYPE_SHUTDOWN", PLUGIN_SHUTDOWN }, { "Collectd::TYPE_LOG", PLUGIN_LOG }, + { "Collectd::TYPE_NOTIF", PLUGIN_NOTIF }, + { "Collectd::TYPE_FLUSH", PLUGIN_FLUSH }, { "Collectd::TYPE_DATASET", PLUGIN_DATASET }, { "Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER }, { "Collectd::DS_TYPE_GAUGE", DS_TYPE_GAUGE }, @@ -137,9 +168,30 @@ struct { { "Collectd::LOG_NOTICE", LOG_NOTICE }, { "Collectd::LOG_INFO", LOG_INFO }, { "Collectd::LOG_DEBUG", LOG_DEBUG }, + { "Collectd::NOTIF_FAILURE", NOTIF_FAILURE }, + { "Collectd::NOTIF_WARNING", NOTIF_WARNING }, + { "Collectd::NOTIF_OKAY", NOTIF_OKAY }, { "", 0 } }; +struct { + char name[64]; + char *var; +} g_strings[] = +{ + { "Collectd::hostname_g", hostname_g }, + { "", NULL } +}; + +struct { + char name[64]; + int *var; +} g_integers[] = +{ + { "Collectd::interval_g", &interval_g }, + { "", NULL } +}; + /* * Helper functions for data type conversion. */ @@ -334,6 +386,43 @@ static int value_list2hv (pTHX_ value_list_t *vl, data_set_t *ds, HV *hash) return 0; } /* static int value2av (value_list_t *, data_set_t *, HV *) */ +static int notification2hv (pTHX_ notification_t *n, HV *hash) +{ + if (NULL == hv_store (hash, "severity", 8, newSViv (n->severity), 0)) + return -1; + + if (0 != n->time) + if (NULL == hv_store (hash, "time", 4, newSViv (n->time), 0)) + return -1; + + if ('\0' != *n->message) + if (NULL == hv_store (hash, "message", 7, newSVpv (n->message, 0), 0)) + return -1; + + if ('\0' != *n->host) + if (NULL == hv_store (hash, "host", 4, newSVpv (n->host, 0), 0)) + return -1; + + if ('\0' != *n->plugin) + if (NULL == hv_store (hash, "plugin", 6, newSVpv (n->plugin, 0), 0)) + return -1; + + if ('\0' != *n->plugin_instance) + if (NULL == hv_store (hash, "plugin_instance", 15, + newSVpv (n->plugin_instance, 0), 0)) + return -1; + + if ('\0' != *n->type) + if (NULL == hv_store (hash, "type", 4, newSVpv (n->type, 0), 0)) + return -1; + + if ('\0' != *n->type_instance) + if (NULL == hv_store (hash, "type_instance", 13, + newSVpv (n->type_instance, 0), 0)) + return -1; + return 0; +} /* static int notification2hv (notification_t *, HV *) */ + /* * Internal functions. */ @@ -344,7 +433,7 @@ static char *get_module_name (char *buf, size_t buf_len, const char *module) { status = snprintf (buf, buf_len, "%s", module); else status = snprintf (buf, buf_len, "%s::%s", base_name, module); - if ((status < 0) || (status >= buf_len)) + if ((status < 0) || ((unsigned int)status >= buf_len)) return (NULL); buf[buf_len - 1] = '\0'; return (buf); @@ -356,6 +445,7 @@ static char *get_module_name (char *buf, size_t buf_len, const char *module) { static int pplugin_register_data_set (pTHX_ char *name, AV *dataset) { int len = -1; + int ret = 0; int i = 0; data_source_t *ds = NULL; @@ -396,7 +486,12 @@ static int pplugin_register_data_set (pTHX_ char *name, AV *dataset) set->ds_num = len + 1; set->ds = ds; - return plugin_register_data_set (set); + + ret = plugin_register_data_set (set); + + free (ds); + free (set); + return ret; } /* static int pplugin_register_data_set (char *, SV *) */ /* @@ -470,7 +565,7 @@ static int pplugin_dispatch_values (pTHX_ char *name, HV *values) list.host[DATA_MAX_NAME_LEN - 1] = '\0'; } else { - strcpy (list.host, hostname_g); + sstrncpy (list.host, hostname_g, sizeof (list.host)); } if (NULL != (tmp = hv_fetch (values, "plugin", 6, 0))) { @@ -478,8 +573,7 @@ static int pplugin_dispatch_values (pTHX_ char *name, HV *values) list.plugin[DATA_MAX_NAME_LEN - 1] = '\0'; } - if (NULL != (tmp = hv_fetch (values, - "plugin_instance", 15, 0))) { + if (NULL != (tmp = hv_fetch (values, "plugin_instance", 15, 0))) { strncpy (list.plugin_instance, SvPV_nolen (*tmp), DATA_MAX_NAME_LEN); list.plugin_instance[DATA_MAX_NAME_LEN - 1] = '\0'; } @@ -496,6 +590,71 @@ static int pplugin_dispatch_values (pTHX_ char *name, HV *values) } /* static int pplugin_dispatch_values (char *, HV *) */ /* + * Dispatch a notification. + * + * notification: + * { + * severity => $severity, + * time => $time, + * message => $msg, + * host => $host, + * plugin => $plugin, + * type => $type, + * plugin_instance => $instance, + * type_instance => $type_instance + * } + */ +static int pplugin_dispatch_notification (pTHX_ HV *notif) +{ + notification_t n; + + SV **tmp = NULL; + + if (NULL == notif) + return -1; + + memset (&n, 0, sizeof (n)); + + if (NULL != (tmp = hv_fetch (notif, "severity", 8, 0))) + n.severity = SvIV (*tmp); + else + n.severity = NOTIF_FAILURE; + + if (NULL != (tmp = hv_fetch (notif, "time", 4, 0))) + n.time = (time_t)SvIV (*tmp); + else + n.time = time (NULL); + + if (NULL != (tmp = hv_fetch (notif, "message", 7, 0))) + strncpy (n.message, SvPV_nolen (*tmp), sizeof (n.message)); + n.message[sizeof (n.message) - 1] = '\0'; + + if (NULL != (tmp = hv_fetch (notif, "host", 4, 0))) + strncpy (n.host, SvPV_nolen (*tmp), sizeof (n.host)); + else + strncpy (n.host, hostname_g, sizeof (n.host)); + n.host[sizeof (n.host) - 1] = '\0'; + + if (NULL != (tmp = hv_fetch (notif, "plugin", 6, 0))) + strncpy (n.plugin, SvPV_nolen (*tmp), sizeof (n.plugin)); + n.plugin[sizeof (n.plugin) - 1] = '\0'; + + if (NULL != (tmp = hv_fetch (notif, "plugin_instance", 15, 0))) + strncpy (n.plugin_instance, SvPV_nolen (*tmp), + sizeof (n.plugin_instance)); + n.plugin_instance[sizeof (n.plugin_instance) - 1] = '\0'; + + if (NULL != (tmp = hv_fetch (notif, "type", 4, 0))) + strncpy (n.type, SvPV_nolen (*tmp), sizeof (n.type)); + n.type[sizeof (n.type) - 1] = '\0'; + + if (NULL != (tmp = hv_fetch (notif, "type_instance", 13, 0))) + strncpy (n.type_instance, SvPV_nolen (*tmp), sizeof (n.type_instance)); + n.type_instance[sizeof (n.type_instance) - 1] = '\0'; + return plugin_dispatch_notification (&n); +} /* static int pplugin_dispatch_notification (HV *) */ + +/* * Call all working functions of the given type. */ static int pplugin_call_all (pTHX_ int type, ...) @@ -553,11 +712,19 @@ static int pplugin_call_all (pTHX_ int type, ...) ds = va_arg (ap, data_set_t *); vl = va_arg (ap, value_list_t *); - if (-1 == data_set2av (aTHX_ ds, pds)) - return -1; + if (-1 == data_set2av (aTHX_ ds, pds)) { + av_clear (pds); + av_undef (pds); + pds = Nullav; + ret = -1; + } - if (-1 == value_list2hv (aTHX_ vl, ds, pvl)) - return -1; + if (-1 == value_list2hv (aTHX_ vl, ds, pvl)) { + hv_clear (pvl); + hv_undef (pvl); + pvl = Nullhv; + ret = -1; + } XPUSHs (sv_2mortal (newSVpv (ds->type, 0))); XPUSHs (sv_2mortal (newRV_noinc ((SV *)pds))); @@ -572,6 +739,40 @@ static int pplugin_call_all (pTHX_ int type, ...) XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0))); } + else if (PLUGIN_NOTIF == type) { + /* + * $_[0] = + * { + * severity => $severity, + * time => $time, + * message => $msg, + * host => $host, + * plugin => $plugin, + * type => $type, + * plugin_instance => $instance, + * type_instance => $type_instance + * }; + */ + notification_t *n; + HV *notif = newHV (); + + n = va_arg (ap, notification_t *); + + if (-1 == notification2hv (aTHX_ n, notif)) { + hv_clear (notif); + hv_undef (notif); + notif = Nullhv; + ret = -1; + } + + XPUSHs (sv_2mortal (newRV_noinc ((SV *)notif))); + } + else if (PLUGIN_FLUSH == type) { + /* + * $_[0] = $timeout; + */ + XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); + } PUTBACK; @@ -656,7 +857,7 @@ static XS (Collectd_plugin_unregister_ds) log_debug ("Collectd::plugin_unregister_data_set: type = \"%s\"", SvPV_nolen (ST (0))); - if (0 == pplugin_unregister_data_set (SvPV_nolen (ST (1)))) + if (0 == pplugin_unregister_data_set (SvPV_nolen (ST (0)))) XSRETURN_YES; else XSRETURN_EMPTY; @@ -708,6 +909,91 @@ static XS (Collectd_plugin_dispatch_values) } /* static XS (Collectd_plugin_dispatch_values) */ /* + * Collectd::plugin_flush_one (timeout, name). + * + * timeout: + * timeout to use when flushing the data + * + * name: + * name of the plugin to flush + */ +static XS (Collectd_plugin_flush_one) +{ + dXSARGS; + + if (2 != items) { + log_err ("Usage: Collectd::plugin_flush_one(timeout, name)"); + XSRETURN_EMPTY; + } + + log_debug ("Collectd::plugin_flush_one: timeout = %i, name = \"%s\"", + (int)SvIV (ST (0)), SvPV_nolen (ST (1))); + + if (0 == plugin_flush_one ((int)SvIV (ST (0)), SvPV_nolen (ST (1)))) + XSRETURN_YES; + else + XSRETURN_EMPTY; +} /* static XS (Collectd_plugin_flush_one) */ + +/* + * Collectd::plugin_flush_all (timeout). + * + * timeout: + * timeout to use when flushing the data + */ +static XS (Collectd_plugin_flush_all) +{ + dXSARGS; + + if (1 != items) { + log_err ("Usage: Collectd::plugin_flush_all(timeout)"); + XSRETURN_EMPTY; + } + + log_debug ("Collectd::plugin_flush_all: timeout = %i", (int)SvIV (ST (0))); + + plugin_flush_all ((int)SvIV (ST (0))); + XSRETURN_YES; +} /* static XS (Collectd_plugin_flush_all) */ + +/* + * Collectd::plugin_dispatch_notification (notif). + * + * notif: + * notification to dispatch + */ +static XS (Collectd_plugin_dispatch_notification) +{ + SV *notif = NULL; + + int ret = 0; + + dXSARGS; + + if (1 != items) { + log_err ("Usage: Collectd::plugin_dispatch_notification(notif)"); + XSRETURN_EMPTY; + } + + log_debug ("Collectd::plugin_dispatch_notification: notif = \"%s\"", + SvPV_nolen (ST (0))); + + notif = ST (0); + + if (! (SvROK (notif) && (SVt_PVHV == SvTYPE (SvRV (notif))))) { + log_err ("Collectd::plugin_dispatch_notification: Invalid notif."); + XSRETURN_EMPTY; + } + + ret = pplugin_dispatch_notification (aTHX_ (HV *)SvRV (notif)); + + if (0 == ret) + XSRETURN_YES; + else + XSRETURN_EMPTY; +} /* static XS (Collectd_plugin_dispatch_notification) */ + +/* * Collectd::plugin_log (level, message). * * level: @@ -730,15 +1016,102 @@ static XS (Collectd_plugin_log) } /* static XS (Collectd_plugin_log) */ /* + * Collectd::call_by_name (...). + * + * Call a Perl sub identified by its name passed through $Collectd::cb_name. + */ +static XS (Collectd_call_by_name) +{ + SV *tmp = NULL; + char *name = NULL; + + if (NULL == (tmp = get_sv ("Collectd::cb_name", 0))) { + sv_setpv (get_sv ("@", 1), "cb_name has not been set"); + CLEAR_STACK_FRAME; + return; + } + + name = SvPV_nolen (tmp); + + if (NULL == get_cv (name, 0)) { + sv_setpvf (get_sv ("@", 1), "unknown callback \"%s\"", name); + CLEAR_STACK_FRAME; + return; + } + + /* simply pass on the subroutine call without touching the stack, + * thus leaving any arguments and return values in place */ + call_pv (name, 0); +} /* static XS (Collectd_call_by_name) */ + +/* * collectd's perl interpreter based thread implementation. * * This has been inspired by Perl's ithreads introduced in version 5.6.0. */ /* must be called with perl_threads->mutex locked */ +static void c_ithread_destroy (c_ithread_t *ithread) +{ + dTHXa (ithread->interp); + + assert (NULL != perl_threads); + + PERL_SET_CONTEXT (aTHX); + log_debug ("Shutting down Perl interpreter %p...", aTHX); + +#if COLLECT_DEBUG + sv_report_used (); + + --perl_threads->number_of_threads; +#endif /* COLLECT_DEBUG */ + + perl_destruct (aTHX); + perl_free (aTHX); + + if (NULL == ithread->prev) + perl_threads->head = ithread->next; + else + ithread->prev->next = ithread->next; + + if (NULL == ithread->next) + perl_threads->tail = ithread->prev; + else + ithread->next->prev = ithread->prev; + + sfree (ithread); + return; +} /* static void c_ithread_destroy (c_ithread_t *) */ + +static void c_ithread_destructor (void *arg) +{ + c_ithread_t *ithread = (c_ithread_t *)arg; + c_ithread_t *t = NULL; + + if (NULL == perl_threads) + return; + + pthread_mutex_lock (&perl_threads->mutex); + + for (t = perl_threads->head; NULL != t; t = t->next) + if (t == ithread) + break; + + /* the ithread no longer exists */ + if (NULL == t) + return; + + c_ithread_destroy (ithread); + + pthread_mutex_unlock (&perl_threads->mutex); + return; +} /* static void c_ithread_destructor (void *) */ + +/* must be called with perl_threads->mutex locked */ static c_ithread_t *c_ithread_create (PerlInterpreter *base) { c_ithread_t *t = NULL; + dTHXa (NULL); assert (NULL != perl_threads); @@ -749,6 +1122,18 @@ static c_ithread_t *c_ithread_create (PerlInterpreter *base) ? NULL : perl_clone (base, CLONEf_KEEP_PTR_TABLE); + aTHX = t->interp; + + if ((NULL != base) && (NULL != PL_endav)) { + av_clear (PL_endav); + av_undef (PL_endav); + PL_endav = Nullav; + } + +#if COLLECT_DEBUG + ++perl_threads->number_of_threads; +#endif /* COLLECT_DEBUG */ + t->next = NULL; if (NULL == perl_threads->tail) { @@ -761,6 +1146,8 @@ static c_ithread_t *c_ithread_create (PerlInterpreter *base) } perl_threads->tail = t; + + pthread_setspecific (perl_thr_key, (const void *)t); return t; } /* static c_ithread_t *c_ithread_create (PerlInterpreter *) */ @@ -784,6 +1171,9 @@ static int perl_init (void) aTHX = t->interp; } + + log_debug ("perl_init: c_ithread: interp = %p (active threads: %i)", + aTHX, perl_threads->number_of_threads); return pplugin_call_all (aTHX_ PLUGIN_INIT); } /* static int perl_init (void) */ @@ -803,6 +1193,9 @@ static int perl_read (void) aTHX = t->interp; } + + log_debug ("perl_read: c_ithread: interp = %p (active threads: %i)", + aTHX, perl_threads->number_of_threads); return pplugin_call_all (aTHX_ PLUGIN_READ); } /* static int perl_read (void) */ @@ -822,6 +1215,9 @@ static int perl_write (const data_set_t *ds, const value_list_t *vl) aTHX = t->interp; } + + log_debug ("perl_write: c_ithread: interp = %p (active threads: %i)", + aTHX, perl_threads->number_of_threads); return pplugin_call_all (aTHX_ PLUGIN_WRITE, ds, vl); } /* static int perl_write (const data_set_t *, const value_list_t *) */ @@ -846,6 +1242,44 @@ static void perl_log (int level, const char *msg) return; } /* static void perl_log (int, const char *) */ +static int perl_notify (const notification_t *notif) +{ + dTHX; + + if (NULL == perl_threads) + return 0; + + if (NULL == aTHX) { + c_ithread_t *t = NULL; + + pthread_mutex_lock (&perl_threads->mutex); + t = c_ithread_create (perl_threads->head->interp); + pthread_mutex_unlock (&perl_threads->mutex); + + aTHX = t->interp; + } + return pplugin_call_all (aTHX_ PLUGIN_NOTIF, notif); +} /* static int perl_notify (const notification_t *) */ + +static int perl_flush (const int timeout) +{ + dTHX; + + if (NULL == perl_threads) + return 0; + + if (NULL == aTHX) { + c_ithread_t *t = NULL; + + pthread_mutex_lock (&perl_threads->mutex); + t = c_ithread_create (perl_threads->head->interp); + pthread_mutex_unlock (&perl_threads->mutex); + + aTHX = t->interp; + } + return pplugin_call_all (aTHX_ PLUGIN_FLUSH, timeout); +} /* static int perl_flush (const int) */ + static int perl_shutdown (void) { c_ithread_t *t = NULL; @@ -869,10 +1303,15 @@ static int perl_shutdown (void) aTHX = t->interp; } + log_debug ("perl_shutdown: c_ithread: interp = %p (active threads: %i)", + aTHX, perl_threads->number_of_threads); + plugin_unregister_log ("perl"); + plugin_unregister_notification ("perl"); plugin_unregister_init ("perl"); plugin_unregister_read ("perl"); plugin_unregister_write ("perl"); + plugin_unregister_flush ("perl"); ret = pplugin_call_all (aTHX_ PLUGIN_SHUTDOWN); @@ -880,35 +1319,72 @@ static int perl_shutdown (void) t = perl_threads->tail; while (NULL != t) { - aTHX = t->interp; - PERL_SET_CONTEXT (aTHX); - -#if COLLECT_DEBUG - sv_report_used (); -#endif /* COLLECT_DEBUG */ - - perl_destruct (aTHX); - perl_free (aTHX); + c_ithread_t *thr = t; + /* the pointer has to be advanced before destroying + * the thread as this will free the memory */ t = t->prev; - sfree (t); + c_ithread_destroy (thr); } pthread_mutex_unlock (&perl_threads->mutex); + pthread_mutex_destroy (&perl_threads->mutex); sfree (perl_threads); + pthread_key_delete (perl_thr_key); + PERL_SYS_TERM (); plugin_unregister_shutdown ("perl"); return ret; } /* static void perl_shutdown (void) */ +/* + * Access functions for global variables. + * + * These functions implement the "magic" used to access + * the global variables from Perl. + */ + +static int g_pv_get (pTHX_ SV *var, MAGIC *mg) +{ + char *pv = mg->mg_ptr; + sv_setpv (var, pv); + return 0; +} /* static int g_pv_get (pTHX_ SV *, MAGIC *) */ + +static int g_pv_set (pTHX_ SV *var, MAGIC *mg) +{ + char *pv = mg->mg_ptr; + strncpy (pv, SvPV_nolen (var), DATA_MAX_NAME_LEN); + pv[DATA_MAX_NAME_LEN - 1] = '\0'; + return 0; +} /* static int g_pv_set (pTHX_ SV *, MAGIC *) */ + +static int g_iv_get (pTHX_ SV *var, MAGIC *mg) +{ + int *iv = (int *)mg->mg_ptr; + sv_setiv (var, *iv); + return 0; +} /* static int g_iv_get (pTHX_ SV *, MAGIC *) */ + +static int g_iv_set (pTHX_ SV *var, MAGIC *mg) +{ + int *iv = (int *)mg->mg_ptr; + *iv = (int)SvIV (var); + return 0; +} /* static int g_iv_set (pTHX_ SV *, MAGIC *) */ + +static MGVTBL g_pv_vtbl = { g_pv_get, g_pv_set, NULL, NULL, NULL, NULL, NULL }; +static MGVTBL g_iv_vtbl = { g_iv_get, g_iv_set, NULL, NULL, NULL, NULL, NULL }; + /* bootstrap the Collectd module */ static void xs_init (pTHX) { HV *stash = NULL; + SV *tmp = NULL; char *file = __FILE__; int i = 0; @@ -927,6 +1403,25 @@ static void xs_init (pTHX) /* export "constants" */ for (i = 0; '\0' != constants[i].name[0]; ++i) newCONSTSUB (stash, constants[i].name, newSViv (constants[i].value)); + + /* export global variables + * by adding "magic" to the SV's representing the globale variables + * perl is able to automagically call the get/set function when + * accessing any such variable (this is basically the same as using + * tie() in Perl) */ + /* global strings */ + for (i = 0; '\0' != g_strings[i].name[0]; ++i) { + tmp = get_sv (g_strings[i].name, 1); + sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_pv_vtbl, + g_strings[i].var, 0); + } + + /* global integers */ + for (i = 0; '\0' != g_integers[i].name[0]; ++i) { + tmp = get_sv (g_integers[i].name, 1); + sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_iv_vtbl, + (char *)g_integers[i].var, 0); + } return; } /* static void xs_init (pTHX) */ @@ -948,6 +1443,18 @@ static int init_pi (int argc, char **argv) } #endif /* COLLECT_DEBUG */ + if (0 != pthread_key_create (&perl_thr_key, c_ithread_destructor)) { + log_err ("init_pi: pthread_key_create failed"); + + /* this must not happen - cowardly giving up if it does */ + return -1; + } + +#ifdef __FreeBSD__ + /* On FreeBSD, PERL_SYS_INIT3 expands to some expression which + * triggers a "value computed is not used" warning by gcc. */ + (void) +#endif PERL_SYS_INIT3 (&argc, &argv, &environ); perl_threads = (c_ithread_list_t *)smalloc (sizeof (c_ithread_list_t)); @@ -962,7 +1469,7 @@ static int init_pi (int argc, char **argv) perl_threads->tail = perl_threads->head; if (NULL == (perl_threads->head->interp = perl_alloc ())) { - log_err ("module_register: Not enough memory."); + log_err ("init_pi: Not enough memory."); exit (3); } @@ -974,8 +1481,14 @@ static int init_pi (int argc, char **argv) PL_exit_flags |= PERL_EXIT_DESTRUCT_END; if (0 != perl_parse (aTHX_ xs_init, argc, argv, NULL)) { - log_err ("module_register: Unable to bootstrap Collectd."); - exit (1); + log_err ("init_pi: Unable to bootstrap Collectd."); + + perl_destruct (perl_threads->head->interp); + perl_free (perl_threads->head->interp); + sfree (perl_threads); + + pthread_key_delete (perl_thr_key); + return -1; } /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */ @@ -984,11 +1497,13 @@ static int init_pi (int argc, char **argv) perl_run (aTHX); plugin_register_log ("perl", perl_log); + plugin_register_notification ("perl", perl_notify); plugin_register_init ("perl", perl_init); plugin_register_read ("perl", perl_read); plugin_register_write ("perl", perl_write); + plugin_register_flush ("perl", perl_flush); plugin_register_shutdown ("perl", perl_shutdown); return 0; } /* static int init_pi (const char **, const int) */ @@ -1003,8 +1518,10 @@ static int perl_config_loadplugin (pTHX_ oconfig_item_t *ci) char *value = NULL; if ((0 != ci->children_num) || (1 != ci->values_num) - || (OCONFIG_TYPE_STRING != ci->values[0].type)) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) { + log_err ("LoadPlugin expects a single string argument."); return 1; + } value = ci->values[0].value.string; @@ -1013,7 +1530,9 @@ static int perl_config_loadplugin (pTHX_ oconfig_item_t *ci) return (1); } - init_pi (perl_argc, perl_argv); + if (0 != init_pi (perl_argc, perl_argv)) + return -1; + assert (NULL != perl_threads); assert (NULL != perl_threads->head); @@ -1033,8 +1552,10 @@ static int perl_config_basename (pTHX_ oconfig_item_t *ci) char *value = NULL; if ((0 != ci->children_num) || (1 != ci->values_num) - || (OCONFIG_TYPE_STRING != ci->values[0].type)) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) { + log_err ("BaseName expects a single string argument."); return 1; + } value = ci->values[0].value.string; @@ -1052,8 +1573,15 @@ static int perl_config_enabledebugger (pTHX_ oconfig_item_t *ci) char *value = NULL; if ((0 != ci->children_num) || (1 != ci->values_num) - || (OCONFIG_TYPE_STRING != ci->values[0].type)) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) { + log_err ("EnableDebugger expects a single string argument."); return 1; + } + + if (NULL != perl_threads) { + log_warn ("EnableDebugger has no effects if used after LoadPlugin."); + return 1; + } value = ci->values[0].value.string; @@ -1086,8 +1614,10 @@ static int perl_config_includedir (pTHX_ oconfig_item_t *ci) char *value = NULL; if ((0 != ci->children_num) || (1 != ci->values_num) - || (OCONFIG_TYPE_STRING != ci->values[0].type)) + || (OCONFIG_TYPE_STRING != ci->values[0].type)) { + log_err ("IncludeDir expects a single string argument."); return 1; + } value = ci->values[0].value.string; @@ -1118,16 +1648,14 @@ static int perl_config (oconfig_item_t *ci) { int i = 0; - dTHX; - - /* dTHX does not get any valid values in case Perl - * has not been initialized */ - if (NULL == perl_threads) - aTHX = NULL; + dTHXa (NULL); for (i = 0; i < ci->children_num; ++i) { oconfig_item_t *c = ci->children + i; + if (NULL != perl_threads) + aTHX = PERL_GET_CONTEXT; + if (0 == strcasecmp (c->key, "LoadPlugin")) perl_config_loadplugin (aTHX_ c); else if (0 == strcasecmp (c->key, "BaseName"))