#! /bin/sh /usr/share/dpatch/dpatch-run
## perl_deadlock.dpatch by Sebastian Harl <sh@tokkee.org>
##
## DP: Collectd.pm: Improved the way access to @plugins is synchronized.
## DP:
## DP: So far, a lock has been placed on @plugins, so that no two threads could
## DP: access the list of plugins simultaneously. This could cause problems
## DP: which in certain situations could even lead to deadlocks. E.g. when
## DP: using the perl plugin in combination with the rrdtool plugin with
## DP: debugging enabled one would get hit by the following situation: the perl
## DP: plugin holds the lock on @plugins and then dispatches values to the
## DP: rrdtool plugin from some Perl plugin's read function. The rrdtool plugin
## DP: then tries to acquire its cache lock. At the same time some other plugin
## DP: dispatches values to the rrdtool plugin as well and this thread now
## DP: holds the lock on the rrdtool cache. While holding that lock, the
## DP: rrdtool plugin might dispatch a debug logging message and thus calls the
## DP: perl plugin's log-callback which tries to get the lock on @plugins thus
## DP: causing a deadlock.
## DP:
## DP: This has been resolved by the following two changes:
## DP:
## DP:  * Restrict the lock to the list of plugins of one type. This allows to
## DP:    access e.g. read and log plugins in parallel.
## DP:
## DP:  * Unlock the variable before calling the Perl callback function. This
## DP:    further prevents nested locks.
## DP:
## DP: (This is upstream Git commit dffb71cd6668e98f93c12da2ee2bd7a728d7292a)

@DPATCH@

diff a/bindings/perl/Collectd.pm b/bindings/perl/Collectd.pm
--- 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 {