bindings/perl/Collectd.pm: Improved the way access to @plugins is synchronized.

So far, a lock has been placed on @plugins, so that no two threads could
access the list of plugins simultaneously. This could cause problems which in
certain situations could even lead to deadlocks. E.g. when using the perl
plugin in combination with the rrdtool plugin with debugging enabled one would
get hit by the following situation: the perl plugin holds the lock on @plugins
and then dispatches values to the rrdtool plugin from some Perl plugin's read
function. The rrdtool plugin then tries to acquire its cache lock. At the same
time some other plugin dispatches values to the rrdtool plugin as well and
this thread now holds the lock on the rrdtool cache. While holding that lock,
the rrdtool plugin might dispatch a debug logging message and thus calls the
perl plugin's log-callback which tries to get the lock on @plugins thus
causing a deadlock.

This has been resolved by the following two changes:

 * Restrict the lock to the list of plugins of one type. This allows to access
   e.g. read and log plugins in parallel.

 * Unlock the variable before calling the Perl callback function. This
   further prevents nested locks.

Signed-off-by: Sebastian Harl <sh@tokkee.org>
Signed-off-by: Florian Forster <octo@huhu.verplant.org>

diff --git a/bindings/perl/Collectd.pm b/bindings/perl/Collectd.pm
index cca349ec7a2c60e9a43dfa4b7030ce2299837d79..afe92b2ccc57b5779f5770601ad4b10b61fe30eb 100644 (file)
--- a/bindings/perl/Collectd.pm
+++ b/bindings/perl/Collectd.pm
@@ -133,6 +133,8 @@ sub DEBUG   { _log (scalar caller, LOG_DEBUG,   shift); }
 sub plugin_call_all {
        my $type = shift;
 
+       my %plugins;
+
        our $cb_name = undef;
 
        if (! defined $type) {
@@ -148,9 +150,13 @@ sub plugin_call_all {
                return;
        }
 
-       lock @plugins;
-       foreach my $plugin (keys %{$plugins[$type]}) {
-               my $p = $plugins[$type]->{$plugin};
+       {
+               lock %{$plugins[$type]};
+               %plugins = %{$plugins[$type]};
+       }
+
+       foreach my $plugin (keys %plugins) {
+               my $p = $plugins{$plugin};
 
                my $status = 0;
 
@@ -261,7 +267,7 @@ sub plugin_register {
                        cb_name   => $data,
                );
 
-               lock @plugins;
+               lock %{$plugins[$type]};
                $plugins[$type]->{$name} = \%p;
        }
        else {
@@ -286,7 +292,7 @@ sub plugin_unregister {
                return plugin_unregister_data_set ($name);
        }
        elsif (defined $plugins[$type]) {
-               lock @plugins;
+               lock %{$plugins[$type]};
                delete $plugins[$type]->{$name};
        }
        else {