perl plugin: lock base thread interpreter in perl_init() too.
[collectd.git] / src / perl.c
index 81ef720..4daa762 100644 (file)
@@ -1,4 +1,4 @@
-/**
+/*
  * collectd - src/perl.c
  * Copyright (C) 2007-2009  Sebastian Harl
  *
@@ -145,6 +145,11 @@ typedef struct {
        } while (0)
 
 /*
+ * Public variable
+ */
+extern char **environ;
+
+/*
  * private variables
  */
 
@@ -194,6 +199,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 },
@@ -267,7 +274,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 +330,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;
@@ -637,8 +651,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);
@@ -1527,6 +1545,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;
@@ -1865,6 +1886,7 @@ static XS (Collectd_call_by_name)
 
 static int perl_init (void)
 {
+       int status;
        dTHX;
 
        if (NULL == perl_threads)
@@ -1882,7 +1904,19 @@ static int perl_init (void)
 
        log_debug ("perl_init: c_ithread: interp = %p (active threads: %i)",
                        aTHX, perl_threads->number_of_threads);
-       return pplugin_call_all (aTHX_ PLUGIN_INIT);
+
+       /* 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. */
+
+       assert (aTHX == perl_threads->head->interp);
+       pthread_mutex_lock (&perl_threads->mutex);
+
+       status = pplugin_call_all (aTHX_ PLUGIN_INIT);
+
+       pthread_mutex_unlock (&perl_threads->mutex);
+
+       return status;
 } /* static int perl_init (void) */
 
 static int perl_read (void)
@@ -1902,13 +1936,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 +1965,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 +1999,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 +2033,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 (int timeout, const char *identifier,
+               user_data_t __attribute__((unused)) *user_data)
 {
        dTHX;
 
@@ -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) */