{GPL, other}: Relicense to MIT license.
[collectd.git] / src / perl.c
index f8a4822..5b9a483 100644 (file)
@@ -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 <sh at tokkee.org>
  **/
 
@@ -102,6 +107,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);
@@ -177,6 +183,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",
@@ -1659,6 +1666,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:
@@ -1929,6 +1951,11 @@ 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);
@@ -1937,6 +1964,7 @@ static int perl_read (void)
 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)
@@ -1952,9 +1980,20 @@ 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,
@@ -1975,7 +2014,17 @@ 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 *) */
 
@@ -2103,23 +2152,20 @@ static int g_pv_set (pTHX_ SV *var, MAGIC *mg)
 
 static int g_interval_get (pTHX_ SV *var, MAGIC *mg)
 {
-       cdtime_t *interval = (cdtime_t *)mg->mg_ptr;
-       double nv;
-
-       nv = CDTIME_T_TO_DOUBLE (*interval);
-
-       sv_setnv (var, nv);
+       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_interval_get (pTHX_ SV *, MAGIC *) */
 
 static int g_interval_set (pTHX_ SV *var, MAGIC *mg)
 {
-       cdtime_t *interval = (cdtime_t *)mg->mg_ptr;
-       double nv;
-
-       nv = (double)SvNV (var);
-
-       *interval = DOUBLE_TO_CDTIME_T (nv);
+       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_interval_set (pTHX_ SV *, MAGIC *) */
 
@@ -2175,7 +2221,7 @@ static void xs_init (pTHX)
        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);
+                       /* name = */ NULL, /* namelen = */ 0);
 
        return;
 } /* static void xs_init (pTHX) */