diff --git a/src/perl.c b/src/perl.c
index 924cb63fe195d018517f4c361f5b10ed848c5996..0a98684e9e809f30be3eb042abe3a254bb028510 100644 (file)
--- a/src/perl.c
+++ b/src/perl.c
* 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>
**/
#include <perl.h>
#if defined(COLLECT_DEBUG) && COLLECT_DEBUG && defined(__GNUC__) && __GNUC__
+# undef sprintf
# pragma GCC poison sprintf
#endif
return 0;
} /* static int hv2data_source (HV *, data_source_t *) */
-static int av2value (pTHX_ char *name, AV *array, value_t *value, int len)
+/* av2value converts at most "len" elements from "array" to "value". Returns the
+ * number of elements converted or zero on error. */
+static size_t av2value (pTHX_ char *name, AV *array, value_t *value, size_t array_len)
{
const data_set_t *ds;
+ size_t i;
- int i = 0;
-
- if ((NULL == name) || (NULL == array) || (NULL == value))
- return -1;
-
- if (av_len (array) < len - 1)
- len = av_len (array) + 1;
-
- if (0 >= len)
- return -1;
+ if ((NULL == name) || (NULL == array) || (NULL == value) || (array_len == 0))
+ return 0;
ds = plugin_get_ds (name);
if (NULL == ds) {
log_err ("av2value: Unknown dataset \"%s\"", name);
- return -1;
+ return 0;
}
- if (ds->ds_num < len) {
- log_warn ("av2value: Value length exceeds data set length.");
- len = ds->ds_num;
+ if (array_len < ds->ds_num) {
+ log_warn ("av2value: array does not contain enough elements for type \"%s\": got %zu, want %zu",
+ name, array_len, ds->ds_num);
+ return 0;
+ } else if (array_len > ds->ds_num) {
+ log_warn ("av2value: array contains excess elements for type \"%s\": got %zu, want %zu",
+ name, array_len, ds->ds_num);
}
- for (i = 0; i < len; ++i) {
+ for (i = 0; i < ds->ds_num; ++i) {
SV **tmp = av_fetch (array, i, 0);
if (NULL != tmp) {
value[i].absolute = SvIV (*tmp);
}
else {
- return -1;
+ return 0;
}
}
- return len;
-} /* static int av2value (char *, AV *, value_t *, int) */
+
+ return ds->ds_num;
+} /* static size_t av2value (char *, AV *, value_t *, size_t) */
/*
* value list:
{
AV *array = (AV *)SvRV (*tmp);
- int len = av_len (array) + 1;
-
- if (len <= 0)
+ /* av_len returns the highest index, not the actual length. */
+ size_t array_len = (size_t) (av_len (array) + 1);
+ if (array_len == 0)
return -1;
- vl->values = (value_t *)smalloc (len * sizeof (value_t));
- vl->values_len = av2value (aTHX_ vl->type, (AV *)SvRV (*tmp),
- vl->values, len);
-
- if (-1 == vl->values_len) {
+ vl->values = calloc (array_len, sizeof (*vl->values));
+ vl->values_len = av2value (aTHX_ vl->type, (AV *)SvRV (*tmp), vl->values, array_len);
+ if (vl->values_len == 0) {
sfree (vl->values);
return -1;
}
if (NULL == (tmp = hv_fetch (hash, "value", 5, 0))) {
log_warn ("av2notification_meta: Skipping invalid "
"meta information.");
- free ((*m)->name);
free (*m);
continue;
}
static int data_set2av (pTHX_ data_set_t *ds, AV *array)
{
- int i = 0;
+ size_t i;
if ((NULL == ds) || (NULL == array))
return -1;
static int value_list2hv (pTHX_ value_list_t *vl, data_set_t *ds, HV *hash)
{
AV *values = NULL;
-
- int i = 0;
- int len = 0;
+ size_t i;
if ((NULL == vl) || (NULL == ds) || (NULL == hash))
return -1;
- len = vl->values_len;
-
- if (ds->ds_num < len) {
- log_warn ("value2av: Value length exceeds data set length.");
- len = ds->ds_num;
- }
-
values = newAV ();
- av_extend (values, len - 1);
+ /* av_extend takes the last *index* to which the array should be extended. */
+ av_extend (values, vl->values_len - 1);
- for (i = 0; i < len; ++i) {
+ assert (ds->ds_num == vl->values_len);
+ for (i = 0; i < vl->values_len; ++i) {
SV *val = NULL;
if (DS_TYPE_COUNTER == ds->ds[i].type)
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_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)
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,
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 g_interval_get (pTHX_ SV *var, MAGIC *mg)
{
+ 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)
{
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 *) */