Merge branch 'collectd-4.3' into collectd-4.4
[collectd.git] / src / perl.c
index d17551e..84dd537 100644 (file)
@@ -1,6 +1,6 @@
 /**
  * collectd - src/perl.c
- * Copyright (C) 2007  Sebastian Harl
+ * Copyright (C) 2007, 2008  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
 /* do not automatically get the thread specific perl interpreter */
 #define PERL_NO_GET_CONTEXT
 
+#define DONT_POISON_SPRINTF_YET 1
 #include "collectd.h"
+#undef DONT_POISON_SPRINTF_YET
 
 #include "configfile.h"
 
 #include <EXTERN.h>
 #include <perl.h>
 
+#if __GNUC__
+# pragma GCC poison sprintf
+#endif
+
 #include <XSUB.h>
 
 /* Some versions of Perl define their own version of DEBUG... :-/ */
@@ -61,8 +67,9 @@
 #define PLUGIN_SHUTDOWN 3
 #define PLUGIN_LOG      4
 #define PLUGIN_NOTIF    5
+#define PLUGIN_FLUSH    6
 
-#define PLUGIN_TYPES    6
+#define PLUGIN_TYPES    7
 
 #define PLUGIN_DATASET  255
 
@@ -77,6 +84,8 @@ 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_flush_one);
+static XS (Collectd_plugin_flush_all);
 static XS (Collectd_plugin_dispatch_notification);
 static XS (Collectd_plugin_log);
 static XS (Collectd_call_by_name);
@@ -130,6 +139,8 @@ 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_flush_one",           Collectd_plugin_flush_one },
+       { "Collectd::plugin_flush_all",           Collectd_plugin_flush_all },
        { "Collectd::plugin_dispatch_notification",
                Collectd_plugin_dispatch_notification },
        { "Collectd::plugin_log",                 Collectd_plugin_log },
@@ -148,6 +159,7 @@ struct {
        { "Collectd::TYPE_SHUTDOWN",   PLUGIN_SHUTDOWN },
        { "Collectd::TYPE_LOG",        PLUGIN_LOG },
        { "Collectd::TYPE_NOTIF",      PLUGIN_NOTIF },
+       { "Collectd::TYPE_FLUSH",      PLUGIN_FLUSH },
        { "Collectd::TYPE_DATASET",    PLUGIN_DATASET },
        { "Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER },
        { "Collectd::DS_TYPE_GAUGE",   DS_TYPE_GAUGE },
@@ -553,7 +565,7 @@ static int pplugin_dispatch_values (pTHX_ char *name, HV *values)
                list.host[DATA_MAX_NAME_LEN - 1] = '\0';
        }
        else {
-               strcpy (list.host, hostname_g);
+               sstrncpy (list.host, hostname_g, sizeof (list.host));
        }
 
        if (NULL != (tmp = hv_fetch (values, "plugin", 6, 0))) {
@@ -755,6 +767,12 @@ static int pplugin_call_all (pTHX_ int type, ...)
 
                XPUSHs (sv_2mortal (newRV_noinc ((SV *)notif)));
        }
+       else if (PLUGIN_FLUSH == type) {
+               /*
+                * $_[0] = $timeout;
+                */
+               XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
+       }
 
        PUTBACK;
 
@@ -891,6 +909,54 @@ static XS (Collectd_plugin_dispatch_values)
 } /* static XS (Collectd_plugin_dispatch_values) */
 
 /*
+ * Collectd::plugin_flush_one (timeout, name).
+ *
+ * timeout:
+ *   timeout to use when flushing the data
+ *
+ * name:
+ *   name of the plugin to flush
+ */
+static XS (Collectd_plugin_flush_one)
+{
+       dXSARGS;
+
+       if (2 != items) {
+               log_err ("Usage: Collectd::plugin_flush_one(timeout, name)");
+               XSRETURN_EMPTY;
+       }
+
+       log_debug ("Collectd::plugin_flush_one: timeout = %i, name = \"%s\"",
+                       (int)SvIV (ST (0)), SvPV_nolen (ST (1)));
+
+       if (0 == plugin_flush_one ((int)SvIV (ST (0)), SvPV_nolen (ST (1))))
+               XSRETURN_YES;
+       else
+               XSRETURN_EMPTY;
+} /* static XS (Collectd_plugin_flush_one) */
+
+/*
+ * Collectd::plugin_flush_all (timeout).
+ *
+ * timeout:
+ *   timeout to use when flushing the data
+ */
+static XS (Collectd_plugin_flush_all)
+{
+       dXSARGS;
+
+       if (1 != items) {
+               log_err ("Usage: Collectd::plugin_flush_all(timeout)");
+               XSRETURN_EMPTY;
+       }
+
+       log_debug ("Collectd::plugin_flush_all: timeout = %i", (int)SvIV (ST (0)));
+
+       plugin_flush_all ((int)SvIV (ST (0)));
+       XSRETURN_YES;
+} /* static XS (Collectd_plugin_flush_all) */
+
+/*
  * Collectd::plugin_dispatch_notification (notif).
  *
  * notif:
@@ -1058,7 +1124,7 @@ static c_ithread_t *c_ithread_create (PerlInterpreter *base)
 
        aTHX = t->interp;
 
-       if (NULL != base) {
+       if ((NULL != base) && (NULL != PL_endav)) {
                av_clear (PL_endav);
                av_undef (PL_endav);
                PL_endav = Nullav;
@@ -1195,6 +1261,25 @@ 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 (const int timeout)
+{
+       dTHX;
+
+       if (NULL == perl_threads)
+               return 0;
+
+       if (NULL == aTHX) {
+               c_ithread_t *t = NULL;
+
+               pthread_mutex_lock (&perl_threads->mutex);
+               t = c_ithread_create (perl_threads->head->interp);
+               pthread_mutex_unlock (&perl_threads->mutex);
+
+               aTHX = t->interp;
+       }
+       return pplugin_call_all (aTHX_ PLUGIN_FLUSH, timeout);
+} /* static int perl_flush (const int) */
+
 static int perl_shutdown (void)
 {
        c_ithread_t *t = NULL;
@@ -1226,6 +1311,7 @@ static int perl_shutdown (void)
        plugin_unregister_init ("perl");
        plugin_unregister_read ("perl");
        plugin_unregister_write ("perl");
+       plugin_unregister_flush ("perl");
 
        ret = pplugin_call_all (aTHX_ PLUGIN_SHUTDOWN);
 
@@ -1361,9 +1447,14 @@ static int init_pi (int argc, char **argv)
                log_err ("init_pi: pthread_key_create failed");
 
                /* this must not happen - cowardly giving up if it does */
-               exit (1);
+               return -1;
        }
 
+#ifdef __FreeBSD__
+       /* On FreeBSD, PERL_SYS_INIT3 expands to some expression which
+        * triggers a "value computed is not used" warning by gcc. */
+       (void)
+#endif
        PERL_SYS_INIT3 (&argc, &argv, &environ);
 
        perl_threads = (c_ithread_list_t *)smalloc (sizeof (c_ithread_list_t));
@@ -1391,7 +1482,13 @@ static int init_pi (int argc, char **argv)
 
        if (0 != perl_parse (aTHX_ xs_init, argc, argv, NULL)) {
                log_err ("init_pi: Unable to bootstrap Collectd.");
-               exit (1);
+
+               perl_destruct (perl_threads->head->interp);
+               perl_free (perl_threads->head->interp);
+               sfree (perl_threads);
+
+               pthread_key_delete (perl_thr_key);
+               return -1;
        }
 
        /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */
@@ -1406,6 +1503,7 @@ static int init_pi (int argc, char **argv)
        plugin_register_read ("perl", perl_read);
 
        plugin_register_write ("perl", perl_write);
+       plugin_register_flush ("perl", perl_flush);
        plugin_register_shutdown ("perl", perl_shutdown);
        return 0;
 } /* static int init_pi (const char **, const int) */
@@ -1432,7 +1530,9 @@ static int perl_config_loadplugin (pTHX_ oconfig_item_t *ci)
                return (1);
        }
 
-       init_pi (perl_argc, perl_argv);
+       if (0 != init_pi (perl_argc, perl_argv))
+               return -1;
+
        assert (NULL != perl_threads);
        assert (NULL != perl_threads->head);
 
@@ -1548,16 +1648,14 @@ static int perl_config (oconfig_item_t *ci)
 {
        int i = 0;
 
-       dTHX;
-
-       /* dTHX does not get any valid values in case Perl
-        * has not been initialized */
-       if (NULL == perl_threads)
-               aTHX = NULL;
+       dTHXa (NULL);
 
        for (i = 0; i < ci->children_num; ++i) {
                oconfig_item_t *c = ci->children + i;
 
+               if (NULL != perl_threads)
+                       aTHX = PERL_GET_CONTEXT;
+
                if (0 == strcasecmp (c->key, "LoadPlugin"))
                        perl_config_loadplugin (aTHX_ c);
                else if (0 == strcasecmp (c->key, "BaseName"))