Merge branch 'collectd-4.10' into collectd-5.0
[collectd.git] / src / perl.c
index 81ef720..a2568da 100644 (file)
 
 #include "configfile.h"
 
+#if HAVE_STDBOOL_H
+# include <stdbool.h>
+#endif
+
 #include <EXTERN.h>
 #include <perl.h>
 
@@ -145,6 +149,11 @@ typedef struct {
        } while (0)
 
 /*
+ * Public variable
+ */
+extern char **environ;
+
+/*
  * private variables
  */
 
@@ -194,6 +203,8 @@ struct {
        { "Collectd::TYPE_DATASET",       PLUGIN_DATASET },
        { "Collectd::DS_TYPE_COUNTER",    DS_TYPE_COUNTER },
        { "Collectd::DS_TYPE_GAUGE",      DS_TYPE_GAUGE },
+       { "Collectd::DS_TYPE_DERIVE",     DS_TYPE_DERIVE },
+       { "Collectd::DS_TYPE_ABSOLUTE",   DS_TYPE_ABSOLUTE },
        { "Collectd::LOG_ERR",            LOG_ERR },
        { "Collectd::LOG_WARNING",        LOG_WARNING },
        { "Collectd::LOG_NOTICE",         LOG_NOTICE },
@@ -224,15 +235,6 @@ struct {
        { "", NULL }
 };
 
-struct {
-       char  name[64];
-       int  *var;
-} g_integers[] =
-{
-       { "Collectd::interval_g", &interval_g },
-       { "", NULL }
-};
-
 /*
  * Helper functions for data type conversion.
  */
@@ -267,7 +269,10 @@ static int hv2data_source (pTHX_ HV *hash, data_source_t *ds)
        if (NULL != (tmp = hv_fetch (hash, "type", 4, 0))) {
                ds->type = SvIV (*tmp);
 
-               if ((DS_TYPE_COUNTER != ds->type) && (DS_TYPE_GAUGE != ds->type)) {
+               if ((DS_TYPE_COUNTER != ds->type)
+                               && (DS_TYPE_GAUGE != ds->type)
+                               && (DS_TYPE_DERIVE != ds->type)
+                               && (DS_TYPE_ABSOLUTE != ds->type)) {
                        log_err ("hv2data_source: Invalid DS type.");
                        return -1;
                }
@@ -320,8 +325,12 @@ static int av2value (pTHX_ char *name, AV *array, value_t *value, int len)
                if (NULL != tmp) {
                        if (DS_TYPE_COUNTER == ds->ds[i].type)
                                value[i].counter = SvIV (*tmp);
-                       else
+                       else if (DS_TYPE_GAUGE == ds->ds[i].type)
                                value[i].gauge = SvNV (*tmp);
+                       else if (DS_TYPE_DERIVE == ds->ds[i].type)
+                               value[i].derive = SvIV (*tmp);
+                       else if (DS_TYPE_ABSOLUTE == ds->ds[i].type)
+                               value[i].absolute = SvIV (*tmp);
                }
                else {
                        return -1;
@@ -379,10 +388,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));
@@ -534,9 +549,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));
@@ -637,8 +655,12 @@ static int value_list2hv (pTHX_ value_list_t *vl, data_set_t *ds, HV *hash)
 
                if (DS_TYPE_COUNTER == ds->ds[i].type)
                        val = newSViv (vl->values[i].counter);
-               else
+               else if (DS_TYPE_GAUGE == ds->ds[i].type)
                        val = newSVnv (vl->values[i].gauge);
+               else if (DS_TYPE_DERIVE == ds->ds[i].type)
+                       val = newSViv (vl->values[i].derive);
+               else if (DS_TYPE_ABSOLUTE == ds->ds[i].type)
+                       val = newSViv (vl->values[i].absolute);
 
                if (NULL == av_store (values, i, val)) {
                        av_undef (values);
@@ -650,11 +672,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))
@@ -732,8 +760,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))
@@ -1084,11 +1115,15 @@ 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)));
        }
 
@@ -1527,6 +1562,9 @@ static XS (Collectd_plugin_register_ds)
 
        dXSARGS;
 
+       log_warn ("Using plugin_register() to register new data-sets is "
+                       "deprecated - add new entries to a custom types.db instead.");
+
        if (2 != items) {
                log_err ("Usage: Collectd::plugin_register_data_set(type, dataset)");
                XSRETURN_EMPTY;
@@ -1589,40 +1627,29 @@ 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);
 
+       /* 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;
        }
 
-       if (((2 == items) && (NULL == ST (0))) || (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.");
+       if (NULL == values)
                XSRETURN_EMPTY;
-       }
 
        ret = pplugin_dispatch_values (aTHX_ (HV *)SvRV (values));
 
@@ -1902,13 +1929,20 @@ static int perl_read (void)
                aTHX = t->interp;
        }
 
+       /* Assert that we're not running as the base thread. Otherwise, we might
+        * run into concurrency issues with c_ithread_create(). See
+        * https://github.com/collectd/collectd/issues/9 for details. */
+       assert (aTHX != perl_threads->head->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) */
 
-static int perl_write (const data_set_t *ds, const value_list_t *vl)
+static int perl_write (const data_set_t *ds, const value_list_t *vl,
+               user_data_t __attribute__((unused)) *user_data)
 {
+       int status;
        dTHX;
 
        if (NULL == perl_threads)
@@ -1924,12 +1958,24 @@ static int perl_write (const data_set_t *ds, const value_list_t *vl)
                aTHX = t->interp;
        }
 
+       /* 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. */
+       if (aTHX == perl_threads->head->interp)
+               pthread_mutex_lock (&perl_threads->mutex);
+
        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);
+       status = pplugin_call_all (aTHX_ PLUGIN_WRITE, ds, vl);
+
+       if (aTHX == perl_threads->head->interp)
+               pthread_mutex_unlock (&perl_threads->mutex);
+
+       return status;
 } /* static int perl_write (const data_set_t *, const value_list_t *) */
 
-static void perl_log (int level, const char *msg)
+static void perl_log (int level, const char *msg,
+               user_data_t __attribute__((unused)) *user_data)
 {
        dTHX;
 
@@ -1946,11 +1992,22 @@ static void perl_log (int level, const char *msg)
                aTHX = t->interp;
        }
 
+       /* 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. */
+       if (aTHX == perl_threads->head->interp)
+               pthread_mutex_lock (&perl_threads->mutex);
+
        pplugin_call_all (aTHX_ PLUGIN_LOG, level, msg);
+
+       if (aTHX == perl_threads->head->interp)
+               pthread_mutex_unlock (&perl_threads->mutex);
+
        return;
 } /* static void perl_log (int, const char *) */
 
-static int perl_notify (const notification_t *notif)
+static int perl_notify (const notification_t *notif,
+               user_data_t __attribute__((unused)) *user_data)
 {
        dTHX;
 
@@ -1969,7 +2026,8 @@ 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;
 
@@ -2070,19 +2128,27 @@ 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);
+       cdtime_t *interval = (cdtime_t *)mg->mg_ptr;
+       double nv;
+
+       nv = CDTIME_T_TO_DOUBLE (*interval);
+
+       sv_setnv (var, nv);
        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);
+       cdtime_t *interval = (cdtime_t *)mg->mg_ptr;
+       double nv;
+
+       nv = (double)SvNV (var);
+
+       *interval = 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
@@ -2090,8 +2156,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
@@ -2133,12 +2199,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 = */ (char *) &interval_g, /* namelen = */ 0);
+
        return;
 } /* static void xs_init (pTHX) */
 
@@ -2215,14 +2280,15 @@ 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_log ("perl", perl_log, /* user_data = */ NULL);
+       plugin_register_notification ("perl", perl_notify,
+                       /* user_data = */ NULL);
        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_write ("perl", perl_write, /* user_data = */ NULL);
+       plugin_register_flush ("perl", perl_flush, /* user_data = */ NULL);
        plugin_register_shutdown ("perl", perl_shutdown);
        return 0;
 } /* static int init_pi (const char **, const int) */