X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=src%2Fperl.c;h=82b9b8c1454262ab0e1c7709718edebee2624908;hb=49ac868d2346c77335272b8a643bca295db9feaa;hp=7ab45d8d758dd7841554ff22fe3d2cd3fe563b7e;hpb=5c57b2bbd57919ad5d33d2cf4b39163f5db4a524;p=collectd.git diff --git a/src/perl.c b/src/perl.c index 7ab45d8d..82b9b8c1 100644 --- a/src/perl.c +++ b/src/perl.c @@ -2,20 +2,25 @@ * collectd - src/perl.c * Copyright (C) 2007-2009 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 - * Free Software Foundation; only version 2 of the License is applicable. + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: * - * This program is distributed in the hope that it will be useful, but - * WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - * General Public License for more details. + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. * - * You should have received a copy of the GNU General Public License along - * with this program; if not, write to the Free Software Foundation, Inc., - * 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. * - * Author: + * Authors: * Sebastian Harl **/ @@ -24,7 +29,7 @@ * interface for collectd plugins written in perl. */ -/* do not automatically get the thread specific perl interpreter */ +/* do not automatically get the thread specific Perl interpreter */ #define PERL_NO_GET_CONTEXT #define DONT_POISON_SPRINTF_YET 1 @@ -33,10 +38,15 @@ #include "configfile.h" +#if HAVE_STDBOOL_H +# include +#endif + #include #include #if defined(COLLECT_DEBUG) && COLLECT_DEBUG && defined(__GNUC__) && __GNUC__ +# undef sprintf # pragma GCC poison sprintf #endif @@ -98,6 +108,7 @@ 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_get_interval); static XS (Collectd__plugin_write); static XS (Collectd__plugin_flush); static XS (Collectd_plugin_dispatch_notification); @@ -112,7 +123,7 @@ static XS (Collectd_call_by_name); typedef struct c_ithread_s { /* the thread's Perl interpreter */ PerlInterpreter *interp; - _Bool running; /* thread is inside pi */ + _Bool running; /* thread is inside Perl interpreter */ _Bool shutdown; pthread_t pthread; @@ -131,6 +142,7 @@ typedef struct { #endif /* COLLECT_DEBUG */ pthread_mutex_t mutex; + pthread_mutexattr_t mutexattr; } c_ithread_list_t; /* name / user_data for Perl matches / targets */ @@ -176,6 +188,7 @@ 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_get_interval", Collectd_plugin_get_interval }, { "Collectd::_plugin_write", Collectd__plugin_write }, { "Collectd::_plugin_flush", Collectd__plugin_flush }, { "Collectd::plugin_dispatch_notification", @@ -234,15 +247,6 @@ struct { { "", NULL } }; -struct { - char name[64]; - int *var; -} g_integers[] = -{ - { "Collectd::interval_g", &interval_g }, - { "", NULL } -}; - /* * Helper functions for data type conversion. */ @@ -396,10 +400,16 @@ static int hv2value_list (pTHX_ HV *hash, value_list_t *vl) } if (NULL != (tmp = hv_fetch (hash, "time", 4, 0))) - vl->time = (time_t)SvIV (*tmp); + { + double t = SvNV (*tmp); + vl->time = DOUBLE_TO_CDTIME_T (t); + } if (NULL != (tmp = hv_fetch (hash, "interval", 8, 0))) - vl->interval = SvIV (*tmp); + { + double t = SvNV (*tmp); + vl->interval = DOUBLE_TO_CDTIME_T (t); + } if (NULL != (tmp = hv_fetch (hash, "host", 4, 0))) sstrncpy (vl->host, SvPV_nolen (*tmp), sizeof (vl->host)); @@ -510,7 +520,6 @@ static int av2notification_meta (pTHX_ AV *array, notification_meta_t **meta) if (NULL == (tmp = hv_fetch (hash, "value", 5, 0))) { log_warn ("av2notification_meta: Skipping invalid " "meta information."); - free ((*m)->name); free (*m); continue; } @@ -551,9 +560,12 @@ static int hv2notification (pTHX_ HV *hash, notification_t *n) n->severity = NOTIF_FAILURE; if (NULL != (tmp = hv_fetch (hash, "time", 4, 0))) - n->time = (time_t)SvIV (*tmp); + { + double t = SvNV (*tmp); + n->time = DOUBLE_TO_CDTIME_T (t); + } else - n->time = time (NULL); + n->time = cdtime (); if (NULL != (tmp = hv_fetch (hash, "message", 7, 0))) sstrncpy (n->message, SvPV_nolen (*tmp), sizeof (n->message)); @@ -671,11 +683,17 @@ static int value_list2hv (pTHX_ value_list_t *vl, data_set_t *ds, HV *hash) return -1; if (0 != vl->time) - if (NULL == hv_store (hash, "time", 4, newSViv (vl->time), 0)) + { + double t = CDTIME_T_TO_DOUBLE (vl->time); + if (NULL == hv_store (hash, "time", 4, newSVnv (t), 0)) return -1; + } - if (NULL == hv_store (hash, "interval", 8, newSViv (vl->interval), 0)) - return -1; + { + double t = CDTIME_T_TO_DOUBLE (vl->interval); + if (NULL == hv_store (hash, "interval", 8, newSVnv (t), 0)) + return -1; + } if ('\0' != vl->host[0]) if (NULL == hv_store (hash, "host", 4, newSVpv (vl->host, 0), 0)) @@ -753,8 +771,11 @@ static int notification2hv (pTHX_ notification_t *n, HV *hash) return -1; if (0 != n->time) - if (NULL == hv_store (hash, "time", 4, newSViv (n->time), 0)) + { + double t = CDTIME_T_TO_DOUBLE (n->time); + if (NULL == hv_store (hash, "time", 4, newSVnv (t), 0)) return -1; + } if ('\0' != *n->message) if (NULL == hv_store (hash, "message", 7, newSVpv (n->message, 0), 0)) @@ -991,30 +1012,43 @@ static int pplugin_dispatch_notification (pTHX_ HV *notif) } /* static int pplugin_dispatch_notification (HV *) */ /* - * Call all working functions of the given type. + * Call perl sub with thread locking flags handled. */ -static int pplugin_call_all (pTHX_ int type, ...) +static int call_pv_locked (pTHX_ const char* sub_name) { - int retvals = 0; - _Bool old_running; - va_list ap; - int ret = 0; - - dSP; + int ret; c_ithread_t *t = (c_ithread_t *)pthread_getspecific(perl_thr_key); - if (t == NULL) /* thread destroyed ( c_ithread_destroy*() -> log_debug() ) */ + if (t == NULL) /* thread destroyed */ return 0; old_running = t->running; t->running = 1; - + if (t->shutdown) { t->running = old_running; return 0; } + ret = call_pv (sub_name, G_SCALAR); + + t->running = old_running; + return ret; +} /* static int call_pv_locked (pTHX, *sub_name) */ + +/* + * Call all working functions of the given type. + */ +static int pplugin_call_all (pTHX_ int type, ...) +{ + int retvals = 0; + + va_list ap; + int ret = 0; + + dSP; + if ((type < 0) || (type >= PLUGIN_TYPES)) return -1; @@ -1118,17 +1152,21 @@ static int pplugin_call_all (pTHX_ int type, ...) XPUSHs (sv_2mortal (newRV_noinc ((SV *)notif))); } else if (PLUGIN_FLUSH == type) { + cdtime_t timeout; + /* * $_[0] = $timeout; * $_[1] = $identifier; */ - XPUSHs (sv_2mortal (newSViv (va_arg (ap, int)))); + timeout = va_arg (ap, cdtime_t); + + XPUSHs (sv_2mortal (newSVnv (CDTIME_T_TO_DOUBLE (timeout)))); XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0))); } PUTBACK; - retvals = call_pv ("Collectd::plugin_call_all", G_SCALAR); + retvals = call_pv_locked (aTHX_ "Collectd::plugin_call_all"); SPAGAIN; if (0 < retvals) { @@ -1141,13 +1179,12 @@ static int pplugin_call_all (pTHX_ int type, ...) FREETMPS; LEAVE; - t->running = old_running; va_end (ap); return ret; } /* static int pplugin_call_all (int, ...) */ /* - * collectd's perl interpreter based thread implementation. + * collectd's Perl interpreter based thread implementation. * * This has been inspired by Perl's ithreads introduced in version 5.6.0. */ @@ -1201,7 +1238,10 @@ static void c_ithread_destructor (void *arg) /* the ithread no longer exists */ if (NULL == t) + { + pthread_mutex_unlock (&perl_threads->mutex); return; + } c_ithread_destroy (ithread); @@ -1264,7 +1304,6 @@ static int fc_call (pTHX_ int type, int cb_type, pfc_user_data_t *data, ...) { int retvals = 0; - _Bool old_running; va_list ap; int ret = 0; @@ -1273,18 +1312,6 @@ static int fc_call (pTHX_ int type, int cb_type, pfc_user_data_t *data, ...) dSP; - c_ithread_t *t = (c_ithread_t *)pthread_getspecific(perl_thr_key); - if (t == NULL) /* thread destroyed */ - return 0; - - old_running = t->running; - t->running = 1; - - if (t->shutdown) { - t->running = old_running; - return 0; - } - if ((type < 0) || (type >= FC_TYPES)) return -1; @@ -1383,7 +1410,7 @@ static int fc_call (pTHX_ int type, int cb_type, pfc_user_data_t *data, ...) PUTBACK; - retvals = call_pv ("Collectd::fc_call", G_SCALAR); + retvals = call_pv_locked (aTHX_ "Collectd::fc_call"); if ((FC_CB_EXEC == cb_type) && (meta != NULL)) { assert (pmeta != NULL); @@ -1408,7 +1435,6 @@ static int fc_call (pTHX_ int type, int cb_type, pfc_user_data_t *data, ...) FREETMPS; LEAVE; - t->running = old_running; va_end (ap); return ret; } /* static int fc_call (int, int, pfc_user_data_t *, ...) */ @@ -1644,38 +1670,27 @@ static XS (Collectd_plugin_unregister_ds) static XS (Collectd_plugin_dispatch_values) { SV *values = NULL; - int values_idx = 0; int ret = 0; dXSARGS; - if (2 == items) { - log_warn ("Collectd::plugin_dispatch_values with two arguments " - "is deprecated - pass the type through values->{type}."); - values_idx = 1; - } - else if (1 != items) { + if (1 != items) { log_err ("Usage: Collectd::plugin_dispatch_values(values)"); XSRETURN_EMPTY; } log_debug ("Collectd::plugin_dispatch_values: values=\"%s\"", - SvPV_nolen (ST (values_idx))); + SvPV_nolen (ST (/* stack index = */ 0))); - values = ST (values_idx); + values = ST (/* stack index = */ 0); - if (! (SvROK (values) && (SVt_PVHV == SvTYPE (SvRV (values))))) { - log_err ("Collectd::plugin_dispatch_values: Invalid values."); - XSRETURN_EMPTY; - } - - if (((2 == items) && (NULL == ST (0))) || (NULL == values)) + if (NULL == values) XSRETURN_EMPTY; - if ((2 == items) && (NULL == hv_store ((HV *)SvRV (values), "type", 4, - newSVsv (ST (0)), 0))) { - log_err ("Collectd::plugin_dispatch_values: Could not store type."); + /* Make sure the argument is a hash reference. */ + if (! (SvROK (values) && (SVt_PVHV == SvTYPE (SvRV (values))))) { + log_err ("Collectd::plugin_dispatch_values: Invalid values."); XSRETURN_EMPTY; } @@ -1687,6 +1702,21 @@ static XS (Collectd_plugin_dispatch_values) XSRETURN_EMPTY; } /* static XS (Collectd_plugin_dispatch_values) */ +/* + * Collectd::plugin_get_interval (). + */ +static XS (Collectd_plugin_get_interval) +{ + dXSARGS; + + /* make sure we don't get any unused variable warnings for 'items'; + * don't abort, though */ + if (items) + log_err ("Usage: Collectd::plugin_get_interval()"); + + XSRETURN_NV ((NV) CDTIME_T_TO_DOUBLE (plugin_get_interval ())); +} /* static XS (Collectd_plugin_get_interval) */ + /* Collectd::plugin_write (plugin, ds, vl). * * plugin: @@ -1942,7 +1972,6 @@ static int perl_init (void) /* Lock the base thread to avoid race conditions with c_ithread_create(). * See https://github.com/collectd/collectd/issues/9 and * https://github.com/collectd/collectd/issues/1706 for details. - * Locking here requires additional check in perl_log() to avoid deadlock. */ assert (aTHX == perl_threads->head->interp); pthread_mutex_lock (&perl_threads->mutex); @@ -2020,7 +2049,6 @@ static void perl_log (int level, const char *msg, user_data_t __attribute__((unused)) *user_data) { dTHX; - int locked = 0; if (NULL == perl_threads) return; @@ -2038,18 +2066,14 @@ static void perl_log (int level, const char *msg, /* Lock the base thread if this is not called from one of the read threads * to avoid race conditions with c_ithread_create(). See * https://github.com/collectd/collectd/issues/9 for details. - * Additionally check, if we are called from perl interpreter. - * Maybe PTHREAD_MUTEX_RECURSIVE mutex type will be more appropriate? */ - if (aTHX == perl_threads->head->interp && !perl_threads->head->running) { + if (aTHX == perl_threads->head->interp) pthread_mutex_lock (&perl_threads->mutex); - locked = 1; - } pplugin_call_all (aTHX_ PLUGIN_LOG, level, msg); - if (locked) + if (aTHX == perl_threads->head->interp) pthread_mutex_unlock (&perl_threads->mutex); return; @@ -2075,7 +2099,7 @@ static int perl_notify (const notification_t *notif, return pplugin_call_all (aTHX_ PLUGIN_NOTIF, notif); } /* static int perl_notify (const notification_t *) */ -static int perl_flush (int timeout, const char *identifier, +static int perl_flush (cdtime_t timeout, const char *identifier, user_data_t __attribute__((unused)) *user_data) { dTHX; @@ -2109,7 +2133,7 @@ static int perl_shutdown (void) return 0; if (NULL == aTHX) { - c_ithread_t *t = NULL; + t = NULL; pthread_mutex_lock (&perl_threads->mutex); t = c_ithread_create (perl_threads->head->interp); @@ -2143,26 +2167,22 @@ static int perl_shutdown (void) thr->shutdown = 1; if (thr->running) { - /* Give some time to thread to exit from pi */ - WARNING ("perl shutdown: thread is running inside perl. Waiting."); + /* Give some time to thread to exit from Perl interpreter */ + WARNING ("perl shutdown: Thread is running inside Perl. Waiting."); ts_wait.tv_sec = 0; ts_wait.tv_nsec = 500000; nanosleep (&ts_wait, NULL); } if (thr->running) { - /* This will crash collectd process later due to PERL_SYS_TERM() */ - //ERROR ("perl shutdown: thread hangs inside perl. " - // "Skipped perl interpreter destroy."); - //continue; - - ERROR ("perl shutdown: thread hangs inside perl. Thread killed."); pthread_kill (thr->pthread, SIGTERM); + ERROR ("perl shutdown: Thread hangs inside Perl. Thread killed."); } c_ithread_destroy (thr); } pthread_mutex_unlock (&perl_threads->mutex); pthread_mutex_destroy (&perl_threads->mutex); + pthread_mutexattr_destroy (&perl_threads->mutexattr); sfree (perl_threads); @@ -2195,19 +2215,24 @@ static int g_pv_set (pTHX_ SV *var, MAGIC *mg) return 0; } /* static int g_pv_set (pTHX_ SV *, MAGIC *) */ -static int g_iv_get (pTHX_ SV *var, MAGIC *mg) +static int g_interval_get (pTHX_ SV *var, MAGIC *mg) { - int *iv = (int *)mg->mg_ptr; - sv_setiv (var, *iv); + log_warn ("Accessing $interval_g is deprecated (and might not " + "give the desired results) - plugin_get_interval() should " + "be used instead."); + sv_setnv (var, CDTIME_T_TO_DOUBLE (interval_g)); return 0; -} /* static int g_iv_get (pTHX_ SV *, MAGIC *) */ +} /* static int g_interval_get (pTHX_ SV *, MAGIC *) */ -static int g_iv_set (pTHX_ SV *var, MAGIC *mg) +static int g_interval_set (pTHX_ SV *var, MAGIC *mg) { - int *iv = (int *)mg->mg_ptr; - *iv = (int)SvIV (var); + double nv = (double)SvNV (var); + log_warn ("Accessing $interval_g is deprecated (and might not " + "give the desired results) - plugin_get_interval() should " + "be used instead."); + interval_g = DOUBLE_TO_CDTIME_T (nv); return 0; -} /* static int g_iv_set (pTHX_ SV *, MAGIC *) */ +} /* static int g_interval_set (pTHX_ SV *, MAGIC *) */ static MGVTBL g_pv_vtbl = { g_pv_get, g_pv_set, NULL, NULL, NULL, NULL, NULL @@ -2215,8 +2240,8 @@ static MGVTBL g_pv_vtbl = { , NULL #endif }; -static MGVTBL g_iv_vtbl = { - g_iv_get, g_iv_set, NULL, NULL, NULL, NULL, NULL +static MGVTBL g_interval_vtbl = { + g_interval_get, g_interval_set, NULL, NULL, NULL, NULL, NULL #if HAVE_PERL_STRUCT_MGVTBL_SVT_LOCAL , NULL #endif @@ -2258,12 +2283,11 @@ static void xs_init (pTHX) 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); - } + tmp = get_sv ("Collectd::interval_g", /* create = */ 1); + sv_magicext (tmp, NULL, /* how = */ PERL_MAGIC_ext, + /* vtbl = */ &g_interval_vtbl, + /* name = */ NULL, /* namelen = */ 0); + return; } /* static void xs_init (pTHX) */ @@ -2302,7 +2326,9 @@ static int init_pi (int argc, char **argv) perl_threads = (c_ithread_list_t *)smalloc (sizeof (c_ithread_list_t)); memset (perl_threads, 0, sizeof (c_ithread_list_t)); - pthread_mutex_init (&perl_threads->mutex, NULL); + pthread_mutexattr_init(&perl_threads->mutexattr); + pthread_mutexattr_settype(&perl_threads->mutexattr, PTHREAD_MUTEX_RECURSIVE); + pthread_mutex_init (&perl_threads->mutex, &perl_threads->mutexattr); /* locking the mutex should not be necessary at this point * but let's just do it for the sake of completeness */ pthread_mutex_lock (&perl_threads->mutex); @@ -2383,7 +2409,7 @@ static int perl_config_loadplugin (pTHX_ oconfig_item_t *ci) aTHX = perl_threads->head->interp; - log_debug ("perl_config: loading perl plugin \"%s\"", value); + log_debug ("perl_config: Loading Perl plugin \"%s\"", value); load_module (PERL_LOADMOD_NOIMPORT, newSVpv (module_name, strlen (module_name)), Nullsv); return 0; @@ -2556,7 +2582,10 @@ static int perl_config (oconfig_item_t *ci) int current_status = 0; if (NULL != perl_threads) - aTHX = PERL_GET_CONTEXT; + { + if ((aTHX = PERL_GET_CONTEXT) == NULL) + return -1; + } if (0 == strcasecmp (c->key, "LoadPlugin")) current_status = perl_config_loadplugin (aTHX_ c);