src/perl.c

   1 /**
   2  * collectd - src/perl.c
   3  * Copyright (C) 2007, 2008  Sebastian Harl
   4  *
   5  * This program is free software; you can redistribute it and/or modify it
   6  * under the terms of the GNU General Public License as published by the
   7  * Free Software Foundation; only version 2 of the License is applicable.
   8  *
   9  * This program is distributed in the hope that it will be useful, but
  10  * WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12  * General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  17  *
  18  * Author:
  19  *   Sebastian Harl <sh at tokkee.org>
  20  **/
  21
  22 /*
  23  * This plugin embeds a Perl interpreter into collectd and provides an
  24  * interface for collectd plugins written in perl.
  25  */
  26
  27 /* do not automatically get the thread specific perl interpreter */
  28 #define PERL_NO_GET_CONTEXT
  29
  30 #define DONT_POISON_SPRINTF_YET 1
  31 #include "collectd.h"
  32 #undef DONT_POISON_SPRINTF_YET
  33
  34 #include "configfile.h"
  35
  36 #include <EXTERN.h>
  37 #include <perl.h>
  38
  39 #if defined(COLLECT_DEBUG) && COLLECT_DEBUG && defined(__GNUC__) && __GNUC__
  40 # pragma GCC poison sprintf
  41 #endif
  42
  43 #include <XSUB.h>
  44
  45 /* Some versions of Perl define their own version of DEBUG... :-/ */
  46 #ifdef DEBUG
  47 # undef DEBUG
  48 #endif /* DEBUG */
  49
  50 /* ... while we want the definition found in plugin.h. */
  51 #include "plugin.h"
  52 #include "common.h"
  53
  54 #include <pthread.h>
  55
  56 #if !defined(USE_ITHREADS)
  57 # error "Perl does not support ithreads!"
  58 #endif /* !defined(USE_ITHREADS) */
  59
  60 /* clear the Perl sub's stack frame
  61  * (this should only be used inside an XSUB) */
  62 #define CLEAR_STACK_FRAME PL_stack_sp = PL_stack_base + *PL_markstack_ptr
  63
  64 #define PLUGIN_INIT     0
  65 #define PLUGIN_READ     1
  66 #define PLUGIN_WRITE    2
  67 #define PLUGIN_SHUTDOWN 3
  68 #define PLUGIN_LOG      4
  69 #define PLUGIN_NOTIF    5
  70 #define PLUGIN_FLUSH    6
  71
  72 #define PLUGIN_TYPES    7
  73
  74 #define PLUGIN_CONFIG   254
  75 #define PLUGIN_DATASET  255
  76
  77 #define log_debug(...) DEBUG ("perl: " __VA_ARGS__)
  78 #define log_info(...) INFO ("perl: " __VA_ARGS__)
  79 #define log_warn(...) WARNING ("perl: " __VA_ARGS__)
  80 #define log_err(...) ERROR ("perl: " __VA_ARGS__)
  81
  82 /* this is defined in DynaLoader.a */
  83 void boot_DynaLoader (PerlInterpreter *, CV *);
  84
  85 static XS (Collectd_plugin_register_ds);
  86 static XS (Collectd_plugin_unregister_ds);
  87 static XS (Collectd_plugin_dispatch_values);
  88 static XS (Collectd__plugin_write);
  89 static XS (Collectd__plugin_flush);
  90 static XS (Collectd_plugin_dispatch_notification);
  91 static XS (Collectd_plugin_log);
  92 static XS (Collectd_call_by_name);
  93
  94 /*
  95  * private data types
  96  */
  97
  98 typedef struct c_ithread_s {
  99         /* the thread's Perl interpreter */
 100         PerlInterpreter *interp;
 101
 102         /* double linked list of threads */
 103         struct c_ithread_s *prev;
 104         struct c_ithread_s *next;
 105 } c_ithread_t;
 106
 107 typedef struct {
 108         c_ithread_t *head;
 109         c_ithread_t *tail;
 110
 111 #if COLLECT_DEBUG
 112         /* some usage stats */
 113         int number_of_threads;
 114 #endif /* COLLECT_DEBUG */
 115
 116         pthread_mutex_t mutex;
 117 } c_ithread_list_t;
 118
 119 /*
 120  * private variables
 121  */
 122
 123 /* if perl_threads != NULL perl_threads->head must
 124  * point to the "base" thread */
 125 static c_ithread_list_t *perl_threads = NULL;
 126
 127 /* the key used to store each pthread's ithread */
 128 static pthread_key_t perl_thr_key;
 129
 130 static int    perl_argc = 0;
 131 static char **perl_argv = NULL;
 132
 133 static char base_name[DATA_MAX_NAME_LEN] = "";
 134
 135 static struct {
 136         char name[64];
 137         XS ((*f));
 138 } api[] =
 139 {
 140         { "Collectd::plugin_register_data_set",   Collectd_plugin_register_ds },
 141         { "Collectd::plugin_unregister_data_set", Collectd_plugin_unregister_ds },
 142         { "Collectd::plugin_dispatch_values",     Collectd_plugin_dispatch_values },
 143         { "Collectd::_plugin_write",              Collectd__plugin_write },
 144         { "Collectd::_plugin_flush",              Collectd__plugin_flush },
 145         { "Collectd::plugin_dispatch_notification",
 146                 Collectd_plugin_dispatch_notification },
 147         { "Collectd::plugin_log",                 Collectd_plugin_log },
 148         { "Collectd::call_by_name",               Collectd_call_by_name },
 149         { "", NULL }
 150 };
 151
 152 struct {
 153         char name[64];
 154         int  value;
 155 } constants[] =
 156 {
 157         { "Collectd::TYPE_INIT",       PLUGIN_INIT },
 158         { "Collectd::TYPE_READ",       PLUGIN_READ },
 159         { "Collectd::TYPE_WRITE",      PLUGIN_WRITE },
 160         { "Collectd::TYPE_SHUTDOWN",   PLUGIN_SHUTDOWN },
 161         { "Collectd::TYPE_LOG",        PLUGIN_LOG },
 162         { "Collectd::TYPE_NOTIF",      PLUGIN_NOTIF },
 163         { "Collectd::TYPE_FLUSH",      PLUGIN_FLUSH },
 164         { "Collectd::TYPE_CONFIG",     PLUGIN_CONFIG },
 165         { "Collectd::TYPE_DATASET",    PLUGIN_DATASET },
 166         { "Collectd::DS_TYPE_COUNTER", DS_TYPE_COUNTER },
 167         { "Collectd::DS_TYPE_GAUGE",   DS_TYPE_GAUGE },
 168         { "Collectd::LOG_ERR",         LOG_ERR },
 169         { "Collectd::LOG_WARNING",     LOG_WARNING },
 170         { "Collectd::LOG_NOTICE",      LOG_NOTICE },
 171         { "Collectd::LOG_INFO",        LOG_INFO },
 172         { "Collectd::LOG_DEBUG",       LOG_DEBUG },
 173         { "Collectd::NOTIF_FAILURE",   NOTIF_FAILURE },
 174         { "Collectd::NOTIF_WARNING",   NOTIF_WARNING },
 175         { "Collectd::NOTIF_OKAY",      NOTIF_OKAY },
 176         { "", 0 }
 177 };
 178
 179 struct {
 180         char  name[64];
 181         char *var;
 182 } g_strings[] =
 183 {
 184         { "Collectd::hostname_g", hostname_g },
 185         { "", NULL }
 186 };
 187
 188 struct {
 189         char  name[64];
 190         int  *var;
 191 } g_integers[] =
 192 {
 193         { "Collectd::interval_g", &interval_g },
 194         { "", NULL }
 195 };
 196
 197 /*
 198  * Helper functions for data type conversion.
 199  */
 200
 201 /*
 202  * data source:
 203  * [
 204  *   {
 205  *     name => $ds_name,
 206  *     type => $ds_type,
 207  *     min  => $ds_min,
 208  *     max  => $ds_max
 209  *   },
 210  *   ...
 211  * ]
 212  */
 213 static int hv2data_source (pTHX_ HV *hash, data_source_t *ds)
 214 {
 215         SV **tmp = NULL;
 216
 217         if ((NULL == hash) || (NULL == ds))
 218                 return -1;
 219
 220         if (NULL != (tmp = hv_fetch (hash, "name", 4, 0))) {
 221                 sstrncpy (ds->name, SvPV_nolen (*tmp), sizeof (ds->name));
 222         }
 223         else {
 224                 log_err ("hv2data_source: No DS name given.");
 225                 return -1;
 226         }
 227
 228         if (NULL != (tmp = hv_fetch (hash, "type", 4, 0))) {
 229                 ds->type = SvIV (*tmp);
 230
 231                 if ((DS_TYPE_COUNTER != ds->type) && (DS_TYPE_GAUGE != ds->type)) {
 232                         log_err ("hv2data_source: Invalid DS type.");
 233                         return -1;
 234                 }
 235         }
 236         else {
 237                 ds->type = DS_TYPE_COUNTER;
 238         }
 239
 240         if (NULL != (tmp = hv_fetch (hash, "min", 3, 0)))
 241                 ds->min = SvNV (*tmp);
 242         else
 243                 ds->min = NAN;
 244
 245         if (NULL != (tmp = hv_fetch (hash, "max", 3, 0)))
 246                 ds->max = SvNV (*tmp);
 247         else
 248                 ds->max = NAN;
 249         return 0;
 250 } /* static int hv2data_source (HV *, data_source_t *) */
 251
 252 static int av2value (pTHX_ char *name, AV *array, value_t *value, int len)
 253 {
 254         const data_set_t *ds;
 255
 256         int i = 0;
 257
 258         if ((NULL == name) || (NULL == array) || (NULL == value))
 259                 return -1;
 260
 261         if (av_len (array) < len - 1)
 262                 len = av_len (array) + 1;
 263
 264         if (0 >= len)
 265                 return -1;
 266
 267         ds = plugin_get_ds (name);
 268         if (NULL == ds) {
 269                 log_err ("av2value: Unknown dataset \"%s\"", name);
 270                 return -1;
 271         }
 272
 273         if (ds->ds_num < len) {
 274                 log_warn ("av2value: Value length exceeds data set length.");
 275                 len = ds->ds_num;
 276         }
 277
 278         for (i = 0; i < len; ++i) {
 279                 SV **tmp = av_fetch (array, i, 0);
 280
 281                 if (NULL != tmp) {
 282                         if (DS_TYPE_COUNTER == ds->ds[i].type)
 283                                 value[i].counter = SvIV (*tmp);
 284                         else
 285                                 value[i].gauge = SvNV (*tmp);
 286                 }
 287                 else {
 288                         return -1;
 289                 }
 290         }
 291         return len;
 292 } /* static int av2value (char *, AV *, value_t *, int) */
 293
 294 /*
 295  * value list:
 296  * {
 297  *   values => [ @values ],
 298  *   time   => $time,
 299  *   host   => $host,
 300  *   plugin => $plugin,
 301  *   plugin_instance => $pinstance,
 302  *   type_instance   => $tinstance,
 303  * }
 304  */
 305 static int hv2value_list (pTHX_ HV *hash, value_list_t *vl)
 306 {
 307         SV **tmp;
 308
 309         if ((NULL == hash) || (NULL == vl))
 310                 return -1;
 311
 312         if (NULL == (tmp = hv_fetch (hash, "type", 4, 0))) {
 313                 log_err ("hv2value_list: No type given.");
 314                 return -1;
 315         }
 316
 317         sstrncpy (vl->type, SvPV_nolen (*tmp), sizeof (vl->type));
 318
 319         if ((NULL == (tmp = hv_fetch (hash, "values", 6, 0)))
 320                         || (! (SvROK (*tmp) && (SVt_PVAV == SvTYPE (SvRV (*tmp)))))) {
 321                 log_err ("hv2value_list: No valid values given.");
 322                 return -1;
 323         }
 324
 325         {
 326                 AV  *array = (AV *)SvRV (*tmp);
 327                 int len    = av_len (array) + 1;
 328
 329                 if (len <= 0)
 330                         return -1;
 331
 332                 vl->values     = (value_t *)smalloc (len * sizeof (value_t));
 333                 vl->values_len = av2value (aTHX_ vl->type, (AV *)SvRV (*tmp),
 334                                 vl->values, len);
 335
 336                 if (-1 == vl->values_len) {
 337                         sfree (vl->values);
 338                         return -1;
 339                 }
 340         }
 341
 342         if (NULL != (tmp = hv_fetch (hash, "time", 4, 0)))
 343                 vl->time = (time_t)SvIV (*tmp);
 344
 345         if (NULL != (tmp = hv_fetch (hash, "interval", 8, 0)))
 346                 vl->interval = SvIV (*tmp);
 347
 348         if (NULL != (tmp = hv_fetch (hash, "host", 4, 0)))
 349                 sstrncpy (vl->host, SvPV_nolen (*tmp), sizeof (vl->host));
 350         else
 351                 sstrncpy (vl->host, hostname_g, sizeof (vl->host));
 352
 353         if (NULL != (tmp = hv_fetch (hash, "plugin", 6, 0)))
 354                 sstrncpy (vl->plugin, SvPV_nolen (*tmp), sizeof (vl->plugin));
 355
 356         if (NULL != (tmp = hv_fetch (hash, "plugin_instance", 15, 0)))
 357                 sstrncpy (vl->plugin_instance, SvPV_nolen (*tmp),
 358                                 sizeof (vl->plugin_instance));
 359
 360         if (NULL != (tmp = hv_fetch (hash, "type_instance", 13, 0)))
 361                 sstrncpy (vl->type_instance, SvPV_nolen (*tmp),
 362                                 sizeof (vl->type_instance));
 363         return 0;
 364 } /* static int hv2value_list (pTHX_ HV *, value_list_t *) */
 365
 366 static int av2data_set (pTHX_ AV *array, char *name, data_set_t *ds)
 367 {
 368         int len, i;
 369
 370         if ((NULL == array) || (NULL == name) || (NULL == ds))
 371                 return -1;
 372
 373         len = av_len (array);
 374
 375         if (-1 == len) {
 376                 log_err ("av2data_set: Invalid data set.");
 377                 return -1;
 378         }
 379
 380         ds->ds = (data_source_t *)smalloc ((len + 1) * sizeof (data_source_t));
 381         ds->ds_num = len + 1;
 382
 383         for (i = 0; i <= len; ++i) {
 384                 SV **elem = av_fetch (array, i, 0);
 385
 386                 if (NULL == elem) {
 387                         log_err ("av2data_set: Failed to fetch data source %i.", i);
 388                         return -1;
 389                 }
 390
 391                 if (! (SvROK (*elem) && (SVt_PVHV == SvTYPE (SvRV (*elem))))) {
 392                         log_err ("av2data_set: Invalid data source.");
 393                         return -1;
 394                 }
 395
 396                 if (-1 == hv2data_source (aTHX_ (HV *)SvRV (*elem), &ds->ds[i]))
 397                         return -1;
 398
 399                 log_debug ("av2data_set: "
 400                                 "DS.name = \"%s\", DS.type = %i, DS.min = %f, DS.max = %f",
 401                                 ds->ds[i].name, ds->ds[i].type, ds->ds[i].min, ds->ds[i].max);
 402         }
 403
 404         sstrncpy (ds->type, name, sizeof (ds->type));
 405         return 0;
 406 } /* static int av2data_set (pTHX_ AV *, data_set_t *) */
 407
 408 /*
 409  * notification:
 410  * {
 411  *   severity => $severity,
 412  *   time     => $time,
 413  *   message  => $msg,
 414  *   host     => $host,
 415  *   plugin   => $plugin,
 416  *   type     => $type,
 417  *   plugin_instance => $instance,
 418  *   type_instance   => $type_instance,
 419  *   meta     => [ { name => <name>, value => <value> }, ... ]
 420  * }
 421  */
 422 static int av2notification_meta (pTHX_ AV *array, notification_meta_t **meta)
 423 {
 424         notification_meta_t **m = meta;
 425
 426         int len = av_len (array);
 427         int i;
 428
 429         for (i = 0; i <= len; ++i) {
 430                 SV **tmp = av_fetch (array, i, 0);
 431                 HV  *hash;
 432
 433                 if (NULL == tmp)
 434                         return -1;
 435
 436                 if (! (SvROK (*tmp) && (SVt_PVHV == SvTYPE (SvRV (*tmp))))) {
 437                         log_warn ("av2notification_meta: Skipping invalid "
 438                                         "meta information.");
 439                         continue;
 440                 }
 441
 442                 hash = (HV *)SvRV (*tmp);
 443
 444                 *m = (notification_meta_t *)smalloc (sizeof (**m));
 445
 446                 if (NULL == (tmp = hv_fetch (hash, "name", 4, 0))) {
 447                         log_warn ("av2notification_meta: Skipping invalid "
 448                                         "meta information.");
 449                         free (*m);
 450                         continue;
 451                 }
 452                 sstrncpy ((*m)->name, SvPV_nolen (*tmp), sizeof ((*m)->name));
 453
 454                 if (NULL == (tmp = hv_fetch (hash, "value", 5, 0))) {
 455                         log_warn ("av2notification_meta: Skipping invalid "
 456                                         "meta information.");
 457                         free ((*m)->name);
 458                         free (*m);
 459                         continue;
 460                 }
 461
 462                 if (SvNOK (*tmp)) {
 463                         (*m)->nm_value.nm_double = SvNVX (*tmp);
 464                         (*m)->type = NM_TYPE_DOUBLE;
 465                 }
 466                 else if (SvUOK (*tmp)) {
 467                         (*m)->nm_value.nm_unsigned_int = SvUVX (*tmp);
 468                         (*m)->type = NM_TYPE_UNSIGNED_INT;
 469                 }
 470                 else if (SvIOK (*tmp)) {
 471                         (*m)->nm_value.nm_signed_int = SvIVX (*tmp);
 472                         (*m)->type = NM_TYPE_SIGNED_INT;
 473                 }
 474                 else {
 475                         (*m)->nm_value.nm_string = sstrdup (SvPV_nolen (*tmp));
 476                         (*m)->type = NM_TYPE_STRING;
 477                 }
 478
 479                 (*m)->next = NULL;
 480                 m = &((*m)->next);
 481         }
 482         return 0;
 483 } /* static int av2notification_meta (AV *, notification_meta_t *) */
 484
 485 static int hv2notification (pTHX_ HV *hash, notification_t *n)
 486 {
 487         SV **tmp = NULL;
 488
 489         if ((NULL == hash) || (NULL == n))
 490                 return -1;
 491
 492         if (NULL != (tmp = hv_fetch (hash, "severity", 8, 0)))
 493                 n->severity = SvIV (*tmp);
 494         else
 495                 n->severity = NOTIF_FAILURE;
 496
 497         if (NULL != (tmp = hv_fetch (hash, "time", 4, 0)))
 498                 n->time = (time_t)SvIV (*tmp);
 499         else
 500                 n->time = time (NULL);
 501
 502         if (NULL != (tmp = hv_fetch (hash, "message", 7, 0)))
 503                 sstrncpy (n->message, SvPV_nolen (*tmp), sizeof (n->message));
 504
 505         if (NULL != (tmp = hv_fetch (hash, "host", 4, 0)))
 506                 sstrncpy (n->host, SvPV_nolen (*tmp), sizeof (n->host));
 507         else
 508                 sstrncpy (n->host, hostname_g, sizeof (n->host));
 509
 510         if (NULL != (tmp = hv_fetch (hash, "plugin", 6, 0)))
 511                 sstrncpy (n->plugin, SvPV_nolen (*tmp), sizeof (n->plugin));
 512
 513         if (NULL != (tmp = hv_fetch (hash, "plugin_instance", 15, 0)))
 514                 sstrncpy (n->plugin_instance, SvPV_nolen (*tmp),
 515                                 sizeof (n->plugin_instance));
 516
 517         if (NULL != (tmp = hv_fetch (hash, "type", 4, 0)))
 518                 sstrncpy (n->type, SvPV_nolen (*tmp), sizeof (n->type));
 519
 520         if (NULL != (tmp = hv_fetch (hash, "type_instance", 13, 0)))
 521                 sstrncpy (n->type_instance, SvPV_nolen (*tmp),
 522                                 sizeof (n->type_instance));
 523
 524         n->meta = NULL;
 525         while (NULL != (tmp = hv_fetch (hash, "meta", 4, 0))) {
 526                 if (! (SvROK (*tmp) && (SVt_PVAV == SvTYPE (SvRV (*tmp))))) {
 527                         log_warn ("hv2notification: Ignoring invalid meta information.");
 528                         break;
 529                 }
 530
 531                 if (0 != av2notification_meta (aTHX_ (AV *)SvRV (*tmp), &n->meta)) {
 532                         plugin_notification_meta_free (n->meta);
 533                         n->meta = NULL;
 534                         return -1;
 535                 }
 536                 break;
 537         }
 538         return 0;
 539 } /* static int hv2notification (pTHX_ HV *, notification_t *) */
 540
 541 static int data_set2av (pTHX_ data_set_t *ds, AV *array)
 542 {
 543         int i = 0;
 544
 545         if ((NULL == ds) || (NULL == array))
 546                 return -1;
 547
 548         av_extend (array, ds->ds_num);
 549
 550         for (i = 0; i < ds->ds_num; ++i) {
 551                 HV *source = newHV ();
 552
 553                 if (NULL == hv_store (source, "name", 4,
 554                                 newSVpv (ds->ds[i].name, 0), 0))
 555                         return -1;
 556
 557                 if (NULL == hv_store (source, "type", 4, newSViv (ds->ds[i].type), 0))
 558                         return -1;
 559
 560                 if (! isnan (ds->ds[i].min))
 561                         if (NULL == hv_store (source, "min", 3,
 562                                         newSVnv (ds->ds[i].min), 0))
 563                                 return -1;
 564
 565                 if (! isnan (ds->ds[i].max))
 566                         if (NULL == hv_store (source, "max", 3,
 567                                         newSVnv (ds->ds[i].max), 0))
 568                                 return -1;
 569
 570                 if (NULL == av_store (array, i, newRV_noinc ((SV *)source)))
 571                         return -1;
 572         }
 573         return 0;
 574 } /* static int data_set2av (data_set_t *, AV *) */
 575
 576 static int value_list2hv (pTHX_ value_list_t *vl, data_set_t *ds, HV *hash)
 577 {
 578         AV *values = NULL;
 579
 580         int i   = 0;
 581         int len = 0;
 582
 583         if ((NULL == vl) || (NULL == ds) || (NULL == hash))
 584                 return -1;
 585
 586         len = vl->values_len;
 587
 588         if (ds->ds_num < len) {
 589                 log_warn ("value2av: Value length exceeds data set length.");
 590                 len = ds->ds_num;
 591         }
 592
 593         values = newAV ();
 594         av_extend (values, len - 1);
 595
 596         for (i = 0; i < len; ++i) {
 597                 SV *val = NULL;
 598
 599                 if (DS_TYPE_COUNTER == ds->ds[i].type)
 600                         val = newSViv (vl->values[i].counter);
 601                 else
 602                         val = newSVnv (vl->values[i].gauge);
 603
 604                 if (NULL == av_store (values, i, val)) {
 605                         av_undef (values);
 606                         return -1;
 607                 }
 608         }
 609
 610         if (NULL == hv_store (hash, "values", 6, newRV_noinc ((SV *)values), 0))
 611                 return -1;
 612
 613         if (0 != vl->time)
 614                 if (NULL == hv_store (hash, "time", 4, newSViv (vl->time), 0))
 615                         return -1;
 616
 617         if (NULL == hv_store (hash, "interval", 8, newSViv (vl->interval), 0))
 618                 return -1;
 619
 620         if ('\0' != vl->host[0])
 621                 if (NULL == hv_store (hash, "host", 4, newSVpv (vl->host, 0), 0))
 622                         return -1;
 623
 624         if ('\0' != vl->plugin[0])
 625                 if (NULL == hv_store (hash, "plugin", 6, newSVpv (vl->plugin, 0), 0))
 626                         return -1;
 627
 628         if ('\0' != vl->plugin_instance[0])
 629                 if (NULL == hv_store (hash, "plugin_instance", 15,
 630                                 newSVpv (vl->plugin_instance, 0), 0))
 631                         return -1;
 632
 633         if ('\0' != vl->type[0])
 634                 if (NULL == hv_store (hash, "type", 4, newSVpv (vl->type, 0), 0))
 635                         return -1;
 636
 637         if ('\0' != vl->type_instance[0])
 638                 if (NULL == hv_store (hash, "type_instance", 13,
 639                                 newSVpv (vl->type_instance, 0), 0))
 640                         return -1;
 641         return 0;
 642 } /* static int value2av (value_list_t *, data_set_t *, HV *) */
 643
 644 static int notification_meta2av (pTHX_ notification_meta_t *meta, AV *array)
 645 {
 646         int meta_num = 0;
 647         int i;
 648
 649         while (meta) {
 650                 ++meta_num;
 651                 meta = meta->next;
 652         }
 653
 654         av_extend (array, meta_num);
 655
 656         for (i = 0; NULL != meta; meta = meta->next, ++i) {
 657                 HV *m = newHV ();
 658                 SV *value;
 659
 660                 if (NULL == hv_store (m, "name", 4, newSVpv (meta->name, 0), 0))
 661                         return -1;
 662
 663                 if (NM_TYPE_STRING == meta->type)
 664                         value = newSVpv (meta->nm_value.nm_string, 0);
 665                 else if (NM_TYPE_SIGNED_INT == meta->type)
 666                         value = newSViv (meta->nm_value.nm_signed_int);
 667                 else if (NM_TYPE_UNSIGNED_INT == meta->type)
 668                         value = newSVuv (meta->nm_value.nm_unsigned_int);
 669                 else if (NM_TYPE_DOUBLE == meta->type)
 670                         value = newSVnv (meta->nm_value.nm_double);
 671                 else if (NM_TYPE_BOOLEAN == meta->type)
 672                         value = meta->nm_value.nm_boolean ? &PL_sv_yes : &PL_sv_no;
 673                 else
 674                         return -1;
 675
 676                 if (NULL == hv_store (m, "value", 5, value, 0)) {
 677                         sv_free (value);
 678                         return -1;
 679                 }
 680
 681                 if (NULL == av_store (array, i, newRV_noinc ((SV *)m))) {
 682                         hv_clear (m);
 683                         hv_undef (m);
 684                         return -1;
 685                 }
 686         }
 687         return 0;
 688 } /* static int notification_meta2av (notification_meta_t *, AV *) */
 689
 690 static int notification2hv (pTHX_ notification_t *n, HV *hash)
 691 {
 692         if (NULL == hv_store (hash, "severity", 8, newSViv (n->severity), 0))
 693                 return -1;
 694
 695         if (0 != n->time)
 696                 if (NULL == hv_store (hash, "time", 4, newSViv (n->time), 0))
 697                         return -1;
 698
 699         if ('\0' != *n->message)
 700                 if (NULL == hv_store (hash, "message", 7, newSVpv (n->message, 0), 0))
 701                         return -1;
 702
 703         if ('\0' != *n->host)
 704                 if (NULL == hv_store (hash, "host", 4, newSVpv (n->host, 0), 0))
 705                         return -1;
 706
 707         if ('\0' != *n->plugin)
 708                 if (NULL == hv_store (hash, "plugin", 6, newSVpv (n->plugin, 0), 0))
 709                         return -1;
 710
 711         if ('\0' != *n->plugin_instance)
 712                 if (NULL == hv_store (hash, "plugin_instance", 15,
 713                                 newSVpv (n->plugin_instance, 0), 0))
 714                         return -1;
 715
 716         if ('\0' != *n->type)
 717                 if (NULL == hv_store (hash, "type", 4, newSVpv (n->type, 0), 0))
 718                         return -1;
 719
 720         if ('\0' != *n->type_instance)
 721                 if (NULL == hv_store (hash, "type_instance", 13,
 722                                 newSVpv (n->type_instance, 0), 0))
 723                         return -1;
 724
 725         if (NULL != n->meta) {
 726                 AV *meta = newAV ();
 727                 if ((0 != notification_meta2av (aTHX_ n->meta, meta))
 728                                 || (NULL == hv_store (hash, "meta", 4,
 729                                                 newRV_noinc ((SV *)meta), 0))) {
 730                         av_clear (meta);
 731                         av_undef (meta);
 732                         return -1;
 733                 }
 734         }
 735         return 0;
 736 } /* static int notification2hv (notification_t *, HV *) */
 737
 738 static int oconfig_item2hv (pTHX_ oconfig_item_t *ci, HV *hash)
 739 {
 740         int i;
 741
 742         AV *values;
 743         AV *children;
 744
 745         if (NULL == hv_store (hash, "key", 3, newSVpv (ci->key, 0), 0))
 746                 return -1;
 747
 748         values = newAV ();
 749         if (0 < ci->values_num)
 750                 av_extend (values, ci->values_num);
 751
 752         if (NULL == hv_store (hash, "values", 6, newRV_noinc ((SV *)values), 0)) {
 753                 av_clear (values);
 754                 av_undef (values);
 755                 return -1;
 756         }
 757
 758         for (i = 0; i < ci->values_num; ++i) {
 759                 SV *value;
 760
 761                 switch (ci->values[i].type) {
 762                         case OCONFIG_TYPE_STRING:
 763                                 value = newSVpv (ci->values[i].value.string, 0);
 764                                 break;
 765                         case OCONFIG_TYPE_NUMBER:
 766                                 value = newSVnv ((NV)ci->values[i].value.number);
 767                                 break;
 768                         case OCONFIG_TYPE_BOOLEAN:
 769                                 value = ci->values[i].value.boolean ? &PL_sv_yes : &PL_sv_no;
 770                                 break;
 771                         default:
 772                                 log_err ("oconfig_item2hv: Invalid value type %i.",
 773                                                 ci->values[i].type);
 774                                 value = &PL_sv_undef;
 775                 }
 776
 777                 if (NULL == av_store (values, i, value)) {
 778                         sv_free (value);
 779                         return -1;
 780                 }
 781         }
 782
 783         /* ignoring 'parent' member which is uninteresting in this case */
 784
 785         children = newAV ();
 786         if (0 < ci->children_num)
 787                 av_extend (children, ci->children_num);
 788
 789         if (NULL == hv_store (hash, "children", 8, newRV_noinc ((SV *)children), 0)) {
 790                 av_clear (children);
 791                 av_undef (children);
 792                 return -1;
 793         }
 794
 795         for (i = 0; i < ci->children_num; ++i) {
 796                 HV *child = newHV ();
 797
 798                 if (0 != oconfig_item2hv (aTHX_ ci->children + i, child)) {
 799                         hv_clear (child);
 800                         hv_undef (child);
 801                         return -1;
 802                 }
 803
 804                 if (NULL == av_store (children, i, newRV_noinc ((SV *)child))) {
 805                         hv_clear (child);
 806                         hv_undef (child);
 807                         return -1;
 808                 }
 809         }
 810         return 0;
 811 } /* static int oconfig_item2hv (pTHX_ oconfig_item_t *, HV *) */
 812
 813 /*
 814  * Internal functions.
 815  */
 816
 817 static char *get_module_name (char *buf, size_t buf_len, const char *module) {
 818         int status = 0;
 819         if (base_name[0] == '\0')
 820                 status = ssnprintf (buf, buf_len, "%s", module);
 821         else
 822                 status = ssnprintf (buf, buf_len, "%s::%s", base_name, module);
 823         if ((status < 0) || ((unsigned int)status >= buf_len))
 824                 return (NULL);
 825         return (buf);
 826 } /* char *get_module_name */
 827
 828 /*
 829  * Add a plugin's data set definition.
 830  */
 831 static int pplugin_register_data_set (pTHX_ char *name, AV *dataset)
 832 {
 833         int ret = 0;
 834
 835         data_set_t ds;
 836
 837         if ((NULL == name) || (NULL == dataset))
 838                 return -1;
 839
 840         if (0 != av2data_set (aTHX_ dataset, name, &ds))
 841                 return -1;
 842
 843         ret = plugin_register_data_set (&ds);
 844
 845         free (ds.ds);
 846         return ret;
 847 } /* static int pplugin_register_data_set (char *, SV *) */
 848
 849 /*
 850  * Remove a plugin's data set definition.
 851  */
 852 static int pplugin_unregister_data_set (char *name)
 853 {
 854         if (NULL == name)
 855                 return 0;
 856         return plugin_unregister_data_set (name);
 857 } /* static int pplugin_unregister_data_set (char *) */
 858
 859 /*
 860  * Submit the values to the write functions.
 861  */
 862 static int pplugin_dispatch_values (pTHX_ HV *values)
 863 {
 864         value_list_t vl = VALUE_LIST_INIT;
 865
 866         int ret = 0;
 867
 868         if (NULL == values)
 869                 return -1;
 870
 871         if (0 != hv2value_list (aTHX_ values, &vl))
 872                 return -1;
 873
 874         ret = plugin_dispatch_values (&vl);
 875
 876         sfree (vl.values);
 877         return ret;
 878 } /* static int pplugin_dispatch_values (char *, HV *) */
 879
 880 /*
 881  * Submit the values to a single write function.
 882  */
 883 static int pplugin_write (pTHX_ const char *plugin, AV *data_set, HV *values)
 884 {
 885         data_set_t   ds;
 886         value_list_t vl = VALUE_LIST_INIT;
 887
 888         int ret;
 889
 890         if (NULL == values)
 891                 return -1;
 892
 893         if (0 != hv2value_list (aTHX_ values, &vl))
 894                 return -1;
 895
 896         if ((NULL != data_set)
 897                         && (0 != av2data_set (aTHX_ data_set, vl.type, &ds)))
 898                 return -1;
 899
 900         ret = plugin_write (plugin, NULL == data_set ? NULL : &ds, &vl);
 901         if (0 != ret)
 902                 log_warn ("Dispatching value to plugin \"%s\" failed with status %i.",
 903                                 NULL == plugin ? "<any>" : plugin, ret);
 904
 905         if (NULL != data_set)
 906                 sfree (ds.ds);
 907         sfree (vl.values);
 908         return ret;
 909 } /* static int pplugin_write (const char *plugin, HV *, HV *) */
 910
 911 /*
 912  * Dispatch a notification.
 913  */
 914 static int pplugin_dispatch_notification (pTHX_ HV *notif)
 915 {
 916         notification_t n;
 917
 918         int ret;
 919
 920         if (NULL == notif)
 921                 return -1;
 922
 923         memset (&n, 0, sizeof (n));
 924
 925         if (0 != hv2notification (aTHX_ notif, &n))
 926                 return -1;
 927
 928         ret = plugin_dispatch_notification (&n);
 929         plugin_notification_meta_free (n.meta);
 930         return ret;
 931 } /* static int pplugin_dispatch_notification (HV *) */
 932
 933 /*
 934  * Call all working functions of the given type.
 935  */
 936 static int pplugin_call_all (pTHX_ int type, ...)
 937 {
 938         int retvals = 0;
 939
 940         va_list ap;
 941         int ret = 0;
 942
 943         dSP;
 944
 945         if ((type < 0) || (type >= PLUGIN_TYPES))
 946                 return -1;
 947
 948         va_start (ap, type);
 949
 950         ENTER;
 951         SAVETMPS;
 952
 953         PUSHMARK (SP);
 954
 955         XPUSHs (sv_2mortal (newSViv ((IV)type)));
 956
 957         if (PLUGIN_WRITE == type) {
 958                 /*
 959                  * $_[0] = $plugin_type;
 960                  *
 961                  * $_[1] =
 962                  * [
 963                  *   {
 964                  *     name => $ds_name,
 965                  *     type => $ds_type,
 966                  *     min  => $ds_min,
 967                  *     max  => $ds_max
 968                  *   },
 969                  *   ...
 970                  * ];
 971                  *
 972                  * $_[2] =
 973                  * {
 974                  *   values => [ $v1, ... ],
 975                  *   time   => $time,
 976                  *   host   => $hostname,
 977                  *   plugin => $plugin,
 978                  *   type   => $type,
 979                  *   plugin_instance => $instance,
 980                  *   type_instance   => $type_instance
 981                  * };
 982                  */
 983                 data_set_t   *ds;
 984                 value_list_t *vl;
 985
 986                 AV *pds = newAV ();
 987                 HV *pvl = newHV ();
 988
 989                 ds = va_arg (ap, data_set_t *);
 990                 vl = va_arg (ap, value_list_t *);
 991
 992                 if (-1 == data_set2av (aTHX_ ds, pds)) {
 993                         av_clear (pds);
 994                         av_undef (pds);
 995                         pds = (AV *)&PL_sv_undef;
 996                         ret = -1;
 997                 }
 998
 999                 if (-1 == value_list2hv (aTHX_ vl, ds, pvl)) {
1000                         hv_clear (pvl);
1001                         hv_undef (pvl);
1002                         pvl = (HV *)&PL_sv_undef;
1003                         ret = -1;
1004                 }
1005
1006                 XPUSHs (sv_2mortal (newSVpv (ds->type, 0)));
1007                 XPUSHs (sv_2mortal (newRV_noinc ((SV *)pds)));
1008                 XPUSHs (sv_2mortal (newRV_noinc ((SV *)pvl)));
1009         }
1010         else if (PLUGIN_LOG == type) {
1011                 /*
1012                  * $_[0] = $level;
1013                  *
1014                  * $_[1] = $message;
1015                  */
1016                 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
1017                 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
1018         }
1019         else if (PLUGIN_NOTIF == type) {
1020                 /*
1021                  * $_[0] =
1022                  * {
1023                  *   severity => $severity,
1024                  *   time     => $time,
1025                  *   message  => $msg,
1026                  *   host     => $host,
1027                  *   plugin   => $plugin,
1028                  *   type     => $type,
1029                  *   plugin_instance => $instance,
1030                  *   type_instance   => $type_instance
1031                  * };
1032                  */
1033                 notification_t *n;
1034                 HV *notif = newHV ();
1035
1036                 n = va_arg (ap, notification_t *);
1037
1038                 if (-1 == notification2hv (aTHX_ n, notif)) {
1039                         hv_clear (notif);
1040                         hv_undef (notif);
1041                         notif = (HV *)&PL_sv_undef;
1042                         ret = -1;
1043                 }
1044
1045                 XPUSHs (sv_2mortal (newRV_noinc ((SV *)notif)));
1046         }
1047         else if (PLUGIN_FLUSH == type) {
1048                 /*
1049                  * $_[0] = $timeout;
1050                  * $_[1] = $identifier;
1051                  */
1052                 XPUSHs (sv_2mortal (newSViv (va_arg (ap, int))));
1053                 XPUSHs (sv_2mortal (newSVpv (va_arg (ap, char *), 0)));
1054         }
1055
1056         PUTBACK;
1057
1058         retvals = call_pv ("Collectd::plugin_call_all", G_SCALAR);
1059
1060         SPAGAIN;
1061         if (0 < retvals) {
1062                 SV *tmp = POPs;
1063                 if (! SvTRUE (tmp))
1064                         ret = -1;
1065         }
1066
1067         PUTBACK;
1068         FREETMPS;
1069         LEAVE;
1070
1071         va_end (ap);
1072         return ret;
1073 } /* static int pplugin_call_all (int, ...) */
1074
1075 /*
1076  * Exported Perl API.
1077  */
1078
1079 /*
1080  * Collectd::plugin_register_data_set (type, dataset).
1081  *
1082  * type:
1083  *   type of the dataset
1084  *
1085  * dataset:
1086  *   dataset to be registered
1087  */
1088 static XS (Collectd_plugin_register_ds)
1089 {
1090         SV  *data = NULL;
1091         int ret   = 0;
1092
1093         dXSARGS;
1094
1095         if (2 != items) {
1096                 log_err ("Usage: Collectd::plugin_register_data_set(type, dataset)");
1097                 XSRETURN_EMPTY;
1098         }
1099
1100         log_debug ("Collectd::plugin_register_data_set: "
1101                         "type = \"%s\", dataset = \"%s\"",
1102                         SvPV_nolen (ST (0)), SvPV_nolen (ST (1)));
1103
1104         data = ST (1);
1105
1106         if (SvROK (data) && (SVt_PVAV == SvTYPE (SvRV (data)))) {
1107                 ret = pplugin_register_data_set (aTHX_ SvPV_nolen (ST (0)),
1108                                 (AV *)SvRV (data));
1109         }
1110         else {
1111                 log_err ("Collectd::plugin_register_data_set: Invalid data.");
1112                 XSRETURN_EMPTY;
1113         }
1114
1115         if (0 == ret)
1116                 XSRETURN_YES;
1117         else
1118                 XSRETURN_EMPTY;
1119 } /* static XS (Collectd_plugin_register_ds) */
1120
1121 /*
1122  * Collectd::plugin_unregister_data_set (type).
1123  *
1124  * type:
1125  *   type of the dataset
1126  */
1127 static XS (Collectd_plugin_unregister_ds)
1128 {
1129         dXSARGS;
1130
1131         if (1 != items) {
1132                 log_err ("Usage: Collectd::plugin_unregister_data_set(type)");
1133                 XSRETURN_EMPTY;
1134         }
1135
1136         log_debug ("Collectd::plugin_unregister_data_set: type = \"%s\"",
1137                         SvPV_nolen (ST (0)));
1138
1139         if (0 == pplugin_unregister_data_set (SvPV_nolen (ST (0))))
1140                 XSRETURN_YES;
1141         else
1142                 XSRETURN_EMPTY;
1143 } /* static XS (Collectd_plugin_register_ds) */
1144
1145 /*
1146  * Collectd::plugin_dispatch_values (name, values).
1147  *
1148  * name:
1149  *   name of the plugin
1150  *
1151  * values:
1152  *   value list to submit
1153  */
1154 static XS (Collectd_plugin_dispatch_values)
1155 {
1156         SV *values     = NULL;
1157         int values_idx = 0;
1158
1159         int ret = 0;
1160
1161         dXSARGS;
1162
1163         if (2 == items) {
1164                 log_warn ("Collectd::plugin_dispatch_values with two arguments "
1165                                 "is deprecated - pass the type through values->{type}.");
1166                 values_idx = 1;
1167         }
1168         else if (1 != items) {
1169                 log_err ("Usage: Collectd::plugin_dispatch_values(values)");
1170                 XSRETURN_EMPTY;
1171         }
1172
1173         log_debug ("Collectd::plugin_dispatch_values: values=\"%s\"",
1174                         SvPV_nolen (ST (values_idx)));
1175
1176         values = ST (values_idx);
1177
1178         if (! (SvROK (values) && (SVt_PVHV == SvTYPE (SvRV (values))))) {
1179                 log_err ("Collectd::plugin_dispatch_values: Invalid values.");
1180                 XSRETURN_EMPTY;
1181         }
1182
1183         if (((2 == items) && (NULL == ST (0))) || (NULL == values))
1184                 XSRETURN_EMPTY;
1185
1186         if ((2 == items) && (NULL == hv_store ((HV *)SvRV (values), "type", 4,
1187                         newSVsv (ST (0)), 0))) {
1188                 log_err ("Collectd::plugin_dispatch_values: Could not store type.");
1189                 XSRETURN_EMPTY;
1190         }
1191
1192         ret = pplugin_dispatch_values (aTHX_ (HV *)SvRV (values));
1193
1194         if (0 == ret)
1195                 XSRETURN_YES;
1196         else
1197                 XSRETURN_EMPTY;
1198 } /* static XS (Collectd_plugin_dispatch_values) */
1199
1200 /* Collectd::plugin_write (plugin, ds, vl).
1201  *
1202  * plugin:
1203  *   name of the plugin to call, may be 'undef'
1204  *
1205  * ds:
1206  *   data-set that describes the submitted values, may be 'undef'
1207  *
1208  * vl:
1209  *   value-list to be written
1210  */
1211 static XS (Collectd__plugin_write)
1212 {
1213         char *plugin;
1214         SV   *ds, *vl;
1215         AV   *ds_array;
1216
1217         int ret;
1218
1219         dXSARGS;
1220
1221         if (3 != items) {
1222                 log_err ("Usage: Collectd::plugin_write(plugin, ds, vl)");
1223                 XSRETURN_EMPTY;
1224         }
1225
1226         log_debug ("Collectd::plugin_write: plugin=\"%s\", ds=\"%s\", vl=\"%s\"",
1227                         SvPV_nolen (ST (0)), SvOK (ST (1)) ? SvPV_nolen (ST (1)) : "",
1228                         SvPV_nolen (ST (2)));
1229
1230         if (! SvOK (ST (0)))
1231                 plugin = NULL;
1232         else
1233                 plugin = SvPV_nolen (ST (0));
1234
1235         ds = ST (1);
1236         if (SvROK (ds) && (SVt_PVAV == SvTYPE (SvRV (ds))))
1237                 ds_array = (AV *)SvRV (ds);
1238         else if (! SvOK (ds))
1239                 ds_array = NULL;
1240         else {
1241                 log_err ("Collectd::plugin_write: Invalid data-set.");
1242                 XSRETURN_EMPTY;
1243         }
1244
1245         vl = ST (2);
1246         if (! (SvROK (vl) && (SVt_PVHV == SvTYPE (SvRV (vl))))) {
1247                 log_err ("Collectd::plugin_write: Invalid value-list.");
1248                 XSRETURN_EMPTY;
1249         }
1250
1251         ret = pplugin_write (aTHX_ plugin, ds_array, (HV *)SvRV (vl));
1252
1253         if (0 == ret)
1254                 XSRETURN_YES;
1255         else
1256                 XSRETURN_EMPTY;
1257 } /* static XS (Collectd__plugin_write) */
1258
1259 /*
1260  * Collectd::_plugin_flush (plugin, timeout, identifier).
1261  *
1262  * plugin:
1263  *   name of the plugin to flush
1264  *
1265  * timeout:
1266  *   timeout to use when flushing the data
1267  *
1268  * identifier:
1269  *   data-set identifier to flush
1270  */
1271 static XS (Collectd__plugin_flush)
1272 {
1273         char *plugin  = NULL;
1274         int   timeout = -1;
1275         char *id      = NULL;
1276
1277         dXSARGS;
1278
1279         if (3 != items) {
1280                 log_err ("Usage: Collectd::_plugin_flush(plugin, timeout, id)");
1281                 XSRETURN_EMPTY;
1282         }
1283
1284         if (SvOK (ST (0)))
1285                 plugin = SvPV_nolen (ST (0));
1286
1287         if (SvOK (ST (1)))
1288                 timeout = (int)SvIV (ST (1));
1289
1290         if (SvOK (ST (2)))
1291                 id = SvPV_nolen (ST (2));
1292
1293         log_debug ("Collectd::_plugin_flush: plugin = \"%s\", timeout = %i, "
1294                         "id = \"%s\"", plugin, timeout, id);
1295
1296         if (0 == plugin_flush (plugin, timeout, id))
1297                 XSRETURN_YES;
1298         else
1299                 XSRETURN_EMPTY;
1300 } /* static XS (Collectd__plugin_flush) */
1301
1302 /*
1303  * Collectd::plugin_dispatch_notification (notif).
1304  *
1305  * notif:
1306  *   notification to dispatch
1307  */
1308 static XS (Collectd_plugin_dispatch_notification)
1309 {
1310         SV *notif = NULL;
1311
1312         int ret = 0;
1313
1314         dXSARGS;
1315
1316         if (1 != items) {
1317                 log_err ("Usage: Collectd::plugin_dispatch_notification(notif)");
1318                 XSRETURN_EMPTY;
1319         }
1320
1321         log_debug ("Collectd::plugin_dispatch_notification: notif = \"%s\"",
1322                         SvPV_nolen (ST (0)));
1323
1324         notif = ST (0);
1325
1326         if (! (SvROK (notif) && (SVt_PVHV == SvTYPE (SvRV (notif))))) {
1327                 log_err ("Collectd::plugin_dispatch_notification: Invalid notif.");
1328                 XSRETURN_EMPTY;
1329         }
1330
1331         ret = pplugin_dispatch_notification (aTHX_ (HV *)SvRV (notif));
1332
1333         if (0 == ret)
1334                 XSRETURN_YES;
1335         else
1336                 XSRETURN_EMPTY;
1337 } /* static XS (Collectd_plugin_dispatch_notification) */
1338
1339 /*
1340  * Collectd::plugin_log (level, message).
1341  *
1342  * level:
1343  *   log level (LOG_DEBUG, ... LOG_ERR)
1344  *
1345  * message:
1346  *   log message
1347  */
1348 static XS (Collectd_plugin_log)
1349 {
1350         dXSARGS;
1351
1352         if (2 != items) {
1353                 log_err ("Usage: Collectd::plugin_log(level, message)");
1354                 XSRETURN_EMPTY;
1355         }
1356
1357         plugin_log (SvIV (ST (0)), "%s", SvPV_nolen (ST (1)));
1358         XSRETURN_YES;
1359 } /* static XS (Collectd_plugin_log) */
1360
1361 /*
1362  * Collectd::call_by_name (...).
1363  *
1364  * Call a Perl sub identified by its name passed through $Collectd::cb_name.
1365  */
1366 static XS (Collectd_call_by_name)
1367 {
1368         SV   *tmp  = NULL;
1369         char *name = NULL;
1370
1371         if (NULL == (tmp = get_sv ("Collectd::cb_name", 0))) {
1372                 sv_setpv (get_sv ("@", 1), "cb_name has not been set");
1373                 CLEAR_STACK_FRAME;
1374                 return;
1375         }
1376
1377         name = SvPV_nolen (tmp);
1378
1379         if (NULL == get_cv (name, 0)) {
1380                 sv_setpvf (get_sv ("@", 1), "unknown callback \"%s\"", name);
1381                 CLEAR_STACK_FRAME;
1382                 return;
1383         }
1384
1385         /* simply pass on the subroutine call without touching the stack,
1386          * thus leaving any arguments and return values in place */
1387         call_pv (name, 0);
1388 } /* static XS (Collectd_call_by_name) */
1389
1390 /*
1391  * collectd's perl interpreter based thread implementation.
1392  *
1393  * This has been inspired by Perl's ithreads introduced in version 5.6.0.
1394  */
1395
1396 /* must be called with perl_threads->mutex locked */
1397 static void c_ithread_destroy (c_ithread_t *ithread)
1398 {
1399         dTHXa (ithread->interp);
1400
1401         assert (NULL != perl_threads);
1402
1403         PERL_SET_CONTEXT (aTHX);
1404         log_debug ("Shutting down Perl interpreter %p...", aTHX);
1405
1406 #if COLLECT_DEBUG
1407         sv_report_used ();
1408
1409         --perl_threads->number_of_threads;
1410 #endif /* COLLECT_DEBUG */
1411
1412         perl_destruct (aTHX);
1413         perl_free (aTHX);
1414
1415         if (NULL == ithread->prev)
1416                 perl_threads->head = ithread->next;
1417         else
1418                 ithread->prev->next = ithread->next;
1419
1420         if (NULL == ithread->next)
1421                 perl_threads->tail = ithread->prev;
1422         else
1423                 ithread->next->prev = ithread->prev;
1424
1425         sfree (ithread);
1426         return;
1427 } /* static void c_ithread_destroy (c_ithread_t *) */
1428
1429 static void c_ithread_destructor (void *arg)
1430 {
1431         c_ithread_t *ithread = (c_ithread_t *)arg;
1432         c_ithread_t *t = NULL;
1433
1434         if (NULL == perl_threads)
1435                 return;
1436
1437         pthread_mutex_lock (&perl_threads->mutex);
1438
1439         for (t = perl_threads->head; NULL != t; t = t->next)
1440                 if (t == ithread)
1441                         break;
1442
1443         /* the ithread no longer exists */
1444         if (NULL == t)
1445                 return;
1446
1447         c_ithread_destroy (ithread);
1448
1449         pthread_mutex_unlock (&perl_threads->mutex);
1450         return;
1451 } /* static void c_ithread_destructor (void *) */
1452
1453 /* must be called with perl_threads->mutex locked */
1454 static c_ithread_t *c_ithread_create (PerlInterpreter *base)
1455 {
1456         c_ithread_t *t = NULL;
1457         dTHXa (NULL);
1458
1459         assert (NULL != perl_threads);
1460
1461         t = (c_ithread_t *)smalloc (sizeof (c_ithread_t));
1462         memset (t, 0, sizeof (c_ithread_t));
1463
1464         t->interp = (NULL == base)
1465                 ? NULL
1466                 : perl_clone (base, CLONEf_KEEP_PTR_TABLE);
1467
1468         aTHX = t->interp;
1469
1470         if ((NULL != base) && (NULL != PL_endav)) {
1471                 av_clear (PL_endav);
1472                 av_undef (PL_endav);
1473                 PL_endav = Nullav;
1474         }
1475
1476 #if COLLECT_DEBUG
1477         ++perl_threads->number_of_threads;
1478 #endif /* COLLECT_DEBUG */
1479
1480         t->next = NULL;
1481
1482         if (NULL == perl_threads->tail) {
1483                 perl_threads->head = t;
1484                 t->prev = NULL;
1485         }
1486         else {
1487                 perl_threads->tail->next = t;
1488                 t->prev = perl_threads->tail;
1489         }
1490
1491         perl_threads->tail = t;
1492
1493         pthread_setspecific (perl_thr_key, (const void *)t);
1494         return t;
1495 } /* static c_ithread_t *c_ithread_create (PerlInterpreter *) */
1496
1497 /*
1498  * Interface to collectd.
1499  */
1500
1501 static int perl_init (void)
1502 {
1503         dTHX;
1504
1505         if (NULL == perl_threads)
1506                 return 0;
1507
1508         if (NULL == aTHX) {
1509                 c_ithread_t *t = NULL;
1510
1511                 pthread_mutex_lock (&perl_threads->mutex);
1512                 t = c_ithread_create (perl_threads->head->interp);
1513                 pthread_mutex_unlock (&perl_threads->mutex);
1514
1515                 aTHX = t->interp;
1516         }
1517
1518         log_debug ("perl_init: c_ithread: interp = %p (active threads: %i)",
1519                         aTHX, perl_threads->number_of_threads);
1520         return pplugin_call_all (aTHX_ PLUGIN_INIT);
1521 } /* static int perl_init (void) */
1522
1523 static int perl_read (void)
1524 {
1525         dTHX;
1526
1527         if (NULL == perl_threads)
1528                 return 0;
1529
1530         if (NULL == aTHX) {
1531                 c_ithread_t *t = NULL;
1532
1533                 pthread_mutex_lock (&perl_threads->mutex);
1534                 t = c_ithread_create (perl_threads->head->interp);
1535                 pthread_mutex_unlock (&perl_threads->mutex);
1536
1537                 aTHX = t->interp;
1538         }
1539
1540         log_debug ("perl_read: c_ithread: interp = %p (active threads: %i)",
1541                         aTHX, perl_threads->number_of_threads);
1542         return pplugin_call_all (aTHX_ PLUGIN_READ);
1543 } /* static int perl_read (void) */
1544
1545 static int perl_write (const data_set_t *ds, const value_list_t *vl)
1546 {
1547         dTHX;
1548
1549         if (NULL == perl_threads)
1550                 return 0;
1551
1552         if (NULL == aTHX) {
1553                 c_ithread_t *t = NULL;
1554
1555                 pthread_mutex_lock (&perl_threads->mutex);
1556                 t = c_ithread_create (perl_threads->head->interp);
1557                 pthread_mutex_unlock (&perl_threads->mutex);
1558
1559                 aTHX = t->interp;
1560         }
1561
1562         log_debug ("perl_write: c_ithread: interp = %p (active threads: %i)",
1563                         aTHX, perl_threads->number_of_threads);
1564         return pplugin_call_all (aTHX_ PLUGIN_WRITE, ds, vl);
1565 } /* static int perl_write (const data_set_t *, const value_list_t *) */
1566
1567 static void perl_log (int level, const char *msg)
1568 {
1569         dTHX;
1570
1571         if (NULL == perl_threads)
1572                 return;
1573
1574         if (NULL == aTHX) {
1575                 c_ithread_t *t = NULL;
1576
1577                 pthread_mutex_lock (&perl_threads->mutex);
1578                 t = c_ithread_create (perl_threads->head->interp);
1579                 pthread_mutex_unlock (&perl_threads->mutex);
1580
1581                 aTHX = t->interp;
1582         }
1583
1584         pplugin_call_all (aTHX_ PLUGIN_LOG, level, msg);
1585         return;
1586 } /* static void perl_log (int, const char *) */
1587
1588 static int perl_notify (const notification_t *notif)
1589 {
1590         dTHX;
1591
1592         if (NULL == perl_threads)
1593                 return 0;
1594
1595         if (NULL == aTHX) {
1596                 c_ithread_t *t = NULL;
1597
1598                 pthread_mutex_lock (&perl_threads->mutex);
1599                 t = c_ithread_create (perl_threads->head->interp);
1600                 pthread_mutex_unlock (&perl_threads->mutex);
1601
1602                 aTHX = t->interp;
1603         }
1604         return pplugin_call_all (aTHX_ PLUGIN_NOTIF, notif);
1605 } /* static int perl_notify (const notification_t *) */
1606
1607 static int perl_flush (int timeout, const char *identifier)
1608 {
1609         dTHX;
1610
1611         if (NULL == perl_threads)
1612                 return 0;
1613
1614         if (NULL == aTHX) {
1615                 c_ithread_t *t = NULL;
1616
1617                 pthread_mutex_lock (&perl_threads->mutex);
1618                 t = c_ithread_create (perl_threads->head->interp);
1619                 pthread_mutex_unlock (&perl_threads->mutex);
1620
1621                 aTHX = t->interp;
1622         }
1623         return pplugin_call_all (aTHX_ PLUGIN_FLUSH, timeout, identifier);
1624 } /* static int perl_flush (const int) */
1625
1626 static int perl_shutdown (void)
1627 {
1628         c_ithread_t *t = NULL;
1629
1630         int ret = 0;
1631
1632         dTHX;
1633
1634         plugin_unregister_complex_config ("perl");
1635
1636         if (NULL == perl_threads)
1637                 return 0;
1638
1639         if (NULL == aTHX) {
1640                 c_ithread_t *t = NULL;
1641
1642                 pthread_mutex_lock (&perl_threads->mutex);
1643                 t = c_ithread_create (perl_threads->head->interp);
1644                 pthread_mutex_unlock (&perl_threads->mutex);
1645
1646                 aTHX = t->interp;
1647         }
1648
1649         log_debug ("perl_shutdown: c_ithread: interp = %p (active threads: %i)",
1650                         aTHX, perl_threads->number_of_threads);
1651
1652         plugin_unregister_log ("perl");
1653         plugin_unregister_notification ("perl");
1654         plugin_unregister_init ("perl");
1655         plugin_unregister_read ("perl");
1656         plugin_unregister_write ("perl");
1657         plugin_unregister_flush ("perl");
1658
1659         ret = pplugin_call_all (aTHX_ PLUGIN_SHUTDOWN);
1660
1661         pthread_mutex_lock (&perl_threads->mutex);
1662         t = perl_threads->tail;
1663
1664         while (NULL != t) {
1665                 c_ithread_t *thr = t;
1666
1667                 /* the pointer has to be advanced before destroying
1668                  * the thread as this will free the memory */
1669                 t = t->prev;
1670
1671                 c_ithread_destroy (thr);
1672         }
1673
1674         pthread_mutex_unlock (&perl_threads->mutex);
1675         pthread_mutex_destroy (&perl_threads->mutex);
1676
1677         sfree (perl_threads);
1678
1679         pthread_key_delete (perl_thr_key);
1680
1681         PERL_SYS_TERM ();
1682
1683         plugin_unregister_shutdown ("perl");
1684         return ret;
1685 } /* static void perl_shutdown (void) */
1686
1687 /*
1688  * Access functions for global variables.
1689  *
1690  * These functions implement the "magic" used to access
1691  * the global variables from Perl.
1692  */
1693
1694 static int g_pv_get (pTHX_ SV *var, MAGIC *mg)
1695 {
1696         char *pv = mg->mg_ptr;
1697         sv_setpv (var, pv);
1698         return 0;
1699 } /* static int g_pv_get (pTHX_ SV *, MAGIC *) */
1700
1701 static int g_pv_set (pTHX_ SV *var, MAGIC *mg)
1702 {
1703         char *pv = mg->mg_ptr;
1704         sstrncpy (pv, SvPV_nolen (var), DATA_MAX_NAME_LEN);
1705         return 0;
1706 } /* static int g_pv_set (pTHX_ SV *, MAGIC *) */
1707
1708 static int g_iv_get (pTHX_ SV *var, MAGIC *mg)
1709 {
1710         int *iv = (int *)mg->mg_ptr;
1711         sv_setiv (var, *iv);
1712         return 0;
1713 } /* static int g_iv_get (pTHX_ SV *, MAGIC *) */
1714
1715 static int g_iv_set (pTHX_ SV *var, MAGIC *mg)
1716 {
1717         int *iv = (int *)mg->mg_ptr;
1718         *iv = (int)SvIV (var);
1719         return 0;
1720 } /* static int g_iv_set (pTHX_ SV *, MAGIC *) */
1721
1722 static MGVTBL g_pv_vtbl = {
1723         g_pv_get, g_pv_set, NULL, NULL, NULL, NULL, NULL
1724 #if HAVE_PERL_STRUCT_MGVTBL_SVT_LOCAL
1725                 , NULL
1726 #endif
1727 };
1728 static MGVTBL g_iv_vtbl = {
1729         g_iv_get, g_iv_set, NULL, NULL, NULL, NULL, NULL
1730 #if HAVE_PERL_STRUCT_MGVTBL_SVT_LOCAL
1731                 , NULL
1732 #endif
1733 };
1734
1735 /* bootstrap the Collectd module */
1736 static void xs_init (pTHX)
1737 {
1738         HV   *stash = NULL;
1739         SV   *tmp   = NULL;
1740         char *file  = __FILE__;
1741
1742         int i = 0;
1743
1744         dXSUB_SYS;
1745
1746         /* enable usage of Perl modules using shared libraries */
1747         newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
1748
1749         /* register API */
1750         for (i = 0; NULL != api[i].f; ++i)
1751                 newXS (api[i].name, api[i].f, file);
1752
1753         stash = gv_stashpv ("Collectd", 1);
1754
1755         /* export "constants" */
1756         for (i = 0; '\0' != constants[i].name[0]; ++i)
1757                 newCONSTSUB (stash, constants[i].name, newSViv (constants[i].value));
1758
1759         /* export global variables
1760          * by adding "magic" to the SV's representing the globale variables
1761          * perl is able to automagically call the get/set function when
1762          * accessing any such variable (this is basically the same as using
1763          * tie() in Perl) */
1764         /* global strings */
1765         for (i = 0; '\0' != g_strings[i].name[0]; ++i) {
1766                 tmp = get_sv (g_strings[i].name, 1);
1767                 sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_pv_vtbl,
1768                                 g_strings[i].var, 0);
1769         }
1770
1771         /* global integers */
1772         for (i = 0; '\0' != g_integers[i].name[0]; ++i) {
1773                 tmp = get_sv (g_integers[i].name, 1);
1774                 sv_magicext (tmp, NULL, PERL_MAGIC_ext, &g_iv_vtbl,
1775                                 (char *)g_integers[i].var, 0);
1776         }
1777         return;
1778 } /* static void xs_init (pTHX) */
1779
1780 /* Initialize the global Perl interpreter. */
1781 static int init_pi (int argc, char **argv)
1782 {
1783         dTHXa (NULL);
1784
1785         if (NULL != perl_threads)
1786                 return 0;
1787
1788         log_info ("Initializing Perl interpreter...");
1789 #if COLLECT_DEBUG
1790         {
1791                 int i = 0;
1792
1793                 for (i = 0; i < argc; ++i)
1794                         log_debug ("argv[%i] = \"%s\"", i, argv[i]);
1795         }
1796 #endif /* COLLECT_DEBUG */
1797
1798         if (0 != pthread_key_create (&perl_thr_key, c_ithread_destructor)) {
1799                 log_err ("init_pi: pthread_key_create failed");
1800
1801                 /* this must not happen - cowardly giving up if it does */
1802                 return -1;
1803         }
1804
1805 #ifdef __FreeBSD__
1806         /* On FreeBSD, PERL_SYS_INIT3 expands to some expression which
1807          * triggers a "value computed is not used" warning by gcc. */
1808         (void)
1809 #endif
1810         PERL_SYS_INIT3 (&argc, &argv, &environ);
1811
1812         perl_threads = (c_ithread_list_t *)smalloc (sizeof (c_ithread_list_t));
1813         memset (perl_threads, 0, sizeof (c_ithread_list_t));
1814
1815         pthread_mutex_init (&perl_threads->mutex, NULL);
1816         /* locking the mutex should not be necessary at this point
1817          * but let's just do it for the sake of completeness */
1818         pthread_mutex_lock (&perl_threads->mutex);
1819
1820         perl_threads->head = c_ithread_create (NULL);
1821         perl_threads->tail = perl_threads->head;
1822
1823         if (NULL == (perl_threads->head->interp = perl_alloc ())) {
1824                 log_err ("init_pi: Not enough memory.");
1825                 exit (3);
1826         }
1827
1828         aTHX = perl_threads->head->interp;
1829         pthread_mutex_unlock (&perl_threads->mutex);
1830
1831         perl_construct (aTHX);
1832
1833         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
1834
1835         if (0 != perl_parse (aTHX_ xs_init, argc, argv, NULL)) {
1836                 SV *err = get_sv ("@", 1);
1837                 log_err ("init_pi: Unable to bootstrap Collectd: %s",
1838                                 SvPV_nolen (err));
1839
1840                 perl_destruct (perl_threads->head->interp);
1841                 perl_free (perl_threads->head->interp);
1842                 sfree (perl_threads);
1843
1844                 pthread_key_delete (perl_thr_key);
1845                 return -1;
1846         }
1847
1848         /* Set $0 to "collectd" because perl_parse() has to set it to "-e". */
1849         sv_setpv (get_sv ("0", 0), "collectd");
1850
1851         perl_run (aTHX);
1852
1853         plugin_register_log ("perl", perl_log);
1854         plugin_register_notification ("perl", perl_notify);
1855         plugin_register_init ("perl", perl_init);
1856
1857         plugin_register_read ("perl", perl_read);
1858
1859         plugin_register_write ("perl", perl_write);
1860         plugin_register_flush ("perl", perl_flush);
1861         plugin_register_shutdown ("perl", perl_shutdown);
1862         return 0;
1863 } /* static int init_pi (const char **, const int) */
1864
1865 /*
1866  * LoadPlugin "<Plugin>"
1867  */
1868 static int perl_config_loadplugin (pTHX_ oconfig_item_t *ci)
1869 {
1870         char module_name[DATA_MAX_NAME_LEN];
1871
1872         char *value = NULL;
1873
1874         if ((0 != ci->children_num) || (1 != ci->values_num)
1875                         || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
1876                 log_err ("LoadPlugin expects a single string argument.");
1877                 return 1;
1878         }
1879
1880         value = ci->values[0].value.string;
1881
1882         if (NULL == get_module_name (module_name, sizeof (module_name), value)) {
1883                 log_err ("Invalid module name %s", value);
1884                 return (1);
1885         }
1886
1887         if (0 != init_pi (perl_argc, perl_argv))
1888                 return -1;
1889
1890         assert (NULL != perl_threads);
1891         assert (NULL != perl_threads->head);
1892
1893         aTHX = perl_threads->head->interp;
1894
1895         log_debug ("perl_config: loading perl plugin \"%s\"", value);
1896         load_module (PERL_LOADMOD_NOIMPORT,
1897                         newSVpv (module_name, strlen (module_name)), Nullsv);
1898         return 0;
1899 } /* static int perl_config_loadplugin (oconfig_item_it *) */
1900
1901 /*
1902  * BaseName "<Name>"
1903  */
1904 static int perl_config_basename (pTHX_ oconfig_item_t *ci)
1905 {
1906         char *value = NULL;
1907
1908         if ((0 != ci->children_num) || (1 != ci->values_num)
1909                         || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
1910                 log_err ("BaseName expects a single string argument.");
1911                 return 1;
1912         }
1913
1914         value = ci->values[0].value.string;
1915
1916         log_debug ("perl_config: Setting plugin basename to \"%s\"", value);
1917         sstrncpy (base_name, value, sizeof (base_name));
1918         return 0;
1919 } /* static int perl_config_basename (oconfig_item_it *) */
1920
1921 /*
1922  * EnableDebugger "<Package>"|""
1923  */
1924 static int perl_config_enabledebugger (pTHX_ oconfig_item_t *ci)
1925 {
1926         char *value = NULL;
1927
1928         if ((0 != ci->children_num) || (1 != ci->values_num)
1929                         || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
1930                 log_err ("EnableDebugger expects a single string argument.");
1931                 return 1;
1932         }
1933
1934         if (NULL != perl_threads) {
1935                 log_warn ("EnableDebugger has no effects if used after LoadPlugin.");
1936                 return 1;
1937         }
1938
1939         value = ci->values[0].value.string;
1940
1941         perl_argv = (char **)realloc (perl_argv,
1942                         (++perl_argc + 1) * sizeof (char *));
1943
1944         if (NULL == perl_argv) {
1945                 log_err ("perl_config: Not enough memory.");
1946                 exit (3);
1947         }
1948
1949         if ('\0' == value[0]) {
1950                 perl_argv[perl_argc - 1] = "-d";
1951         }
1952         else {
1953                 perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 4);
1954                 sstrncpy (perl_argv[perl_argc - 1], "-d:", 4);
1955                 sstrncpy (perl_argv[perl_argc - 1] + 3, value, strlen (value) + 1);
1956         }
1957
1958         perl_argv[perl_argc] = NULL;
1959         return 0;
1960 } /* static int perl_config_enabledebugger (oconfig_item_it *) */
1961
1962 /*
1963  * IncludeDir "<Dir>"
1964  */
1965 static int perl_config_includedir (pTHX_ oconfig_item_t *ci)
1966 {
1967         char *value = NULL;
1968
1969         if ((0 != ci->children_num) || (1 != ci->values_num)
1970                         || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
1971                 log_err ("IncludeDir expects a single string argument.");
1972                 return 1;
1973         }
1974
1975         value = ci->values[0].value.string;
1976
1977         if (NULL == aTHX) {
1978                 perl_argv = (char **)realloc (perl_argv,
1979                                 (++perl_argc + 1) * sizeof (char *));
1980
1981                 if (NULL == perl_argv) {
1982                         log_err ("perl_config: Not enough memory.");
1983                         exit (3);
1984                 }
1985
1986                 perl_argv[perl_argc - 1] = (char *)smalloc (strlen (value) + 3);
1987                 sstrncpy(perl_argv[perl_argc - 1], "-I", 3);
1988                 sstrncpy(perl_argv[perl_argc - 1] + 2, value, strlen (value) + 1);
1989
1990                 perl_argv[perl_argc] = NULL;
1991         }
1992         else {
1993                 /* prepend the directory to @INC */
1994                 av_unshift (GvAVn (PL_incgv), 1);
1995                 av_store (GvAVn (PL_incgv), 0, newSVpv (value, strlen (value)));
1996         }
1997         return 0;
1998 } /* static int perl_config_includedir (oconfig_item_it *) */
1999
2000 /*
2001  * <Plugin> block
2002  */
2003 static int perl_config_plugin (pTHX_ oconfig_item_t *ci)
2004 {
2005         int retvals = 0;
2006         int ret     = 0;
2007
2008         char *plugin;
2009         HV   *config;
2010
2011         dSP;
2012
2013         if ((1 != ci->values_num) || (OCONFIG_TYPE_STRING != ci->values[0].type)) {
2014                 log_err ("LoadPlugin expects a single string argument.");
2015                 return 1;
2016         }
2017
2018         plugin = ci->values[0].value.string;
2019         config = newHV ();
2020
2021         if (0 != oconfig_item2hv (aTHX_ ci, config)) {
2022                 hv_clear (config);
2023                 hv_undef (config);
2024
2025                 log_err ("Unable to convert configuration to a Perl hash value.");
2026                 config = (HV *)&PL_sv_undef;
2027         }
2028
2029         ENTER;
2030         SAVETMPS;
2031
2032         PUSHMARK (SP);
2033
2034         XPUSHs (sv_2mortal (newSVpv (plugin, 0)));
2035         XPUSHs (sv_2mortal (newRV_noinc ((SV *)config)));
2036
2037         PUTBACK;
2038
2039         retvals = call_pv ("Collectd::_plugin_dispatch_config", G_SCALAR);
2040
2041         SPAGAIN;
2042         if (0 < retvals) {
2043                 SV *tmp = POPs;
2044                 if (! SvTRUE (tmp))
2045                         ret = 1;
2046         }
2047         else
2048                 ret = 1;
2049
2050         PUTBACK;
2051         FREETMPS;
2052         LEAVE;
2053         return ret;
2054 } /* static int perl_config_plugin (oconfig_item_it *) */
2055
2056 static int perl_config (oconfig_item_t *ci)
2057 {
2058         int status = 0;
2059         int i = 0;
2060
2061         dTHXa (NULL);
2062
2063         for (i = 0; i < ci->children_num; ++i) {
2064                 oconfig_item_t *c = ci->children + i;
2065                 int current_status = 0;
2066
2067                 if (NULL != perl_threads)
2068                         aTHX = PERL_GET_CONTEXT;
2069
2070                 if (0 == strcasecmp (c->key, "LoadPlugin"))
2071                         current_status = perl_config_loadplugin (aTHX_ c);
2072                 else if (0 == strcasecmp (c->key, "BaseName"))
2073                         current_status = perl_config_basename (aTHX_ c);
2074                 else if (0 == strcasecmp (c->key, "EnableDebugger"))
2075                         current_status = perl_config_enabledebugger (aTHX_ c);
2076                 else if (0 == strcasecmp (c->key, "IncludeDir"))
2077                         current_status = perl_config_includedir (aTHX_ c);
2078                 else if (0 == strcasecmp (c->key, "Plugin"))
2079                         current_status = perl_config_plugin (aTHX_ c);
2080                 else
2081                 {
2082                         log_warn ("Ignoring unknown config key \"%s\".", c->key);
2083                         current_status = 0;
2084                 }
2085
2086                 /* fatal error - it's up to perl_config_* to clean up */
2087                 if (0 > current_status) {
2088                         log_err ("Configuration failed with a fatal error - "
2089                                         "plugin disabled!");
2090                         return current_status;
2091                 }
2092
2093                 status += current_status;
2094         }
2095         return status;
2096 } /* static int perl_config (oconfig_item_t *) */
2097
2098 void module_register (void)
2099 {
2100         perl_argc = 4;
2101         perl_argv = (char **)smalloc ((perl_argc + 1) * sizeof (char *));
2102
2103         /* default options for the Perl interpreter */
2104         perl_argv[0] = "";
2105         perl_argv[1] = "-MCollectd";
2106         perl_argv[2] = "-e";
2107         perl_argv[3] = "1";
2108         perl_argv[4] = NULL;
2109
2110         plugin_register_complex_config ("perl", perl_config);
2111         return;
2112 } /* void module_register (void) */
2113
2114 /* vim: set sw=4 ts=4 tw=78 noexpandtab : */
2115