src/perl.c

   1 /**
   2  * collectd - src/perl.c
   3  * Copyright (C) 2007-2009  Sebastian Harl
   4  *
   5  * Permission is hereby granted, free of charge, to any person obtaining a
   6  * copy of this software and associated documentation files (the "Software"),
   7  * to deal in the Software without restriction, including without limitation
   8  * the rights to use, copy, modify, merge, publish, distribute, sublicense,
   9  * and/or sell copies of the Software, and to permit persons to whom the
  10  * Software is furnished to do so, subject to the following conditions:
  11  *
  12  * The above copyright notice and this permission notice shall be included in
  13  * all copies or substantial portions of the Software.
  14  *
  15  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  16  * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  17  * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  18  * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  19  * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  20  * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  21  * DEALINGS IN THE SOFTWARE.
  22  *
  23  * Authors:
  24  *   Sebastian Harl <sh at tokkee.org>
  25  *   Pavel Rochnyak <pavel2000 ngs.ru>
  26  **/
  27
  28 /*
  29  * This plugin embeds a Perl interpreter into collectd and provides an
  30  * interface for collectd plugins written in perl.
  31  */
  32
  33 /* do not automatically get the thread specific Perl interpreter */
  34 #define PERL_NO_GET_CONTEXT
  35
  36 #include <stdbool.h>
  37
  38 #include <EXTERN.h>
  39 #include <perl.h>
  40
  41 #include <XSUB.h>
  42
  43 /* Some versions of Perl define their own version of DEBUG... :-/ */
  44 #ifdef DEBUG
  45 #undef DEBUG
  46 #endif /* DEBUG */
  47
  48 /* ... while we want the definition found in plugin.h. */
  49 #include "common.h"
  50 #include "plugin.h"
  51
  52 #include "filter_chain.h"
  53
  54 #if !defined(USE_ITHREADS)
  55 #error "Perl does not support ithreads!"
  56 #endif /* !defined(USE_ITHREADS) */
  57
  58 /* clear the Perl sub's stack frame
  59  * (this should only be used inside an XSUB) */
  60 #define CLEAR_STACK_FRAME PL_stack_sp = PL_stack_base + *PL_markstack_ptr
  61
  62 #define PLUGIN_INIT 0
  63 #define PLUGIN_READ 1
  64 #define PLUGIN_WRITE 2
  65 #define PLUGIN_SHUTDOWN 3
  66 #define PLUGIN_LOG 4
  67 #define PLUGIN_NOTIF 5
  68 #define PLUGIN_FLUSH 6
  69 #define PLUGIN_FLUSH_ALL 7 /* For collectd-5.6 only */
  70
  71 #define PLUGIN_TYPES 8
  72
  73 #define PLUGIN_CONFIG 254
  74 #define PLUGIN_DATASET 255
  75
  76 #define FC_MATCH 0
  77 #define FC_TARGET 1
  78
  79 #define FC_TYPES 2
  80
  81 #define FC_CB_CREATE 0
  82 #define FC_CB_DESTROY 1
  83 #define FC_CB_EXEC 2
  84
  85 #define FC_CB_TYPES 3
  86
  87 #define log_debug(...) DEBUG("perl: " __VA_ARGS__)
  88 #define log_info(...) INFO("perl: " __VA_ARGS__)
  89 #define log_warn(...) WARNING("perl: " __VA_ARGS__)
  90 #define log_err(...) ERROR("perl: " __VA_ARGS__)
  91
  92 /* this is defined in DynaLoader.a */
  93 void boot_DynaLoader(PerlInterpreter *, CV *);
  94
  95 static XS(Collectd_plugin_register_read);
  96 static XS(Collectd_plugin_register_write);
  97 static XS(Collectd_plugin_register_log);
  98 static XS(Collectd_plugin_register_notification);
  99 static XS(Collectd_plugin_register_flush);
 100 static XS(Collectd_plugin_unregister_read);
 101 static XS(Collectd_plugin_unregister_write);
 102 static XS(Collectd_plugin_unregister_log);
 103 static XS(Collectd_plugin_unregister_notification);
 104 static XS(Collectd_plugin_unregister_flush);
 105 static XS(Collectd_plugin_register_ds);
 106 static XS(Collectd_plugin_unregister_ds);
 107 static XS(Collectd_plugin_dispatch_values);
 108 static XS(Collectd_plugin_get_interval);
 109 static XS(Collectd__plugin_write);
 110 static XS(Collectd__plugin_flush);
 111 static XS(Collectd_plugin_dispatch_notification);
 112 static XS(Collectd_plugin_log);
 113 static XS(Collectd__fc_register);
 114 static XS(Collectd_call_by_name);
 115
 116 static int perl_read(user_data_t *ud);
 117 static int perl_write(const data_set_t *ds, const value_list_t *vl,
 118                       user_data_t *user_data);
 119 static void perl_log(int level, const char *msg, user_data_t *user_data);
 120 static int perl_notify(const notification_t *notif, user_data_t *user_data);
 121 static int perl_flush(cdtime_t timeout, const char *identifier,
 122                       user_data_t *user_data);
 123
 124 /*
 125  * private data types
 126  */
 127
 128 typedef struct c_ithread_s {
 129   /* the thread's Perl interpreter */
 130   PerlInterpreter *interp;
 131   bool running; /* thread is inside Perl interpreter */
 132   bool shutdown;
 133   pthread_t pthread;
 134
 135   /* double linked list of threads */
 136   struct c_ithread_s *prev;
 137   struct c_ithread_s *next;
 138 } c_ithread_t;
 139
 140 typedef struct {
 141   c_ithread_t *head;
 142   c_ithread_t *tail;
 143
 144 #if COLLECT_DEBUG
 145   /* some usage stats */
 146   int number_of_threads;
 147 #endif /* COLLECT_DEBUG */
 148
 149   pthread_mutex_t mutex;
 150   pthread_mutexattr_t mutexattr;
 151 } c_ithread_list_t;
 152
 153 /* name / user_data for Perl matches / targets */
 154 typedef struct {
 155   char *name;
 156   SV *user_data;
 157 } pfc_user_data_t;
 158
 159 #define PFC_USER_DATA_FREE(data)                                               \
 160   do {                                                                         \
 161     sfree((data)->name);                                                       \
 162     if (NULL != (data)->user_data)                                             \
 163       sv_free((data)->user_data);                                              \
 164     sfree(data);                                                               \
 165   } while (0)
 166
 167 /*
 168  * Public variable
 169  */
 170 extern char **environ;
 171
 172 /*
 173  * private variables
 174  */
 175
 176 static bool register_legacy_flush = true;
 177
 178 /* if perl_threads != NULL perl_threads->head must
 179  * point to the "base" thread */
 180 static c_ithread_list_t *perl_threads;
 181
 182 /* the key used to store each pthread's ithread */
 183 static pthread_key_t perl_thr_key;
 184
 185 static int perl_argc;
 186 static char **perl_argv;
 187
 188 static char base_name[DATA_MAX_NAME_LEN] = "";
 189
 190 static struct {
 191   char name[64];
 192   XS((*f));
 193 } api[] = {
 194     {"Collectd::plugin_register_read", Collectd_plugin_register_read},
 195     {"Collectd::plugin_register_write", Collectd_plugin_register_write},
 196     {"Collectd::plugin_register_log", Collectd_plugin_register_log},
 197     {"Collectd::plugin_register_notification",
 198      Collectd_plugin_register_notification},
 199     {"Collectd::plugin_register_flush", Collectd_plugin_register_flush},
 200     {"Collectd::plugin_unregister_read", Collectd_plugin_unregister_read},
 201     {"Collectd::plugin_unregister_write", Collectd_plugin_unregister_write},
 202     {"Collectd::plugin_unregister_log", Collectd_plugin_unregister_log},
 203     {"Collectd::plugin_unregister_notification",
 204      Collectd_plugin_unregister_notification},
 205     {"Collectd::plugin_unregister_flush", Collectd_plugin_unregister_flush},
 206     {"Collectd::plugin_register_data_set", Collectd_plugin_register_ds},
 207     {"Collectd::plugin_unregister_data_set", Collectd_plugin_unregister_ds},
 208     {"Collectd::plugin_dispatch_values", Collectd_plugin_dispatch_values},
 209     {"Collectd::plugin_get_interval", Collectd_plugin_get_interval},
 210     {"Collectd::_plugin_write", Collectd__plugin_write},
 211     {"Collectd::_plugin_flush", Collectd__plugin_flush},
 212     {"Collectd::plugin_dispatch_notification",
 213      Collectd_plugin_dispatch_notification},
 214     {"Collectd::plugin_log", Collectd_plugin_log},
 215     {"Collectd::_fc_register", Collectd__fc_register},
 216     {"Collectd::call_by_name", Collectd_call_by_name},
 217     {"", NULL}};
 218
 219 struct {
 220   char name[64];
 221   int value;
 222 } constants[] = {{"Collectd::TYPE_INIT", PLUGIN_INIT},
 223                  {"Collectd::TYPE_READ", PLUGIN_READ},
 224                  {"Collectd::TYPE_WRITE", PLUGIN_WRITE},
 225                  {"Collectd::TYPE_SHUTDOWN", PLUGIN_SHUTDOWN},
 226                  {"Collectd::TYPE_LOG", PLUGIN_LOG},
 227                  {"Collectd::TYPE_NOTIF", PLUGIN_NOTIF},
 228                  {"Collectd::TYPE_FLUSH", PLUGIN_FLUSH},
 229                  {"Collectd::TYPE_CONFIG", PLUGIN_CONFIG},
 230                  {"Collectd::TYPE_DATASET", PLUGIN_DATASET},
 231                  {"Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER},
 232                  {"Collectd::DS_TYPE_GAUGE", DS_TYPE_GAUGE},
 233                  {"Collectd::DS_TYPE_DERIVE", DS_TYPE_DERIVE},
 234                  {"Collectd::DS_TYPE_ABSOLUTE", DS_TYPE_ABSOLUTE},
 235                  {"Collectd::LOG_ERR", LOG_ERR},
 236                  {"Collectd::LOG_WARNING", LOG_WARNING},
 237                  {"Collectd::LOG_NOTICE", LOG_NOTICE},
 238                  {"Collectd::LOG_INFO", LOG_INFO},
 239                  {"Collectd::LOG_DEBUG", LOG_DEBUG},
 240                  {"Collectd::FC_MATCH", FC_MATCH},
 241                  {"Collectd::FC_TARGET", FC_TARGET},
 242                  {"Collectd::FC_CB_CREATE", FC_CB_CREATE},
 243                  {"Collectd::FC_CB_DESTROY", FC_CB_DESTROY},
 244                  {"Collectd::FC_CB_EXEC", FC_CB_EXEC},
 245                  {"Collectd::FC_MATCH_NO_MATCH", FC_MATCH_NO_MATCH},
 246                  {"Collectd::FC_MATCH_MATCHES", FC_MATCH_MATCHES},
 247                  {"Collectd::FC_TARGET_CONTINUE", FC_TARGET_CONTINUE},
 248                  {"Collectd::FC_TARGET_STOP", FC_TARGET_STOP},
 249                  {"Collectd::FC_TARGET_RETURN", FC_TARGET_RETURN},
 250                  {"Collectd::NOTIF_FAILURE", NOTIF_FAILURE},
 251                  {"Collectd::NOTIF_WARNING", NOTIF_WARNING},
 252                  {"Collectd::NOTIF_OKAY", NOTIF_OKAY},
 253                  {"", 0}};
 254 /*
 255  * Helper functions for data type conversion.
 256  */
 257
 258 /*
 259  * data source:
 260  * [
 261  *   {
 262  *     name => $ds_name,
 263  *     type => $ds_type,
 264  *     min  => $ds_min,
 265  *     max  => $ds_max
 266  *   },
 267  *   ...
 268  * ]
 269  */
 270 static int hv2data_source(pTHX_ HV *hash, data_source_t *ds) {
 271   SV **tmp = NULL;
 272
 273   if ((NULL == hash) || (NULL == ds))
 274     return -1;
 275
 276   if (NULL != (tmp = hv_fetch(hash, "name", 4, 0))) {
 277     sstrncpy(ds->name, SvPV_nolen(*tmp), sizeof(ds->name));
 278   } else {
 279     log_err("hv2data_source: No DS name given.");
 280     return -1;
 281   }
 282
 283   if (NULL != (tmp = hv_fetch(hash, "type", 4, 0))) {
 284     ds->type = SvIV(*tmp);
 285
 286     if ((DS_TYPE_COUNTER != ds->type) && (DS_TYPE_GAUGE != ds->type) &&
 287         (DS_TYPE_DERIVE != ds->type) && (DS_TYPE_ABSOLUTE != ds->type)) {
 288       log_err("hv2data_source: Invalid DS type.");
 289       return -1;
 290     }
 291   } else {
 292     ds->type = DS_TYPE_COUNTER;
 293   }
 294
 295   if (NULL != (tmp = hv_fetch(hash, "min", 3, 0)))
 296     ds->min = SvNV(*tmp);
 297   else
 298     ds->min = NAN;
 299
 300   if (NULL != (tmp = hv_fetch(hash, "max", 3, 0)))
 301     ds->max = SvNV(*tmp);
 302   else
 303     ds->max = NAN;
 304   return 0;
 305 } /* static int hv2data_source (HV *, data_source_t *) */
 306
 307 /* av2value converts at most "len" elements from "array" to "value". Returns the
 308  * number of elements converted or zero on error. */
 309 static size_t av2value(pTHX_ char *name, AV *array, value_t *value,
 310                        size_t array_len) {
 311   const data_set_t *ds;
 312
 313   if ((NULL == name) || (NULL == array) || (NULL == value) || (array_len == 0))
 314     return 0;
 315
 316   ds = plugin_get_ds(name);
 317   if (NULL == ds) {
 318     log_err("av2value: Unknown dataset \"%s\"", name);
 319     return 0;
 320   }
 321
 322   if (array_len < ds->ds_num) {
 323     log_warn("av2value: array does not contain enough elements for type "
 324              "\"%s\": got %" PRIsz ", want %" PRIsz,
 325              name, array_len, ds->ds_num);
 326     return 0;
 327   } else if (array_len > ds->ds_num) {
 328     log_warn("av2value: array contains excess elements for type \"%s\": got "
 329              "%" PRIsz ", want %" PRIsz,
 330              name, array_len, ds->ds_num);
 331   }
 332
 333   for (size_t i = 0; i < ds->ds_num; ++i) {
 334     SV **tmp = av_fetch(array, i, 0);
 335
 336     if (NULL != tmp) {
 337       if (DS_TYPE_COUNTER == ds->ds[i].type)
 338         value[i].counter = SvIV(*tmp);
 339       else if (DS_TYPE_GAUGE == ds->ds[i].type)
 340         value[i].gauge = SvNV(*tmp);
 341       else if (DS_TYPE_DERIVE == ds->ds[i].type)
 342         value[i].derive = SvIV(*tmp);
 343       else if (DS_TYPE_ABSOLUTE == ds->ds[i].type)
 344         value[i].absolute = SvIV(*tmp);
 345     } else {
 346       return 0;
 347     }
 348   }
 349
 350   return ds->ds_num;
 351 } /* static size_t av2value (char *, AV *, value_t *, size_t) */
 352
 353 /*
 354  * value list:
 355  * {
 356  *   values => [ @values ],
 357  *   time   => $time,
 358  *   host   => $host,
 359  *   plugin => $plugin,
 360  *   plugin_instance => $pinstance,
 361  *   type_instance   => $tinstance,
 362  * }
 363  */
 364 static int hv2value_list(pTHX_ HV *hash, value_list_t *vl) {
 365   SV **tmp;
 366
 367   if ((NULL == hash) || (NULL == vl))
 368     return -1;
 369
 370   if (NULL == (tmp = hv_fetch(hash, "type", 4, 0))) {
 371     log_err("hv2value_list: No type given.");
 372     return -1;
 373   }
 374
 375   sstrncpy(vl->type, SvPV_nolen(*tmp), sizeof(vl->type));
 376
 377   if ((NULL == (tmp = hv_fetch(hash, "values", 6, 0))) ||
 378       (!(SvROK(*tmp) && (SVt_PVAV == SvTYPE(SvRV(*tmp)))))) {
 379     log_err("hv2value_list: No valid values given.");
 380     return -1;
 381   }
 382
 383   {
 384     AV *array = (AV *)SvRV(*tmp);
 385     /* av_len returns the highest index, not the actual length. */
 386     size_t array_len = (size_t)(av_len(array) + 1);
 387     if (array_len == 0)
 388       return -1;
 389
 390     vl->values = calloc(array_len, sizeof(*vl->values));
 391     vl->values_len =
 392         av2value(aTHX_ vl->type, (AV *)SvRV(*tmp), vl->values, array_len);
 393     if (vl->values_len == 0) {
 394       sfree(vl->values);
 395       return -1;
 396     }
 397   }
 398
 399   if (NULL != (tmp = hv_fetch(hash, "time", 4, 0))) {
 400     double t = SvNV(*tmp);
 401     vl->time = DOUBLE_TO_CDTIME_T(t);
 402   }
 403
 404   if (NULL != (tmp = hv_fetch(hash, "interval", 8, 0))) {
 405     double t = SvNV(*tmp);
 406     vl->interval = DOUBLE_TO_CDTIME_T(t);
 407   }
 408
 409   if (NULL != (tmp = hv_fetch(hash, "host", 4, 0)))
 410     sstrncpy(vl->host, SvPV_nolen(*tmp), sizeof(vl->host));
 411
 412   if (NULL != (tmp = hv_fetch(hash, "plugin", 6, 0)))
 413     sstrncpy(vl->plugin, SvPV_nolen(*tmp), sizeof(vl->plugin));
 414
 415   if (NULL != (tmp = hv_fetch(hash, "plugin_instance", 15, 0)))
 416     sstrncpy(vl->plugin_instance, SvPV_nolen(*tmp),
 417              sizeof(vl->plugin_instance));
 418
 419   if (NULL != (tmp = hv_fetch(hash, "type_instance", 13, 0)))
 420     sstrncpy(vl->type_instance, SvPV_nolen(*tmp), sizeof(vl->type_instance));
 421   return 0;
 422 } /* static int hv2value_list (pTHX_ HV *, value_list_t *) */
 423
 424 static int av2data_set(pTHX_ AV *array, char *name, data_set_t *ds) {
 425   int len;
 426
 427   if ((NULL == array) || (NULL == name) || (NULL == ds))
 428     return -1;
 429
 430   len = av_len(array);
 431
 432   if (-1 == len) {
 433     log_err("av2data_set: Invalid data set.");
 434     return -1;
 435   }
 436
 437   ds->ds = smalloc((len + 1) * sizeof(*ds->ds));
 438   ds->ds_num = len + 1;
 439
 440   for (int i = 0; i <= len; ++i) {
 441     SV **elem = av_fetch(array, i, 0);
 442
 443     if (NULL == elem) {
 444       log_err("av2data_set: Failed to fetch data source %i.", i);
 445       return -1;
 446     }
 447
 448     if (!(SvROK(*elem) && (SVt_PVHV == SvTYPE(SvRV(*elem))))) {
 449       log_err("av2data_set: Invalid data source.");
 450       return -1;
 451     }
 452
 453     if (-1 == hv2data_source(aTHX_(HV *) SvRV(*elem), &ds->ds[i]))
 454       return -1;
 455
 456     log_debug("av2data_set: "
 457               "DS.name = \"%s\", DS.type = %i, DS.min = %f, DS.max = %f",
 458               ds->ds[i].name, ds->ds[i].type, ds->ds[i].min, ds->ds[i].max);
 459   }
 460
 461   sstrncpy(ds->type, name, sizeof(ds->type));
 462   return 0;
 463 } /* static int av2data_set (pTHX_ AV *, data_set_t *) */
 464
 465 /*
 466  * notification:
 467  * {
 468  *   severity => $severity,
 469  *   time     => $time,
 470  *   message  => $msg,
 471  *   host     => $host,
 472  *   plugin   => $plugin,
 473  *   type     => $type,
 474  *   plugin_instance => $instance,
 475  *   type_instance   => $type_instance,
 476  *   meta     => [ { name => <name>, value => <value> }, ... ]
 477  * }
 478  */
 479 static int av2notification_meta(pTHX_ AV *array,
 480                                 notification_meta_t **ret_meta) {
 481   notification_meta_t *tail = NULL;
 482
 483   int len = av_len(array);
 484
 485   for (int i = 0; i <= len; ++i) {
 486     SV **tmp = av_fetch(array, i, 0);
 487
 488     if (tmp == NULL)
 489       return -1;
 490
 491     if (!(SvROK(*tmp) && (SVt_PVHV == SvTYPE(SvRV(*tmp))))) {
 492       log_warn("av2notification_meta: Skipping invalid "
 493                "meta information.");
 494       continue;
 495     }
 496
 497     HV *hash = (HV *)SvRV(*tmp);
 498
 499     notification_meta_t *m = calloc(1, sizeof(*m));
 500     if (m == NULL)
 501       return ENOMEM;
 502
 503     SV **name = hv_fetch(hash, "name", strlen("name"), 0);
 504     if (name == NULL) {
 505       log_warn("av2notification_meta: Skipping invalid "
 506                "meta information.");
 507       sfree(m);
 508       continue;
 509     }
 510     sstrncpy(m->name, SvPV_nolen(*name), sizeof(m->name));
 511
 512     SV **value = hv_fetch(hash, "value", strlen("value"), 0);
 513     if (value == NULL) {
 514       log_warn("av2notification_meta: Skipping invalid "
 515                "meta information.");
 516       sfree(m);
 517       continue;
 518     }
 519
 520     if (SvNOK(*value)) {
 521       m->nm_value.nm_double = SvNVX(*value);
 522       m->type = NM_TYPE_DOUBLE;
 523     } else if (SvUOK(*value)) {
 524       m->nm_value.nm_unsigned_int = SvUVX(*value);
 525       m->type = NM_TYPE_UNSIGNED_INT;
 526     } else if (SvIOK(*value)) {
 527       m->nm_value.nm_signed_int = SvIVX(*value);
 528       m->type = NM_TYPE_SIGNED_INT;
 529     } else {
 530       m->nm_value.nm_string = sstrdup(SvPV_nolen(*value));
 531       m->type = NM_TYPE_STRING;
 532     }
 533
 534     m->next = NULL;
 535     if (tail == NULL)
 536       *ret_meta = m;
 537     else
 538       tail->next = m;
 539     tail = m;
 540   }
 541
 542   return 0;
 543 } /* static int av2notification_meta (AV *, notification_meta_t *) */
 544
 545 static int hv2notification(pTHX_ HV *hash, notification_t *n) {
 546   SV **tmp = NULL;
 547
 548   if ((NULL == hash) || (NULL == n))
 549     return -1;
 550
 551   if (NULL != (tmp = hv_fetch(hash, "severity", 8, 0)))
 552     n->severity = SvIV(*tmp);
 553   else
 554     n->severity = NOTIF_FAILURE;
 555
 556   if (NULL != (tmp = hv_fetch(hash, "time", 4, 0))) {
 557     double t = SvNV(*tmp);
 558     n->time = DOUBLE_TO_CDTIME_T(t);
 559   } else
 560     n->time = cdtime();
 561
 562   if (NULL != (tmp = hv_fetch(hash, "message", 7, 0)))
 563     sstrncpy(n->message, SvPV_nolen(*tmp), sizeof(n->message));
 564
 565   if (NULL != (tmp = hv_fetch(hash, "host", 4, 0)))
 566     sstrncpy(n->host, SvPV_nolen(*tmp), sizeof(n->host));
 567   else
 568     sstrncpy(n->host, hostname_g, sizeof(n->host));
 569
 570   if (NULL != (tmp = hv_fetch(hash, "plugin", 6, 0)))
 571     sstrncpy(n->plugin, SvPV_nolen(*tmp), sizeof(n->plugin));
 572
 573   if (NULL != (tmp = hv_fetch(hash, "plugin_instance", 15, 0)))
 574     sstrncpy(n->plugin_instance, SvPV_nolen(*tmp), sizeof(n->plugin_instance));
 575
 576   if (NULL != (tmp = hv_fetch(hash, "type", 4, 0)))
 577     sstrncpy(n->type, SvPV_nolen(*tmp), sizeof(n->type));
 578
 579   if (NULL != (tmp = hv_fetch(hash, "type_instance", 13, 0)))
 580     sstrncpy(n->type_instance, SvPV_nolen(*tmp), sizeof(n->type_instance));
 581
 582   n->meta = NULL;
 583   while (NULL != (tmp = hv_fetch(hash, "meta", 4, 0))) {
 584     if (!(SvROK(*tmp) && (SVt_PVAV == SvTYPE(SvRV(*tmp))))) {
 585       log_warn("hv2notification: Ignoring invalid meta information.");
 586       break;
 587     }
 588
 589     if (0 != av2notification_meta(aTHX_(AV *) SvRV(*tmp), &n->meta)) {
 590       plugin_notification_meta_free(n->meta);
 591       n->meta = NULL;
 592       return -1;
 593     }
 594     break;
 595   }
 596   return 0;
 597 } /* static int hv2notification (pTHX_ HV *, notification_t *) */
 598
 599 static int data_set2av(pTHX_ data_set_t *ds, AV *array) {
 600   if ((NULL == ds) || (NULL == array))
 601     return -1;
 602
 603   av_extend(array, ds->ds_num);
 604
 605   for (size_t i = 0; i < ds->ds_num; ++i) {
 606     HV *source = newHV();
 607
 608     if (NULL == hv_store(source, "name", 4, newSVpv(ds->ds[i].name, 0), 0))
 609       return -1;
 610
 611     if (NULL == hv_store(source, "type", 4, newSViv(ds->ds[i].type), 0))
 612       return -1;
 613
 614     if (!isnan(ds->ds[i].min))
 615       if (NULL == hv_store(source, "min", 3, newSVnv(ds->ds[i].min), 0))
 616         return -1;
 617
 618     if (!isnan(ds->ds[i].max))
 619       if (NULL == hv_store(source, "max", 3, newSVnv(ds->ds[i].max), 0))
 620         return -1;
 621
 622     if (NULL == av_store(array, i, newRV_noinc((SV *)source)))
 623       return -1;
 624   }
 625   return 0;
 626 } /* static int data_set2av (data_set_t *, AV *) */
 627
 628 static int value_list2hv(pTHX_ value_list_t *vl, data_set_t *ds, HV *hash) {
 629   AV *values = NULL;
 630   size_t i;
 631
 632   if ((NULL == vl) || (NULL == ds) || (NULL == hash))
 633     return -1;
 634
 635   values = newAV();
 636   /* av_extend takes the last *index* to which the array should be extended. */
 637   av_extend(values, vl->values_len - 1);
 638
 639   assert(ds->ds_num == vl->values_len);
 640   for (i = 0; i < vl->values_len; ++i) {
 641     SV *val = NULL;
 642
 643     if (DS_TYPE_COUNTER == ds->ds[i].type)
 644       val = newSViv(vl->values[i].counter);
 645     else if (DS_TYPE_GAUGE == ds->ds[i].type)
 646       val = newSVnv(vl->values[i].gauge);
 647     else if (DS_TYPE_DERIVE == ds->ds[i].type)
 648       val = newSViv(vl->values[i].derive);
 649     else if (DS_TYPE_ABSOLUTE == ds->ds[i].type)
 650       val = newSViv(vl->values[i].absolute);
 651
 652     if (NULL == av_store(values, i, val)) {
 653       av_undef(values);
 654       return -1;
 655     }
 656   }
 657
 658   if (NULL == hv_store(hash, "values", 6, newRV_noinc((SV *)values), 0))
 659     return -1;
 660
 661   if (0 != vl->time) {
 662     double t = CDTIME_T_TO_DOUBLE(vl->time);
 663     if (NULL == hv_store(hash, "time", 4, newSVnv(t), 0))
 664       return -1;
 665   }
 666
 667   {
 668     double t = CDTIME_T_TO_DOUBLE(vl->interval);
 669     if (NULL == hv_store(hash, "interval", 8, newSVnv(t), 0))
 670       return -1;
 671   }
 672
 673   if ('\0' != vl->host[0])
 674     if (NULL == hv_store(hash, "host", 4, newSVpv(vl->host, 0), 0))
 675       return -1;
 676
 677   if ('\0' != vl->plugin[0])
 678     if (NULL == hv_store(hash, "plugin", 6, newSVpv(vl->plugin, 0), 0))
 679       return -1;
 680
 681   if ('\0' != vl->plugin_instance[0])
 682     if (NULL == hv_store(hash, "plugin_instance", 15,
 683                          newSVpv(vl->plugin_instance, 0), 0))
 684       return -1;
 685
 686   if ('\0' != vl->type[0])
 687     if (NULL == hv_store(hash, "type", 4, newSVpv(vl->type, 0), 0))
 688       return -1;
 689
 690   if ('\0' != vl->type_instance[0])
 691     if (NULL ==
 692         hv_store(hash, "type_instance", 13, newSVpv(vl->type_instance, 0), 0))
 693       return -1;
 694   return 0;
 695 } /* static int value2av (value_list_t *, data_set_t *, HV *) */
 696
 697 static int notification_meta2av(pTHX_ notification_meta_t *meta, AV *array) {
 698   int meta_num = 0;
 699   for (notification_meta_t *m = meta; m != NULL; m = m->next) {
 700     ++meta_num;
 701   }
 702
 703   av_extend(array, meta_num);
 704
 705   for (int i = 0; NULL != meta; meta = meta->next, ++i) {
 706     HV *m = newHV();
 707     SV *value;
 708
 709     if (NULL == hv_store(m, "name", 4, newSVpv(meta->name, 0), 0))
 710       return -1;
 711
 712     if (NM_TYPE_STRING == meta->type)
 713       value = newSVpv(meta->nm_value.nm_string, 0);
 714     else if (NM_TYPE_SIGNED_INT == meta->type)
 715       value = newSViv(meta->nm_value.nm_signed_int);
 716     else if (NM_TYPE_UNSIGNED_INT == meta->type)
 717       value = newSVuv(meta->nm_value.nm_unsigned_int);
 718     else if (NM_TYPE_DOUBLE == meta->type)
 719       value = newSVnv(meta->nm_value.nm_double);
 720     else if (NM_TYPE_BOOLEAN == meta->type)
 721       value = meta->nm_value.nm_boolean ? &PL_sv_yes : &PL_sv_no;
 722     else
 723       return -1;
 724
 725     if (NULL == hv_store(m, "value", 5, value, 0)) {
 726       sv_free(value);
 727       return -1;
 728     }
 729
 730     if (NULL == av_store(array, i, newRV_noinc((SV *)m))) {
 731       hv_clear(m);
 732       hv_undef(m);
 733       return -1;
 734     }
 735   }
 736   return 0;
 737 } /* static int notification_meta2av (notification_meta_t *, AV *) */
 738
 739 static int notification2hv(pTHX_ notification_t *n, HV *hash) {
 740   if (NULL == hv_store(hash, "severity", 8, newSViv(n->severity), 0))
 741     return -1;
 742
 743   if (0 != n->time) {
 744     double t = CDTIME_T_TO_DOUBLE(n->time);
 745     if (NULL == hv_store(hash, "time", 4, newSVnv(t), 0))
 746       return -1;
 747   }
 748
 749   if ('\0' != *n->message)
 750     if (NULL == hv_store(hash, "message", 7, newSVpv(n->message, 0), 0))
 751       return -1;
 752
 753   if ('\0' != *n->host)
 754     if (NULL == hv_store(hash, "host", 4, newSVpv(n->host, 0), 0))
 755       return -1;
 756
 757   if ('\0' != *n->plugin)
 758     if (NULL == hv_store(hash, "plugin", 6, newSVpv(n->plugin, 0), 0))
 759       return -1;
 760
 761   if ('\0' != *n->plugin_instance)
 762     if (NULL == hv_store(hash, "plugin_instance", 15,
 763                          newSVpv(n->plugin_instance, 0), 0))
 764       return -1;
 765
 766   if ('\0' != *n->type)
 767     if (NULL == hv_store(hash, "type", 4, newSVpv(n->type, 0), 0))
 768       return -1;
 769
 770   if ('\0' != *n->type_instance)
 771     if (NULL ==
 772         hv_store(hash, "type_instance", 13, newSVpv(n->type_instance, 0), 0))
 773       return -1;
 774
 775   if (NULL != n->meta) {
 776     AV *meta = newAV();
 777     if ((0 != notification_meta2av(aTHX_ n->meta, meta)) ||
 778         (NULL == hv_store(hash, "meta", 4, newRV_noinc((SV *)meta), 0))) {
 779       av_clear(meta);
 780       av_undef(meta);
 781       return -1;
 782     }
 783   }
 784   return 0;
 785 } /* static int notification2hv (notification_t *, HV *) */
 786
 787 static int oconfig_item2hv(pTHX_ oconfig_item_t *ci, HV *hash) {
 788   AV *values;
 789   AV *children;
 790
 791   if (NULL == hv_store(hash, "key", 3, newSVpv(ci->key, 0), 0))
 792     return -1;
 793
 794   values = newAV();
 795   if (0 < ci->values_num)
 796     av_extend(values, ci->values_num);
 797
 798   if (NULL == hv_store(hash, "values", 6, newRV_noinc((SV *)values), 0)) {
 799     av_clear(values);
 800     av_undef(values);
 801     return -1;
 802   }
 803
 804   for (int i = 0; i < ci->values_num; ++i) {
 805     SV *value;
 806
 807     switch (ci->values[i].type) {
 808     case OCONFIG_TYPE_STRING:
 809       value = newSVpv(ci->values[i].value.string, 0);
 810       break;
 811     case OCONFIG_TYPE_NUMBER:
 812       value = newSVnv((NV)ci->values[i].value.number);
 813       break;
 814     case OCONFIG_TYPE_BOOLEAN:
 815       value = ci->values[i].value.boolean ? &PL_sv_yes : &PL_sv_no;
 816       break;
 817     default:
 818       log_err("oconfig_item2hv: Invalid value type %i.", ci->values[i].type);
 819       value = &PL_sv_undef;
 820     }
 821
 822     if (NULL == av_store(values, i, value)) {
 823       sv_free(value);
 824       return -1;
 825     }
 826   }
 827
 828   /* ignoring 'parent' member which is uninteresting in this case */
 829
 830   children = newAV();
 831   if (0 < ci->children_num)
 832     av_extend(children, ci->children_num);
 833
 834   if (NULL == hv_store(hash, "children", 8, newRV_noinc((SV *)children), 0)) {
 835     av_clear(children);
 836     av_undef(children);
 837     return -1;
 838   }
 839
 840   for (int i = 0; i < ci->children_num; ++i) {
 841     HV *child = newHV();
 842
 843     if (0 != oconfig_item2hv(aTHX_ ci->children + i, child)) {
 844       hv_clear(child);
 845       hv_undef(child);
 846       return -1;
 847     }
 848
 849     if (NULL == av_store(children, i, newRV_noinc((SV *)child))) {
 850       hv_clear(child);
 851       hv_undef(child);
 852       return -1;
 853     }
 854   }
 855   return 0;
 856 } /* static int oconfig_item2hv (pTHX_ oconfig_item_t *, HV *) */
 857
 858 /*
 859  * Internal functions.
 860  */
 861
 862 static char *get_module_name(char *buf, size_t buf_len, const char *module) {
 863   int status = 0;
 864   if (base_name[0] == '\0')
 865     status = snprintf(buf, buf_len, "%s", module);
 866   else
 867     status = snprintf(buf, buf_len, "%s::%s", base_name, module);
 868   if ((status < 0) || ((unsigned int)status >= buf_len))
 869     return NULL;
 870   return buf;
 871 } /* char *get_module_name */
 872
 873 /*
 874  * Add a plugin's data set definition.
 875  */
 876 static int pplugin_register_data_set(pTHX_ char *name, AV *dataset) {
 877   int ret = 0;
 878
 879   data_set_t ds;
 880
 881   if ((NULL == name) || (NULL == dataset))
 882     return -1;
 883
 884   if (0 != av2data_set(aTHX_ dataset, name, &ds))
 885     return -1;
 886
 887   ret = plugin_register_data_set(&ds);
 888
 889   free(ds.ds);
 890   return ret;
 891 } /* static int pplugin_register_data_set (char *, SV *) */
 892
 893 /*
 894  * Remove a plugin's data set definition.
 895  */
 896 static int pplugin_unregister_data_set(char *name) {
 897   if (NULL == name)
 898     return 0;
 899   return plugin_unregister_data_set(name);
 900 } /* static int pplugin_unregister_data_set (char *) */
 901
 902 /*
 903  * Submit the values to the write functions.
 904  */
 905 static int pplugin_dispatch_values(pTHX_ HV *values) {
 906   value_list_t vl = VALUE_LIST_INIT;
 907
 908   int ret = 0;
 909
 910   if (NULL == values)
 911     return -1;
 912
 913   if (0 != hv2value_list(aTHX_ values, &vl))
 914     return -1;
 915
 916   ret = plugin_dispatch_values(&vl);
 917
 918   sfree(vl.values);
 919   return ret;
 920 } /* static int pplugin_dispatch_values (char *, HV *) */
 921
 922 /*
 923  * Submit the values to a single write function.
 924  */
 925 static int pplugin_write(pTHX_ const char *plugin, AV *data_set, HV *values) {
 926   data_set_t ds;
 927   value_list_t vl = VALUE_LIST_INIT;
 928
 929   int ret;
 930
 931   if (NULL == values)
 932     return -1;
 933
 934   if (0 != hv2value_list(aTHX_ values, &vl))
 935     return -1;
 936
 937   if ((NULL != data_set) && (0 != av2data_set(aTHX_ data_set, vl.type, &ds)))
 938     return -1;
 939
 940   ret = plugin_write(plugin, NULL == data_set ? NULL : &ds, &vl);
 941   if (0 != ret)
 942     log_warn("Dispatching value to plugin \"%s\" failed with status %i.",
 943              NULL == plugin ? "<any>" : plugin, ret);
 944
 945   if (NULL != data_set)
 946     sfree(ds.ds);
 947   sfree(vl.values);
 948   return ret;
 949 } /* static int pplugin_write (const char *plugin, HV *, HV *) */
 950
 951 /*
 952  * Dispatch a notification.
 953  */
 954 static int pplugin_dispatch_notification(pTHX_ HV *notif) {
 955   notification_t n = {0};
 956
 957   int ret;
 958
 959   if (NULL == notif)
 960     return -1;
 961
 962   if (0 != hv2notification(aTHX_ notif, &n))
 963     return -1;
 964
 965   ret = plugin_dispatch_notification(&n);
 966   plugin_notification_meta_free(n.meta);
 967   return ret;
 968 } /* static int pplugin_dispatch_notification (HV *) */
 969
 970 /*
 971  * Call perl sub with thread locking flags handled.
 972  */
 973 static int call_pv_locked(pTHX_ const char *sub_name) {
 974   bool old_running;
 975   int ret;
 976
 977   c_ithread_t *t = (c_ithread_t *)pthread_getspecific(perl_thr_key);
 978   if (t == NULL) /* thread destroyed */
 979     return 0;
 980
 981   old_running = t->running;
 982   t->running = true;
 983
 984   if (t->shutdown) {
 985     t->running = old_running;
 986     return 0;
 987   }
 988
 989   ret = call_pv(sub_name, G_SCALAR | G_EVAL);
 990
 991   t->running = old_running;
 992   return ret;
 993 } /* static int call_pv_locked (pTHX, *sub_name) */
 994
 995 /*
 996  * Call all working functions of the given type.
 997  */
 998 static int pplugin_call(pTHX_ int type, ...) {
 999   int retvals = 0;
1000
1001   va_list ap;
1002   int ret = 0;
1003   char *subname;
1004
1005   dSP;
1006
1007   if ((type < 0) || (type >= PLUGIN_TYPES))
1008     return -1;
1009
1010   va_start(ap, type);
1011
1012   ENTER;
1013   SAVETMPS;
1014
1015   PUSHMARK(SP);
1016
1017   if (PLUGIN_READ == type) {
1018     subname = va_arg(ap, char *);
1019   } else if (PLUGIN_WRITE == type) {
1020     data_set_t *ds;
1021     value_list_t *vl;
1022
1023     AV *pds = newAV();
1024     HV *pvl = newHV();
1025
1026     subname = va_arg(ap, char *);
1027     /*
1028      * $_[0] = $plugin_type;
1029      *
1030      * $_[1] =
1031      * [
1032      *   {
1033      *     name => $ds_name,
1034      *     type => $ds_type,
1035      *     min  => $ds_min,
1036      *     max  => $ds_max
1037      *   },
1038      *   ...
1039      * ];
1040      *
1041      * $_[2] =
1042      * {
1043      *   values => [ $v1, ... ],
1044      *   time   => $time,
1045      *   host   => $hostname,
1046      *   plugin => $plugin,
1047      *   type   => $type,
1048      *   plugin_instance => $instance,
1049      *   type_instance   => $type_instance
1050      * };
1051      */
1052     ds = va_arg(ap, data_set_t *);
1053     vl = va_arg(ap, value_list_t *);
1054
1055     if (-1 == data_set2av(aTHX_ ds, pds)) {
1056       av_clear(pds);
1057       av_undef(pds);
1058       pds = (AV *)&PL_sv_undef;
1059       ret = -1;
1060     }
1061
1062     if (-1 == value_list2hv(aTHX_ vl, ds, pvl)) {
1063       hv_clear(pvl);
1064       hv_undef(pvl);
1065       pvl = (HV *)&PL_sv_undef;
1066       ret = -1;
1067     }
1068
1069     XPUSHs(sv_2mortal(newSVpv(ds->type, 0)));
1070     XPUSHs(sv_2mortal(newRV_noinc((SV *)pds)));
1071     XPUSHs(sv_2mortal(newRV_noinc((SV *)pvl)));
1072   } else if (PLUGIN_LOG == type) {
1073     subname = va_arg(ap, char *);
1074     /*
1075      * $_[0] = $level;
1076      *
1077      * $_[1] = $message;
1078      */
1079     XPUSHs(sv_2mortal(newSViv(va_arg(ap, int))));
1080     XPUSHs(sv_2mortal(newSVpv(va_arg(ap, char *), 0)));
1081   } else if (PLUGIN_NOTIF == type) {
1082     notification_t *n;
1083     HV *notif = newHV();
1084
1085     subname = va_arg(ap, char *);
1086     /*
1087      * $_[0] =
1088      * {
1089      *   severity => $severity,
1090      *   time     => $time,
1091      *   message  => $msg,
1092      *   host     => $host,
1093      *   plugin   => $plugin,
1094      *   type     => $type,
1095      *   plugin_instance => $instance,
1096      *   type_instance   => $type_instance
1097      * };
1098      */
1099     n = va_arg(ap, notification_t *);
1100
1101     if (-1 == notification2hv(aTHX_ n, notif)) {
1102       hv_clear(notif);
1103       hv_undef(notif);
1104       notif = (HV *)&PL_sv_undef;
1105       ret = -1;
1106     }
1107
1108     XPUSHs(sv_2mortal(newRV_noinc((SV *)notif)));
1109   } else if (PLUGIN_FLUSH == type) {
1110     cdtime_t timeout;
1111     subname = va_arg(ap, char *);
1112     /*
1113      * $_[0] = $timeout;
1114      * $_[1] = $identifier;
1115      */
1116     timeout = va_arg(ap, cdtime_t);
1117
1118     XPUSHs(sv_2mortal(newSVnv(CDTIME_T_TO_DOUBLE(timeout))));
1119     XPUSHs(sv_2mortal(newSVpv(va_arg(ap, char *), 0)));
1120   } else if (PLUGIN_FLUSH_ALL == type) {
1121     cdtime_t timeout;
1122     subname = "Collectd::plugin_call_all";
1123     /*
1124      * $_[0] = $timeout;
1125      * $_[1] = $identifier;
1126      */
1127     timeout = va_arg(ap, cdtime_t);
1128
1129     XPUSHs(sv_2mortal(newSViv((IV)PLUGIN_FLUSH)));
1130     XPUSHs(sv_2mortal(newSVnv(CDTIME_T_TO_DOUBLE(timeout))));
1131     XPUSHs(sv_2mortal(newSVpv(va_arg(ap, char *), 0)));
1132   } else if (PLUGIN_INIT == type) {
1133     subname = "Collectd::plugin_call_all";
1134     XPUSHs(sv_2mortal(newSViv((IV)type)));
1135   } else if (PLUGIN_SHUTDOWN == type) {
1136     subname = "Collectd::plugin_call_all";
1137     XPUSHs(sv_2mortal(newSViv((IV)type)));
1138   } else { /* Unknown type. Run 'plugin_call_all' and make compiler happy */
1139     subname = "Collectd::plugin_call_all";
1140     XPUSHs(sv_2mortal(newSViv((IV)type)));
1141   }
1142
1143   PUTBACK;
1144
1145   retvals = call_pv_locked(aTHX_ subname);
1146
1147   SPAGAIN;
1148   if (SvTRUE(ERRSV)) {
1149     if (PLUGIN_LOG != type)
1150       ERROR("perl: %s error: %s", subname, SvPV_nolen(ERRSV));
1151     ret = -1;
1152   } else if (0 < retvals) {
1153     SV *tmp = POPs;
1154     if (!SvTRUE(tmp))
1155       ret = -1;
1156   }
1157
1158   PUTBACK;
1159   FREETMPS;
1160   LEAVE;
1161
1162   va_end(ap);
1163   return ret;
1164 } /* static int pplugin_call (int, ...) */
1165
1166 /*
1167  * collectd's Perl interpreter based thread implementation.
1168  *
1169  * This has been inspired by Perl's ithreads introduced in version 5.6.0.
1170  */
1171
1172 /* must be called with perl_threads->mutex locked */
1173 static void c_ithread_destroy(c_ithread_t *ithread) {
1174   dTHXa(ithread->interp);
1175
1176   assert(NULL != perl_threads);
1177
1178   PERL_SET_CONTEXT(aTHX);
1179   /* Mark as running to avoid deadlock:
1180      c_ithread_destroy -> log_debug -> perl_log()
1181   */
1182   ithread->running = true;
1183   log_debug("Shutting down Perl interpreter %p...", aTHX);
1184
1185 #if COLLECT_DEBUG
1186   sv_report_used();
1187
1188   --perl_threads->number_of_threads;
1189 #endif /* COLLECT_DEBUG */
1190
1191   perl_destruct(aTHX);
1192   perl_free(aTHX);
1193
1194   if (NULL == ithread->prev)
1195     perl_threads->head = ithread->next;
1196   else
1197     ithread->prev->next = ithread->next;
1198
1199   if (NULL == ithread->next)
1200     perl_threads->tail = ithread->prev;
1201   else
1202     ithread->next->prev = ithread->prev;
1203
1204   sfree(ithread);
1205   return;
1206 } /* static void c_ithread_destroy (c_ithread_t *) */
1207
1208 static void c_ithread_destructor(void *arg) {
1209   c_ithread_t *ithread = (c_ithread_t *)arg;
1210   c_ithread_t *t = NULL;
1211
1212   if (NULL == perl_threads)
1213     return;
1214
1215   pthread_mutex_lock(&perl_threads->mutex);
1216
1217   for (t = perl_threads->head; NULL != t; t = t->next)
1218     if (t == ithread)
1219       break;
1220
1221   /* the ithread no longer exists */
1222   if (NULL == t) {
1223     pthread_mutex_unlock(&perl_threads->mutex);
1224     return;
1225   }
1226
1227   c_ithread_destroy(ithread);
1228
1229   pthread_mutex_unlock(&perl_threads->mutex);
1230   return;
1231 } /* static void c_ithread_destructor (void *) */
1232
1233 /* must be called with perl_threads->mutex locked */
1234 static c_ithread_t *c_ithread_create(PerlInterpreter *base) {
1235   c_ithread_t *t = NULL;
1236   dTHXa(NULL);
1237
1238   assert(NULL != perl_threads);
1239
1240   t = smalloc(sizeof(*t));
1241   memset(t, 0, sizeof(c_ithread_t));
1242
1243   t->interp = (NULL == base) ? NULL : perl_clone(base, CLONEf_KEEP_PTR_TABLE);
1244
1245   aTHX = t->interp;
1246
1247   if ((NULL != base) && (NULL != PL_endav)) {
1248     av_clear(PL_endav);
1249     av_undef(PL_endav);
1250     PL_endav = Nullav;
1251   }
1252
1253 #if COLLECT_DEBUG
1254   ++perl_threads->number_of_threads;
1255 #endif /* COLLECT_DEBUG */
1256
1257   t->next = NULL;
1258
1259   if (NULL == perl_threads->tail) {
1260     perl_threads->head = t;
1261     t->prev = NULL;
1262   } else {
1263     perl_threads->tail->next = t;
1264     t->prev = perl_threads->tail;
1265   }
1266
1267   t->pthread = pthread_self();
1268   t->running = false;
1269   t->shutdown = false;
1270   perl_threads->tail = t;
1271
1272   pthread_setspecific(perl_thr_key, (const void *)t);
1273   return t;
1274 } /* static c_ithread_t *c_ithread_create (PerlInterpreter *) */
1275
1276 /*
1277  * Filter chains implementation.
1278  */
1279
1280 static int fc_call(pTHX_ int type, int cb_type, pfc_user_data_t *data, ...) {
1281   int retvals = 0;
1282
1283   va_list ap;
1284   int ret = 0;
1285
1286   notification_meta_t **meta = NULL;
1287   AV *pmeta = NULL;
1288
1289   dSP;
1290
1291   if ((type < 0) || (type >= FC_TYPES))
1292     return -1;
1293
1294   if ((cb_type < 0) || (cb_type >= FC_CB_TYPES))
1295     return -1;
1296
1297   va_start(ap, data);
1298
1299   ENTER;
1300   SAVETMPS;
1301
1302   PUSHMARK(SP);
1303
1304   XPUSHs(sv_2mortal(newSViv((IV)type)));
1305   XPUSHs(sv_2mortal(newSVpv(data->name, 0)));
1306   XPUSHs(sv_2mortal(newSViv((IV)cb_type)));
1307
1308   if (FC_CB_CREATE == cb_type) {
1309     /*
1310      * $_[0] = $ci;
1311      * $_[1] = $user_data;
1312      */
1313     oconfig_item_t *ci;
1314     HV *config = newHV();
1315
1316     ci = va_arg(ap, oconfig_item_t *);
1317
1318     if (0 != oconfig_item2hv(aTHX_ ci, config)) {
1319       hv_clear(config);
1320       hv_undef(config);
1321       config = (HV *)&PL_sv_undef;
1322       ret = -1;
1323     }
1324
1325     XPUSHs(sv_2mortal(newRV_noinc((SV *)config)));
1326   } else if (FC_CB_DESTROY == cb_type) {
1327     /*
1328      * $_[1] = $user_data;
1329      */
1330
1331     /* nothing to be done - the user data pointer
1332      * is pushed onto the stack later */
1333   } else if (FC_CB_EXEC == cb_type) {
1334     /*
1335      * $_[0] = $ds;
1336      * $_[1] = $vl;
1337      * $_[2] = $meta;
1338      * $_[3] = $user_data;
1339      */
1340     data_set_t *ds;
1341     value_list_t *vl;
1342
1343     AV *pds = newAV();
1344     HV *pvl = newHV();
1345
1346     ds = va_arg(ap, data_set_t *);
1347     vl = va_arg(ap, value_list_t *);
1348     meta = va_arg(ap, notification_meta_t **);
1349
1350     if (0 != data_set2av(aTHX_ ds, pds)) {
1351       av_clear(pds);
1352       av_undef(pds);
1353       pds = (AV *)&PL_sv_undef;
1354       ret = -1;
1355     }
1356
1357     if (0 != value_list2hv(aTHX_ vl, ds, pvl)) {
1358       hv_clear(pvl);
1359       hv_undef(pvl);
1360       pvl = (HV *)&PL_sv_undef;
1361       ret = -1;
1362     }
1363
1364     if (NULL != meta) {
1365       pmeta = newAV();
1366
1367       if (0 != notification_meta2av(aTHX_ * meta, pmeta)) {
1368         av_clear(pmeta);
1369         av_undef(pmeta);
1370         pmeta = (AV *)&PL_sv_undef;
1371         ret = -1;
1372       }
1373     } else {
1374       pmeta = (AV *)&PL_sv_undef;
1375     }
1376
1377     XPUSHs(sv_2mortal(newRV_noinc((SV *)pds)));
1378     XPUSHs(sv_2mortal(newRV_noinc((SV *)pvl)));
1379     XPUSHs(sv_2mortal(newRV_noinc((SV *)pmeta)));
1380   }
1381
1382   XPUSHs(sv_2mortal(newRV_inc(data->user_data)));
1383
1384   PUTBACK;
1385
1386   retvals = call_pv_locked(aTHX_ "Collectd::fc_call");
1387
1388   if ((FC_CB_EXEC == cb_type) && (meta != NULL)) {
1389     assert(pmeta != NULL);
1390
1391     plugin_notification_meta_free(*meta);
1392     av2notification_meta(aTHX_ pmeta, meta);
1393   }
1394
1395   SPAGAIN;
1396   if (SvTRUE(ERRSV)) {
1397     ERROR("perl: Collectd::fc_call error: %s", SvPV_nolen(ERRSV));
1398     ret = -1;
1399   } else if (0 < retvals) {
1400     SV *tmp = POPs;
1401
1402     /* the exec callbacks return a status, while
1403      * the others return a boolean value */
1404     if (FC_CB_EXEC == cb_type)
1405       ret = SvIV(tmp);
1406     else if (!SvTRUE(tmp))
1407       ret = -1;
1408   }
1409
1410   PUTBACK;
1411   FREETMPS;
1412   LEAVE;
1413
1414   va_end(ap);
1415   return ret;
1416 } /* static int fc_call (int, int, pfc_user_data_t *, ...) */
1417
1418 static int fc_create(int type, const oconfig_item_t *ci, void **user_data) {
1419   pfc_user_data_t *data;
1420
1421   int ret = 0;
1422
1423   dTHX;
1424
1425   if (NULL == perl_threads)
1426     return 0;
1427
1428   if (NULL == aTHX) {
1429     c_ithread_t *t = NULL;
1430
1431     pthread_mutex_lock(&perl_threads->mutex);
1432     t = c_ithread_create(perl_threads->head->interp);
1433     pthread_mutex_unlock(&perl_threads->mutex);
1434
1435     aTHX = t->interp;
1436   }
1437
1438   log_debug("fc_create: c_ithread: interp = %p (active threads: %i)", aTHX,
1439             perl_threads->number_of_threads);
1440
1441   if ((1 != ci->values_num) || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
1442     log_warn("A \"%s\" block expects a single string argument.",
1443              (FC_MATCH == type) ? "Match" : "Target");
1444     return -1;
1445   }
1446
1447   data = smalloc(sizeof(*data));
1448   data->name = sstrdup(ci->values[0].value.string);
1449   data->user_data = newSV(0);
1450
1451   ret = fc_call(aTHX_ type, FC_CB_CREATE, data, ci);
1452
1453   if (0 != ret)
1454     PFC_USER_DATA_FREE(data);
1455   else
1456     *user_data = data;
1457   return ret;
1458 } /* static int fc_create (int, const oconfig_item_t *, void **) */
1459
1460 static int fc_destroy(int type, void **user_data) {
1461   pfc_user_data_t *data = *(pfc_user_data_t **)user_data;
1462
1463   int ret = 0;
1464
1465   dTHX;
1466
1467   if ((NULL == perl_threads) || (NULL == data))
1468     return 0;
1469
1470   if (NULL == aTHX) {
1471     c_ithread_t *t = NULL;
1472
1473     pthread_mutex_lock(&perl_threads->mutex);
1474     t = c_ithread_create(perl_threads->head->interp);
1475     pthread_mutex_unlock(&perl_threads->mutex);
1476
1477     aTHX = t->interp;
1478   }
1479
1480   log_debug("fc_destroy: c_ithread: interp = %p (active threads: %i)", aTHX,
1481             perl_threads->number_of_threads);
1482
1483   ret = fc_call(aTHX_ type, FC_CB_DESTROY, data);
1484
1485   PFC_USER_DATA_FREE(data);
1486   *user_data = NULL;
1487   return ret;
1488 } /* static int fc_destroy (int, void **) */
1489
1490 static int fc_exec(int type, const data_set_t *ds, const value_list_t *vl,
1491                    notification_meta_t **meta, void **user_data) {
1492   pfc_user_data_t *data = *(pfc_user_data_t **)user_data;
1493
1494   dTHX;
1495
1496   if (NULL == perl_threads)
1497     return 0;
1498
1499   assert(NULL != data);
1500
1501   if (NULL == aTHX) {
1502     c_ithread_t *t = NULL;
1503
1504     pthread_mutex_lock(&perl_threads->mutex);
1505     t = c_ithread_create(perl_threads->head->interp);
1506     pthread_mutex_unlock(&perl_threads->mutex);
1507
1508     aTHX = t->interp;
1509   }
1510
1511   log_debug("fc_exec: c_ithread: interp = %p (active threads: %i)", aTHX,
1512             perl_threads->number_of_threads);
1513
1514   return fc_call(aTHX_ type, FC_CB_EXEC, data, ds, vl, meta);
1515 } /* static int fc_exec (int, const data_set_t *, const value_list_t *,
1516                 notification_meta_t **, void **) */
1517
1518 static int pmatch_create(const oconfig_item_t *ci, void **user_data) {
1519   return fc_create(FC_MATCH, ci, user_data);
1520 } /* static int pmatch_create (const oconfig_item_t *, void **) */
1521
1522 static int pmatch_destroy(void **user_data) {
1523   return fc_destroy(FC_MATCH, user_data);
1524 } /* static int pmatch_destroy (void **) */
1525
1526 static int pmatch_match(const data_set_t *ds, const value_list_t *vl,
1527                         notification_meta_t **meta, void **user_data) {
1528   return fc_exec(FC_MATCH, ds, vl, meta, user_data);
1529 } /* static int pmatch_match (const data_set_t *, const value_list_t *,
1530                 notification_meta_t **, void **) */
1531
1532 static match_proc_t pmatch = {pmatch_create, pmatch_destroy, pmatch_match};
1533
1534 static int ptarget_create(const oconfig_item_t *ci, void **user_data) {
1535   return fc_create(FC_TARGET, ci, user_data);
1536 } /* static int ptarget_create (const oconfig_item_t *, void **) */
1537
1538 static int ptarget_destroy(void **user_data) {
1539   return fc_destroy(FC_TARGET, user_data);
1540 } /* static int ptarget_destroy (void **) */
1541
1542 static int ptarget_invoke(const data_set_t *ds, value_list_t *vl,
1543                           notification_meta_t **meta, void **user_data) {
1544   return fc_exec(FC_TARGET, ds, vl, meta, user_data);
1545 } /* static int ptarget_invoke (const data_set_t *, value_list_t *,
1546                 notification_meta_t **, void **) */
1547
1548 static target_proc_t ptarget = {ptarget_create, ptarget_destroy,
1549                                 ptarget_invoke};
1550
1551 /*
1552  * Exported Perl API.
1553  */
1554
1555 static void _plugin_register_generic_userdata(pTHX, int type,
1556                                               const char *desc) {
1557   int ret = 0;
1558   user_data_t userdata;
1559   char *pluginname;
1560
1561   dXSARGS;
1562
1563   if (2 != items) {
1564     log_err("Usage: Collectd::plugin_register_%s(pluginname, subname)", desc);
1565     XSRETURN_EMPTY;
1566   }
1567
1568   if (!SvOK(ST(0))) {
1569     log_err("Collectd::plugin_register_%s(pluginname, subname): "
1570             "Invalid pluginname",
1571             desc);
1572     XSRETURN_EMPTY;
1573   }
1574   if (!SvOK(ST(1))) {
1575     log_err("Collectd::plugin_register_%s(pluginname, subname): "
1576             "Invalid subname",
1577             desc);
1578     XSRETURN_EMPTY;
1579   }
1580
1581   /* Use pluginname as-is to allow flush a single perl plugin */
1582   pluginname = SvPV_nolen(ST(0));
1583
1584   log_debug("Collectd::plugin_register_%s: "
1585             "plugin = \"%s\", sub = \"%s\"",
1586             desc, pluginname, SvPV_nolen(ST(1)));
1587
1588   memset(&userdata, 0, sizeof(userdata));
1589   userdata.data = strdup(SvPV_nolen(ST(1)));
1590   userdata.free_func = free;
1591
1592   if (PLUGIN_READ == type) {
1593     ret = plugin_register_complex_read(
1594         "perl",                                       /* group */
1595         pluginname, perl_read, plugin_get_interval(), /* Default interval */
1596         &userdata);
1597   } else if (PLUGIN_WRITE == type) {
1598     ret = plugin_register_write(pluginname, perl_write, &userdata);
1599   } else if (PLUGIN_LOG == type) {
1600     ret = plugin_register_log(pluginname, perl_log, &userdata);
1601   } else if (PLUGIN_NOTIF == type) {
1602     ret = plugin_register_notification(pluginname, perl_notify, &userdata);
1603   } else if (PLUGIN_FLUSH == type) {
1604     if (1 == register_legacy_flush) { /* For collectd-5.7 only, #1731 */
1605       register_legacy_flush = 0;
1606       ret = plugin_register_flush("perl", perl_flush, /* user_data = */ NULL);
1607     }
1608
1609     if (0 == ret) {
1610       ret = plugin_register_flush(pluginname, perl_flush, &userdata);
1611     } else {
1612       free(userdata.data);
1613     }
1614   } else {
1615     ret = -1;
1616   }
1617
1618   if (0 == ret)
1619     XSRETURN_YES;
1620   else
1621     XSRETURN_EMPTY;
1622 } /* static void _plugin_register_generic_userdata ( ... ) */
1623
1624 /*
1625  * Collectd::plugin_register_TYPE (pluginname, subname).
1626  *
1627  * pluginname:
1628  *   name of the perl plugin
1629  *
1630  * subname:
1631  *   name of the plugin's subroutine that does the work
1632  */
1633
1634 static XS(Collectd_plugin_register_read) {
1635   _plugin_register_generic_userdata(aTHX, PLUGIN_READ, "read");
1636 }
1637
1638 static XS(Collectd_plugin_register_write) {
1639   _plugin_register_generic_userdata(aTHX, PLUGIN_WRITE, "write");
1640 }
1641
1642 static XS(Collectd_plugin_register_log) {
1643   _plugin_register_generic_userdata(aTHX, PLUGIN_LOG, "log");
1644 }
1645
1646 static XS(Collectd_plugin_register_notification) {
1647   _plugin_register_generic_userdata(aTHX, PLUGIN_NOTIF, "notification");
1648 }
1649
1650 static XS(Collectd_plugin_register_flush) {
1651   _plugin_register_generic_userdata(aTHX, PLUGIN_FLUSH, "flush");
1652 }
1653
1654 typedef int perl_unregister_function_t(const char *name);
1655
1656 static void _plugin_unregister_generic(pTHX, perl_unregister_function_t *unreg,
1657                                        const char *desc) {
1658   dXSARGS;
1659
1660   if (1 != items) {
1661     log_err("Usage: Collectd::plugin_unregister_%s(pluginname)", desc);
1662     XSRETURN_EMPTY;
1663   }
1664
1665   if (!SvOK(ST(0))) {
1666     log_err("Collectd::plugin_unregister_%s(pluginname): "
1667             "Invalid pluginname",
1668             desc);
1669     XSRETURN_EMPTY;
1670   }
1671
1672   log_debug("Collectd::plugin_unregister_%s: plugin = \"%s\"", desc,
1673             SvPV_nolen(ST(0)));
1674
1675   unreg(SvPV_nolen(ST(0)));
1676
1677   XSRETURN_EMPTY;
1678 } /* static void _plugin_unregister_generic ( ... ) */
1679
1680 /*
1681  * Collectd::plugin_unregister_TYPE (pluginname).
1682  *
1683  * TYPE:
1684  *   type of callback to be unregistered: read, write, log, notification, flush
1685  *
1686  * pluginname:
1687  *   name of the perl plugin
1688  */
1689
1690 static XS(Collectd_plugin_unregister_read) {
1691   _plugin_unregister_generic(aTHX, plugin_unregister_read, "read");
1692 }
1693
1694 static XS(Collectd_plugin_unregister_write) {
1695   _plugin_unregister_generic(aTHX, plugin_unregister_write, "write");
1696 }
1697
1698 static XS(Collectd_plugin_unregister_log) {
1699   _plugin_unregister_generic(aTHX, plugin_unregister_log, "log");
1700 }
1701
1702 static XS(Collectd_plugin_unregister_notification) {
1703   _plugin_unregister_generic(aTHX, plugin_unregister_notification,
1704                              "notification");
1705 }
1706
1707 static XS(Collectd_plugin_unregister_flush) {
1708   _plugin_unregister_generic(aTHX, plugin_unregister_flush, "flush");
1709 }
1710
1711 /*
1712  * Collectd::plugin_register_data_set (type, dataset).
1713  *
1714  * type:
1715  *   type of the dataset
1716  *
1717  * dataset:
1718  *   dataset to be registered
1719  */
1720 static XS(Collectd_plugin_register_ds) {
1721   SV *data = NULL;
1722   int ret = 0;
1723
1724   dXSARGS;
1725
1726   log_warn("Using plugin_register() to register new data-sets is "
1727            "deprecated - add new entries to a custom types.db instead.");
1728
1729   if (2 != items) {
1730     log_err("Usage: Collectd::plugin_register_data_set(type, dataset)");
1731     XSRETURN_EMPTY;
1732   }
1733
1734   log_debug("Collectd::plugin_register_data_set: "
1735             "type = \"%s\", dataset = \"%s\"",
1736             SvPV_nolen(ST(0)), SvPV_nolen(ST(1)));
1737
1738   data = ST(1);
1739
1740   if (SvROK(data) && (SVt_PVAV == SvTYPE(SvRV(data)))) {
1741     ret = pplugin_register_data_set(aTHX_ SvPV_nolen(ST(0)), (AV *)SvRV(data));
1742   } else {
1743     log_err("Collectd::plugin_register_data_set: Invalid data.");
1744     XSRETURN_EMPTY;
1745   }
1746
1747   if (0 == ret)
1748     XSRETURN_YES;
1749   else
1750     XSRETURN_EMPTY;
1751 } /* static XS (Collectd_plugin_register_ds) */
1752
1753 /*
1754  * Collectd::plugin_unregister_data_set (type).
1755  *
1756  * type:
1757  *   type of the dataset
1758  */
1759 static XS(Collectd_plugin_unregister_ds) {
1760   dXSARGS;
1761
1762   if (1 != items) {
1763     log_err("Usage: Collectd::plugin_unregister_data_set(type)");
1764     XSRETURN_EMPTY;
1765   }
1766
1767   log_debug("Collectd::plugin_unregister_data_set: type = \"%s\"",
1768             SvPV_nolen(ST(0)));
1769
1770   if (0 == pplugin_unregister_data_set(SvPV_nolen(ST(0))))
1771     XSRETURN_YES;
1772   else
1773     XSRETURN_EMPTY;
1774 } /* static XS (Collectd_plugin_register_ds) */
1775
1776 /*
1777  * Collectd::plugin_dispatch_values (name, values).
1778  *
1779  * name:
1780  *   name of the plugin
1781  *
1782  * values:
1783  *   value list to submit
1784  */
1785 static XS(Collectd_plugin_dispatch_values) {
1786   SV *values = NULL;
1787
1788   int ret = 0;
1789
1790   dXSARGS;
1791
1792   if (1 != items) {
1793     log_err("Usage: Collectd::plugin_dispatch_values(values)");
1794     XSRETURN_EMPTY;
1795   }
1796
1797   log_debug("Collectd::plugin_dispatch_values: values=\"%s\"",
1798             SvPV_nolen(ST(/* stack index = */ 0)));
1799
1800   values = ST(/* stack index = */ 0);
1801
1802   if (NULL == values)
1803     XSRETURN_EMPTY;
1804
1805   /* Make sure the argument is a hash reference. */
1806   if (!(SvROK(values) && (SVt_PVHV == SvTYPE(SvRV(values))))) {
1807     log_err("Collectd::plugin_dispatch_values: Invalid values.");
1808     XSRETURN_EMPTY;
1809   }
1810
1811   ret = pplugin_dispatch_values(aTHX_(HV *) SvRV(values));
1812
1813   if (0 == ret)
1814     XSRETURN_YES;
1815   else
1816     XSRETURN_EMPTY;
1817 } /* static XS (Collectd_plugin_dispatch_values) */
1818
1819 /*
1820  * Collectd::plugin_get_interval ().
1821  */
1822 static XS(Collectd_plugin_get_interval) {
1823   dXSARGS;
1824
1825   /* make sure we don't get any unused variable warnings for 'items';
1826    * don't abort, though */
1827   if (items)
1828     log_err("Usage: Collectd::plugin_get_interval()");
1829
1830   XSRETURN_NV((NV)CDTIME_T_TO_DOUBLE(plugin_get_interval()));
1831 } /* static XS (Collectd_plugin_get_interval) */
1832
1833 /* Collectd::plugin_write (plugin, ds, vl).
1834  *
1835  * plugin:
1836  *   name of the plugin to call, may be 'undef'
1837  *
1838  * ds:
1839  *   data-set that describes the submitted values, may be 'undef'
1840  *
1841  * vl:
1842  *   value-list to be written
1843  */
1844 static XS(Collectd__plugin_write) {
1845   char *plugin;
1846   SV *ds, *vl;
1847   AV *ds_array;
1848
1849   int ret;
1850
1851   dXSARGS;
1852
1853   if (3 != items) {
1854     log_err("Usage: Collectd::plugin_write(plugin, ds, vl)");
1855     XSRETURN_EMPTY;
1856   }
1857
1858   log_debug("Collectd::plugin_write: plugin=\"%s\", ds=\"%s\", vl=\"%s\"",
1859             SvPV_nolen(ST(0)), SvOK(ST(1)) ? SvPV_nolen(ST(1)) : "",
1860             SvPV_nolen(ST(2)));
1861
1862   if (!SvOK(ST(0)))
1863     plugin = NULL;
1864   else
1865     plugin = SvPV_nolen(ST(0));
1866
1867   ds = ST(1);
1868   if (SvROK(ds) && (SVt_PVAV == SvTYPE(SvRV(ds))))
1869     ds_array = (AV *)SvRV(ds);
1870   else if (!SvOK(ds))
1871     ds_array = NULL;
1872   else {
1873     log_err("Collectd::plugin_write: Invalid data-set.");
1874     XSRETURN_EMPTY;
1875   }
1876
1877   vl = ST(2);
1878   if (!(SvROK(vl) && (SVt_PVHV == SvTYPE(SvRV(vl))))) {
1879     log_err("Collectd::plugin_write: Invalid value-list.");
1880     XSRETURN_EMPTY;
1881   }
1882
1883   ret = pplugin_write(aTHX_ plugin, ds_array, (HV *)SvRV(vl));
1884
1885   if (0 == ret)
1886     XSRETURN_YES;
1887   else
1888     XSRETURN_EMPTY;
1889 } /* static XS (Collectd__plugin_write) */
1890
1891 /*
1892  * Collectd::_plugin_flush (plugin, timeout, identifier).
1893  *
1894  * plugin:
1895  *   name of the plugin to flush
1896  *
1897  * timeout:
1898  *   timeout to use when flushing the data
1899  *
1900  * identifier:
1901  *   data-set identifier to flush
1902  */
1903 static XS(Collectd__plugin_flush) {
1904   char *plugin = NULL;
1905   int timeout = -1;
1906   char *id = NULL;
1907
1908   dXSARGS;
1909
1910   if (3 != items) {
1911     log_err("Usage: Collectd::_plugin_flush(plugin, timeout, id)");
1912     XSRETURN_EMPTY;
1913   }
1914
1915   if (SvOK(ST(0)))
1916     plugin = SvPV_nolen(ST(0));
1917
1918   if (SvOK(ST(1)))
1919     timeout = (int)SvIV(ST(1));
1920
1921   if (SvOK(ST(2)))
1922     id = SvPV_nolen(ST(2));
1923
1924   log_debug("Collectd::_plugin_flush: plugin = \"%s\", timeout = %i, "
1925             "id = \"%s\"",
1926             plugin, timeout, id);
1927
1928   if (0 == plugin_flush(plugin, timeout, id))
1929     XSRETURN_YES;
1930   else
1931     XSRETURN_EMPTY;
1932 } /* static XS (Collectd__plugin_flush) */
1933
1934 /*
1935  * Collectd::plugin_dispatch_notification (notif).
1936  *
1937  * notif:
1938  *   notification to dispatch
1939  */
1940 static XS(Collectd_plugin_dispatch_notification) {
1941   SV *notif = NULL;
1942
1943   int ret = 0;
1944
1945   dXSARGS;
1946
1947   if (1 != items) {
1948     log_err("Usage: Collectd::plugin_dispatch_notification(notif)");
1949     XSRETURN_EMPTY;
1950   }
1951
1952   log_debug("Collectd::plugin_dispatch_notification: notif = \"%s\"",
1953             SvPV_nolen(ST(0)));
1954
1955   notif = ST(0);
1956
1957   if (!(SvROK(notif) && (SVt_PVHV == SvTYPE(SvRV(notif))))) {
1958     log_err("Collectd::plugin_dispatch_notification: Invalid notif.");
1959     XSRETURN_EMPTY;
1960   }
1961
1962   ret = pplugin_dispatch_notification(aTHX_(HV *) SvRV(notif));
1963
1964   if (0 == ret)
1965     XSRETURN_YES;
1966   else
1967     XSRETURN_EMPTY;
1968 } /* static XS (Collectd_plugin_dispatch_notification) */
1969
1970 /*
1971  * Collectd::plugin_log (level, message).
1972  *
1973  * level:
1974  *   log level (LOG_DEBUG, ... LOG_ERR)
1975  *
1976  * message:
1977  *   log message
1978  */
1979 static XS(Collectd_plugin_log) {
1980   dXSARGS;
1981
1982   if (2 != items) {
1983     log_err("Usage: Collectd::plugin_log(level, message)");
1984     XSRETURN_EMPTY;
1985   }
1986
1987   plugin_log(SvIV(ST(0)), "%s", SvPV_nolen(ST(1)));
1988   XSRETURN_YES;
1989 } /* static XS (Collectd_plugin_log) */
1990
1991 /*
1992  * Collectd::_fc_register (type, name)
1993  *
1994  * type:
1995  *   match | target
1996  *
1997  * name:
1998  *   name of the match
1999  */
2000 static XS(Collectd__fc_register) {
2001   int type;
2002   char *name;
2003
2004   int ret = 0;
2005
2006   dXSARGS;
2007
2008   if (2 != items) {
2009     log_err("Usage: Collectd::_fc_register(type, name)");
2010     XSRETURN_EMPTY;
2011   }
2012
2013   type = SvIV(ST(0));
2014   name = SvPV_nolen(ST(1));
2015
2016   if (FC_MATCH == type)
2017     ret = fc_register_match(name, pmatch);
2018   else if (FC_TARGET == type)
2019     ret = fc_register_target(name, ptarget);
2020
2021   if (0 == ret)
2022     XSRETURN_YES;
2023   else
2024     XSRETURN_EMPTY;
2025 } /* static XS (Collectd_fc_register) */
2026
2027 /*
2028  * Collectd::call_by_name (...).
2029  *
2030  * Call a Perl sub identified by its name passed through $Collectd::cb_name.
2031  */
2032 static XS(Collectd_call_by_name) {
2033   SV *tmp = NULL;
2034   char *name = NULL;
2035
2036   if (NULL == (tmp = get_sv("Collectd::cb_name", 0))) {
2037     sv_setpv(get_sv("@", 1), "cb_name has not been set");
2038     CLEAR_STACK_FRAME;
2039     return;
2040   }
2041
2042   name = SvPV_nolen(tmp);
2043
2044   if (NULL == get_cv(name, 0)) {
2045     sv_setpvf(get_sv("@", 1), "unknown callback \"%s\"", name);
2046     CLEAR_STACK_FRAME;
2047     return;
2048   }
2049
2050   /* simply pass on the subroutine call without touching the stack,
2051    * thus leaving any arguments and return values in place */
2052   call_pv(name, 0);
2053 } /* static XS (Collectd_call_by_name) */
2054
2055 /*
2056  * Interface to collectd.
2057  */
2058
2059 static int perl_init(void) {
2060   int status;
2061   dTHX;
2062
2063   if (NULL == perl_threads)
2064     return 0;
2065
2066   if (NULL == aTHX) {
2067     c_ithread_t *t = NULL;
2068
2069     pthread_mutex_lock(&perl_threads->mutex);
2070     t = c_ithread_create(perl_threads->head->interp);
2071     pthread_mutex_unlock(&perl_threads->mutex);
2072
2073     aTHX = t->interp;
2074   }
2075
2076   log_debug("perl_init: c_ithread: interp = %p (active threads: %i)", aTHX,
2077             perl_threads->number_of_threads);
2078
2079   /* Lock the base thread to avoid race conditions with c_ithread_create().
2080    * See https://github.com/collectd/collectd/issues/9 and
2081    *     https://github.com/collectd/collectd/issues/1706 for details.
2082    */
2083   assert(aTHX == perl_threads->head->interp);
2084   pthread_mutex_lock(&perl_threads->mutex);
2085
2086   status = pplugin_call(aTHX_ PLUGIN_INIT);
2087
2088   pthread_mutex_unlock(&perl_threads->mutex);
2089
2090   return status;
2091 } /* static int perl_init (void) */
2092
2093 static int perl_read(user_data_t *user_data) {
2094   dTHX;
2095
2096   if (NULL == perl_threads)
2097     return 0;
2098
2099   if (NULL == aTHX) {
2100     c_ithread_t *t = NULL;
2101
2102     pthread_mutex_lock(&perl_threads->mutex);
2103     t = c_ithread_create(perl_threads->head->interp);
2104     pthread_mutex_unlock(&perl_threads->mutex);
2105
2106     aTHX = t->interp;
2107   }
2108
2109   /* Assert that we're not running as the base thread. Otherwise, we might
2110    * run into concurrency issues with c_ithread_create(). See
2111    * https://github.com/collectd/collectd/issues/9 for details. */
2112   assert(aTHX != perl_threads->head->interp);
2113
2114   log_debug("perl_read: c_ithread: interp = %p (active threads: %i)", aTHX,
2115             perl_threads->number_of_threads);
2116
2117   return pplugin_call(aTHX_ PLUGIN_READ, user_data->data);
2118 } /* static int perl_read (user_data_t *user_data) */
2119
2120 static int perl_write(const data_set_t *ds, const value_list_t *vl,
2121                       user_data_t *user_data) {
2122   int status;
2123   dTHX;
2124
2125   if (NULL == perl_threads)
2126     return 0;
2127
2128   if (NULL == aTHX) {
2129     c_ithread_t *t = NULL;
2130
2131     pthread_mutex_lock(&perl_threads->mutex);
2132     t = c_ithread_create(perl_threads->head->interp);
2133     pthread_mutex_unlock(&perl_threads->mutex);
2134
2135     aTHX = t->interp;
2136   }
2137
2138   /* Lock the base thread if this is not called from one of the read threads
2139    * to avoid race conditions with c_ithread_create(). See
2140    * https://github.com/collectd/collectd/issues/9 for details. */
2141   if (aTHX == perl_threads->head->interp)
2142     pthread_mutex_lock(&perl_threads->mutex);
2143
2144   log_debug("perl_write: c_ithread: interp = %p (active threads: %i)", aTHX,
2145             perl_threads->number_of_threads);
2146   status = pplugin_call(aTHX_ PLUGIN_WRITE, user_data->data, ds, vl);
2147
2148   if (aTHX == perl_threads->head->interp)
2149     pthread_mutex_unlock(&perl_threads->mutex);
2150
2151   return status;
2152 } /* static int perl_write (const data_set_t *, const value_list_t *) */
2153
2154 static void perl_log(int level, const char *msg, user_data_t *user_data) {
2155   dTHX;
2156
2157   if (NULL == perl_threads)
2158     return;
2159
2160   if (NULL == aTHX) {
2161     c_ithread_t *t = NULL;
2162
2163     pthread_mutex_lock(&perl_threads->mutex);
2164     t = c_ithread_create(perl_threads->head->interp);
2165     pthread_mutex_unlock(&perl_threads->mutex);
2166
2167     aTHX = t->interp;
2168   }
2169
2170   /* Lock the base thread if this is not called from one of the read threads
2171    * to avoid race conditions with c_ithread_create(). See
2172    * https://github.com/collectd/collectd/issues/9 for details.
2173    */
2174
2175   if (aTHX == perl_threads->head->interp)
2176     pthread_mutex_lock(&perl_threads->mutex);
2177
2178   pplugin_call(aTHX_ PLUGIN_LOG, user_data->data, level, msg);
2179
2180   if (aTHX == perl_threads->head->interp)
2181     pthread_mutex_unlock(&perl_threads->mutex);
2182
2183   return;
2184 } /* static void perl_log (int, const char *) */
2185
2186 static int perl_notify(const notification_t *notif, user_data_t *user_data) {
2187   dTHX;
2188
2189   if (NULL == perl_threads)
2190     return 0;
2191
2192   if (NULL == aTHX) {
2193     c_ithread_t *t = NULL;
2194
2195     pthread_mutex_lock(&perl_threads->mutex);
2196     t = c_ithread_create(perl_threads->head->interp);
2197     pthread_mutex_unlock(&perl_threads->mutex);
2198
2199     aTHX = t->interp;
2200   }
2201   return pplugin_call(aTHX_ PLUGIN_NOTIF, user_data->data, notif);
2202 } /* static int perl_notify (const notification_t *) */
2203
2204 static int perl_flush(cdtime_t timeout, const char *identifier,
2205                       user_data_t *user_data) {
2206   dTHX;
2207
2208   if (NULL == perl_threads)
2209     return 0;
2210
2211   if (NULL == aTHX) {
2212     c_ithread_t *t = NULL;
2213
2214     pthread_mutex_lock(&perl_threads->mutex);
2215     t = c_ithread_create(perl_threads->head->interp);
2216     pthread_mutex_unlock(&perl_threads->mutex);
2217
2218     aTHX = t->interp;
2219   }
2220
2221   /* For collectd-5.6 only, #1731 */
2222   if (user_data == NULL || user_data->data == NULL)
2223     return pplugin_call(aTHX_ PLUGIN_FLUSH_ALL, timeout, identifier);
2224
2225   return pplugin_call(aTHX_ PLUGIN_FLUSH, user_data->data, timeout, identifier);
2226 } /* static int perl_flush (const int) */
2227
2228 static int perl_shutdown(void) {
2229   c_ithread_t *t;
2230   int ret;
2231
2232   dTHX;
2233
2234   plugin_unregister_complex_config("perl");
2235   plugin_unregister_read_group("perl");
2236
2237   if (NULL == perl_threads)
2238     return 0;
2239
2240   if (NULL == aTHX) {
2241     pthread_mutex_lock(&perl_threads->mutex);
2242     t = c_ithread_create(perl_threads->head->interp);
2243     pthread_mutex_unlock(&perl_threads->mutex);
2244
2245     aTHX = t->interp;
2246   }
2247
2248   log_debug("perl_shutdown: c_ithread: interp = %p (active threads: %i)", aTHX,
2249             perl_threads->number_of_threads);
2250
2251   plugin_unregister_init("perl");
2252   plugin_unregister_flush("perl"); /* For collectd-5.6 only, #1731 */
2253
2254   ret = pplugin_call(aTHX_ PLUGIN_SHUTDOWN);
2255
2256   pthread_mutex_lock(&perl_threads->mutex);
2257   t = perl_threads->tail;
2258
2259   while (NULL != t) {
2260     struct timespec ts_wait;
2261     c_ithread_t *thr = t;
2262
2263     /* the pointer has to be advanced before destroying
2264      * the thread as this will free the memory */
2265     t = t->prev;
2266
2267     thr->shutdown = true;
2268     if (thr->running) {
2269       /* Give some time to thread to exit from Perl interpreter */
2270       WARNING("perl shutdown: Thread is running inside Perl. Waiting.");
2271       ts_wait.tv_sec = 0;
2272       ts_wait.tv_nsec = 500000;
2273       nanosleep(&ts_wait, NULL);
2274     }
2275     if (thr->running) {
2276       pthread_kill(thr->pthread, SIGTERM);
2277       ERROR("perl shutdown: Thread hangs inside Perl. Thread killed.");
2278     }
2279     c_ithread_destroy(thr);
2280   }
2281
2282   pthread_mutex_unlock(&perl_threads->mutex);
2283   pthread_mutex_destroy(&perl_threads->mutex);
2284   pthread_mutexattr_destroy(&perl_threads->mutexattr);
2285
2286   sfree(perl_threads);
2287
2288   pthread_key_delete(perl_thr_key);
2289
2290   PERL_SYS_TERM();
2291
2292   plugin_unregister_shutdown("perl");
2293   return ret;
2294 } /* static void perl_shutdown (void) */
2295
2296 /*
2297  * Access functions for global variables.
2298  *
2299  * These functions implement the "magic" used to access
2300  * the global variables from Perl.
2301  */
2302
2303 static int g_pv_get(pTHX_ SV *var, MAGIC *mg) {
2304   char *pv = mg->mg_ptr;
2305   sv_setpv(var, pv);
2306   return 0;
2307 } /* static int g_pv_get (pTHX_ SV *, MAGIC *) */
2308
2309 static int g_pv_set(pTHX_ SV *var, MAGIC *mg) {
2310   char *pv = mg->mg_ptr;
2311   sstrncpy(pv, SvPV_nolen(var), DATA_MAX_NAME_LEN);
2312   return 0;
2313 } /* static int g_pv_set (pTHX_ SV *, MAGIC *) */
2314
2315 static int g_interval_get(pTHX_ SV *var, MAGIC *mg) {
2316   log_warn("Accessing $interval_g is deprecated (and might not "
2317            "give the desired results) - plugin_get_interval() should "
2318            "be used instead.");
2319   sv_setnv(var, CDTIME_T_TO_DOUBLE(interval_g));
2320   return 0;
2321 } /* static int g_interval_get (pTHX_ SV *, MAGIC *) */
2322
2323 static int g_interval_set(pTHX_ SV *var, MAGIC *mg) {
2324   double nv = (double)SvNV(var);
2325   log_warn("Accessing $interval_g is deprecated (and might not "
2326            "give the desired results) - plugin_get_interval() should "
2327            "be used instead.");
2328   interval_g = DOUBLE_TO_CDTIME_T(nv);
2329   return 0;
2330 } /* static int g_interval_set (pTHX_ SV *, MAGIC *) */
2331
2332 static MGVTBL g_pv_vtbl = {g_pv_get,
2333                            g_pv_set,
2334                            NULL,
2335                            NULL,
2336                            NULL,
2337                            NULL,
2338                            NULL
2339 #if HAVE_PERL_STRUCT_MGVTBL_SVT_LOCAL
2340                            ,
2341                            NULL
2342 #endif
2343 };
2344 static MGVTBL g_interval_vtbl = {g_interval_get,
2345                                  g_interval_set,
2346                                  NULL,
2347                                  NULL,
2348                                  NULL,
2349                                  NULL,
2350                                  NULL
2351 #if HAVE_PERL_STRUCT_MGVTBL_SVT_LOCAL
2352                                  ,
2353                                  NULL
2354 #endif
2355 };
2356
2357 /* bootstrap the Collectd module */
2358 static void xs_init(pTHX) {
2359   HV *stash = NULL;
2360   SV *tmp = NULL;
2361   char *file = __FILE__;
2362
2363   dXSUB_SYS;
2364
2365   /* enable usage of Perl modules using shared libraries */
2366   newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
2367
2368   /* register API */
2369   for (int i = 0; NULL != api[i].f; ++i)
2370     newXS(api[i].name, api[i].f, file);
2371
2372   stash = gv_stashpv("Collectd", 1);
2373
2374   /* export "constants" */
2375   for (int i = 0; '\0' != constants[i].name[0]; ++i)
2376     newCONSTSUB(stash, constants[i].name, newSViv(constants[i].value));
2377
2378   /* export global variables
2379    * by adding "magic" to the SV's representing the globale variables
2380    * perl is able to automagically call the get/set function when
2381    * accessing any such variable (this is basically the same as using
2382    * tie() in Perl) */
2383   /* global strings */
2384   struct {
2385     char name[64];
2386     char *var;
2387   } g_strings[] = {{"Collectd::hostname_g", hostname_g}, {"", NULL}};
2388
2389   for (int i = 0; '\0' != g_strings[i].name[0]; ++i) {
2390     tmp = get_sv(g_strings[i].name, 1);
2391     sv_magicext(tmp, NULL, PERL_MAGIC_ext, &g_pv_vtbl, g_strings[i].var, 0);
2392   }
2393
2394   tmp = get_sv("Collectd::interval_g", /* create = */ 1);
2395   sv_magicext(tmp, NULL, /* how = */ PERL_MAGIC_ext,
2396               /* vtbl = */ &g_interval_vtbl,
2397               /* name = */ NULL, /* namelen = */ 0);
2398
2399   return;
2400 } /* static void xs_init (pTHX) */
2401
2402 /* Initialize the global Perl interpreter. */
2403 static int init_pi(int argc, char **argv) {
2404   dTHXa(NULL);
2405
2406   if (NULL != perl_threads)
2407     return 0;
2408
2409   log_info("Initializing Perl interpreter...");
2410 #if COLLECT_DEBUG
2411   {
2412     for (int i = 0; i < argc; ++i)
2413       log_debug("argv[%i] = \"%s\"", i, argv[i]);
2414   }
2415 #endif /* COLLECT_DEBUG */
2416
2417   if (0 != pthread_key_create(&perl_thr_key, c_ithread_destructor)) {
2418     log_err("init_pi: pthread_key_create failed");
2419
2420     /* this must not happen - cowardly giving up if it does */
2421     return -1;
2422   }
2423
2424 #ifdef __FreeBSD__
2425   /* On FreeBSD, PERL_SYS_INIT3 expands to some expression which
2426    * triggers a "value computed is not used" warning by gcc. */
2427   (void)
2428 #endif
2429       PERL_SYS_INIT3(&argc, &argv, &environ);
2430
2431   perl_threads = smalloc(sizeof(*perl_threads));
2432   memset(perl_threads, 0, sizeof(c_ithread_list_t));
2433
2434   pthread_mutexattr_init(&perl_threads->mutexattr);
2435   pthread_mutexattr_settype(&perl_threads->mutexattr, PTHREAD_MUTEX_RECURSIVE);
2436   pthread_mutex_init(&perl_threads->mutex, &perl_threads->mutexattr);
2437   /* locking the mutex should not be necessary at this point
2438    * but let's just do it for the sake of completeness */
2439   pthread_mutex_lock(&perl_threads->mutex);
2440
2441   perl_threads->head = c_ithread_create(NULL);
2442   perl_threads->tail = perl_threads->head;
2443
2444   if (NULL == (perl_threads->head->interp = perl_alloc())) {
2445     log_err("init_pi: Not enough memory.");
2446     exit(3);
2447   }
2448
2449   aTHX = perl_threads->head->interp;
2450   pthread_mutex_unlock(&perl_threads->mutex);
2451
2452   perl_construct(aTHX);
2453
2454   PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
2455
2456   if (0 != perl_parse(aTHX_ xs_init, argc, argv, NULL)) {
2457     SV *err = get_sv("@", 1);
2458     log_err("init_pi: Unable to bootstrap Collectd: %s", SvPV_nolen(err));
2459
2460     perl_destruct(perl_threads->head->interp);
2461     perl_free(perl_threads->head->interp);
2462     sfree(perl_threads);
2463
2464     pthread_key_delete(perl_thr_key);
2465     return -1;
2466   }
2467
2468   /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */
2469   sv_setpv(get_sv("0", 0), "collectd");
2470
2471   perl_run(aTHX);
2472
2473   plugin_register_init("perl", perl_init);
2474   plugin_register_shutdown("perl", perl_shutdown);
2475   return 0;
2476 } /* static int init_pi (const char **, const int) */
2477
2478 /*
2479  * LoadPlugin "<Plugin>"
2480  */
2481 static int perl_config_loadplugin(pTHX_ oconfig_item_t *ci) {
2482   char module_name[DATA_MAX_NAME_LEN];
2483
2484   char *value = NULL;
2485
2486   if ((0 != ci->children_num) || (1 != ci->values_num) ||
2487       (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2488     log_err("LoadPlugin expects a single string argument.");
2489     return 1;
2490   }
2491
2492   value = ci->values[0].value.string;
2493
2494   if (NULL == get_module_name(module_name, sizeof(module_name), value)) {
2495     log_err("Invalid module name %s", value);
2496     return 1;
2497   }
2498
2499   if (0 != init_pi(perl_argc, perl_argv))
2500     return -1;
2501
2502   assert(NULL != perl_threads);
2503   assert(NULL != perl_threads->head);
2504
2505   aTHX = perl_threads->head->interp;
2506
2507   log_debug("perl_config: Loading Perl plugin \"%s\"", value);
2508   load_module(PERL_LOADMOD_NOIMPORT, newSVpv(module_name, strlen(module_name)),
2509               Nullsv);
2510   return 0;
2511 } /* static int perl_config_loadplugin (oconfig_item_it *) */
2512
2513 /*
2514  * BaseName "<Name>"
2515  */
2516 static int perl_config_basename(pTHX_ oconfig_item_t *ci) {
2517   char *value = NULL;
2518
2519   if ((0 != ci->children_num) || (1 != ci->values_num) ||
2520       (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2521     log_err("BaseName expects a single string argument.");
2522     return 1;
2523   }
2524
2525   value = ci->values[0].value.string;
2526
2527   log_debug("perl_config: Setting plugin basename to \"%s\"", value);
2528   sstrncpy(base_name, value, sizeof(base_name));
2529   return 0;
2530 } /* static int perl_config_basename (oconfig_item_it *) */
2531
2532 /*
2533  * EnableDebugger "<Package>"|""
2534  */
2535 static int perl_config_enabledebugger(pTHX_ oconfig_item_t *ci) {
2536   char *value = NULL;
2537
2538   if ((0 != ci->children_num) || (1 != ci->values_num) ||
2539       (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2540     log_err("EnableDebugger expects a single string argument.");
2541     return 1;
2542   }
2543
2544   if (NULL != perl_threads) {
2545     log_warn("EnableDebugger has no effects if used after LoadPlugin.");
2546     return 1;
2547   }
2548
2549   value = ci->values[0].value.string;
2550
2551   perl_argv = realloc(perl_argv, (++perl_argc + 1) * sizeof(char *));
2552
2553   if (NULL == perl_argv) {
2554     log_err("perl_config: Not enough memory.");
2555     exit(3);
2556   }
2557
2558   if ('\0' == value[0]) {
2559     perl_argv[perl_argc - 1] = "-d";
2560   } else {
2561     perl_argv[perl_argc - 1] = smalloc(strlen(value) + 4);
2562     sstrncpy(perl_argv[perl_argc - 1], "-d:", 4);
2563     sstrncpy(perl_argv[perl_argc - 1] + 3, value, strlen(value) + 1);
2564   }
2565
2566   perl_argv[perl_argc] = NULL;
2567   return 0;
2568 } /* static int perl_config_enabledebugger (oconfig_item_it *) */
2569
2570 /*
2571  * IncludeDir "<Dir>"
2572  */
2573 static int perl_config_includedir(pTHX_ oconfig_item_t *ci) {
2574   char *value = NULL;
2575
2576   if ((0 != ci->children_num) || (1 != ci->values_num) ||
2577       (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2578     log_err("IncludeDir expects a single string argument.");
2579     return 1;
2580   }
2581
2582   value = ci->values[0].value.string;
2583
2584   if (NULL == aTHX) {
2585     perl_argv = realloc(perl_argv, (++perl_argc + 1) * sizeof(char *));
2586
2587     if (NULL == perl_argv) {
2588       log_err("perl_config: Not enough memory.");
2589       exit(3);
2590     }
2591
2592     perl_argv[perl_argc - 1] = smalloc(strlen(value) + 3);
2593     sstrncpy(perl_argv[perl_argc - 1], "-I", 3);
2594     sstrncpy(perl_argv[perl_argc - 1] + 2, value, strlen(value) + 1);
2595
2596     perl_argv[perl_argc] = NULL;
2597   } else {
2598     /* prepend the directory to @INC */
2599     av_unshift(GvAVn(PL_incgv), 1);
2600     av_store(GvAVn(PL_incgv), 0, newSVpv(value, strlen(value)));
2601   }
2602   return 0;
2603 } /* static int perl_config_includedir (oconfig_item_it *) */
2604
2605 /*
2606  * <Plugin> block
2607  */
2608 static int perl_config_plugin(pTHX_ oconfig_item_t *ci) {
2609   int retvals = 0;
2610   int ret = 0;
2611
2612   char *plugin;
2613   HV *config;
2614
2615   if (NULL == perl_threads) {
2616     log_err("A `Plugin' block was encountered but no plugin was loaded yet. "
2617             "Put the appropriate `LoadPlugin' option in front of it.");
2618     return -1;
2619   }
2620
2621   dSP;
2622
2623   if ((1 != ci->values_num) || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2624     log_err("LoadPlugin expects a single string argument.");
2625     return 1;
2626   }
2627
2628   plugin = ci->values[0].value.string;
2629   config = newHV();
2630
2631   if (0 != oconfig_item2hv(aTHX_ ci, config)) {
2632     hv_clear(config);
2633     hv_undef(config);
2634
2635     log_err("Unable to convert configuration to a Perl hash value.");
2636     config = (HV *)&PL_sv_undef;
2637   }
2638
2639   ENTER;
2640   SAVETMPS;
2641
2642   PUSHMARK(SP);
2643
2644   XPUSHs(sv_2mortal(newSVpv(plugin, 0)));
2645   XPUSHs(sv_2mortal(newRV_noinc((SV *)config)));
2646
2647   PUTBACK;
2648
2649   retvals = call_pv("Collectd::_plugin_dispatch_config", G_SCALAR);
2650
2651   SPAGAIN;
2652   if (0 < retvals) {
2653     SV *tmp = POPs;
2654     if (!SvTRUE(tmp))
2655       ret = 1;
2656   } else
2657     ret = 1;
2658
2659   PUTBACK;
2660   FREETMPS;
2661   LEAVE;
2662   return ret;
2663 } /* static int perl_config_plugin (oconfig_item_it *) */
2664
2665 static int perl_config(oconfig_item_t *ci) {
2666   int status = 0;
2667
2668   dTHXa(NULL);
2669
2670   for (int i = 0; i < ci->children_num; ++i) {
2671     oconfig_item_t *c = ci->children + i;
2672     int current_status = 0;
2673
2674     if (NULL != perl_threads) {
2675       if ((aTHX = PERL_GET_CONTEXT) == NULL)
2676         return -1;
2677     }
2678
2679     if (0 == strcasecmp(c->key, "LoadPlugin"))
2680       current_status = perl_config_loadplugin(aTHX_ c);
2681     else if (0 == strcasecmp(c->key, "BaseName"))
2682       current_status = perl_config_basename(aTHX_ c);
2683     else if (0 == strcasecmp(c->key, "EnableDebugger"))
2684       current_status = perl_config_enabledebugger(aTHX_ c);
2685     else if (0 == strcasecmp(c->key, "IncludeDir"))
2686       current_status = perl_config_includedir(aTHX_ c);
2687     else if (0 == strcasecmp(c->key, "Plugin"))
2688       current_status = perl_config_plugin(aTHX_ c);
2689     else if (0 == strcasecmp(c->key, "RegisterLegacyFlush"))
2690       cf_util_get_boolean(c, &register_legacy_flush);
2691     else {
2692       log_warn("Ignoring unknown config key \"%s\".", c->key);
2693       current_status = 0;
2694     }
2695
2696     /* fatal error - it's up to perl_config_* to clean up */
2697     if (0 > current_status) {
2698       log_err("Configuration failed with a fatal error - "
2699               "plugin disabled!");
2700       return current_status;
2701     }
2702
2703     status += current_status;
2704   }
2705   return status;
2706 } /* static int perl_config (oconfig_item_t *) */
2707
2708 void module_register(void) {
2709   perl_argc = 4;
2710   perl_argv = smalloc((perl_argc + 1) * sizeof(*perl_argv));
2711
2712   /* default options for the Perl interpreter */
2713   perl_argv[0] = "";
2714   perl_argv[1] = "-MCollectd";
2715   perl_argv[2] = "-e";
2716   perl_argv[3] = "1";
2717   perl_argv[4] = NULL;
2718
2719   plugin_register_complex_config("perl", perl_config);
2720   return;
2721 } /* void module_register (void) */