Per plugin hook timeouts

[Hanno Hecker]

Hi,

this is a first version of a per plugin hook timeout. It seems to work
well for me, but I've never had the problem of plugins running too
long... Basically this is an advanced version of what Robert suggested
here: http://www.nntp.perl.org/group/perl.qpsmtpd/2008/02/msg7781.html

The "timeout" plugin configures the timeouts, a timeout of 0 disables a
timeout (the default). 

Any wishes, comments, tests where the long running plugin problem
appears, ...?

One likely change in a later version would be a configurable return
code (+message) in case a timeout appears.

        Hanno
Index: lib/Qpsmtpd.pm
===================================================================
--- lib/Qpsmtpd.pm	(revision 917)
+++ lib/Qpsmtpd.pm	(working copy)
@@ -4,6 +4,7 @@
 
 use Sys::Hostname;
 use Qpsmtpd::Constants;
+use Mail::SpamAssassin::Timeout;
 
 #use DashProfiler;
 
@@ -387,11 +388,36 @@
 
 sub run_hooks_no_respond {
     my ($self, $hook) = (shift, shift);
+    my @args = @_;
     if ($hooks->{$hook}) {
         my @r;
         for my $code (@{$hooks->{$hook}}) {
-            eval { (@r) = $code->{code}->($self, $self->transaction, @_); };
+	    ## no timeout for logging / config, else we'd run into a 
+	    ## "deep recursion on subroutine" ... 
+	    my $hook_timeout = 0;
+	    unless ($hook =~ /^(config|logging)$/) {
+	        $hook_timeout = $self->config($code->{name}."/$hook");
+	    }
+	    $self->log(LOGDEBUG, "timeout for $hook set to $hook_timeout secs")
+	      if $hook_timeout;
+
+            my $mst = Mail::SpamAssassin::Timeout->new({secs => $hook_timeout});
+	    eval { 
+	    	$mst->run(sub {
+		    (@r) = $code->{code}->($self, $self->transaction, @args);
+	        });
+	    };
+	    # on a timeout, $@ is empty...
             $@ and warn("FATAL PLUGIN ERROR: ", $@) and next;
+	    # ...but $mst->timed_out is true
+	    if ($mst->timed_out) {
+	        $self->log(LOGERROR, "plugin ".$code->{name}.", hook $hook"
+		                    ." timed out after $hook_timeout seconds");
+		my $notes = $self->transaction->notes('plugin_timeouts') || {};
+                $notes->{$code->{name}}->{$hook}++;
+		$self->transaction->notes('plugin_timeouts', $notes);
+	        next;
+	    }
             if ($r[0] == YIELD) {
                 die "YIELD not valid from $hook hook";
             }
@@ -422,9 +448,25 @@
     #warn("Got sampler called: ${hook}_$code->{name}\n");
     $self->varlog(LOGDEBUG, $hook, $code->{name});
     my $tran = $self->transaction;
-    eval { (@r) = $code->{code}->($self, $tran, @$args); };
+    my $hook_timeout = 0;
+    unless ($hook =~ /^(config|logging)$/) {
+      $hook_timeout = $self->config($code->{name}."/$hook");
+    }
+    $self->log(LOGDEBUG, "timeout for $hook set to $hook_timeout secs")
+      if $hook_timeout;
+    my $mst = Mail::SpamAssassin::Timeout->new({ secs => $hook_timeout });
+    eval {
+      $mst->run(sub { (@r) = $code->{code}->($self, $tran, @$args); })
+    };
     $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR: ", $@) and next;
-
+    if ($mst->timed_out) {
+       $self->log(LOGERROR, "plugin ".$code->{name}.", hook $hook "
+                           ."timed out after $hook_timeout seconds");
+       my $notes = $self->transaction->notes('plugin_timeouts') || {};
+       $notes->{$code->{name}}->{$hook}++;
+       $self->transaction->notes('plugin_timeouts', $notes);
+       next;
+    }
     !defined $r[0]
         and $self->log(LOGERROR, "plugin ".$code->{name}
                        ." running the $hook hook returned undef!")
--- ../qpsmtpd/plugins/timeout	1970-01-01 01:00:00.000000000 +0100
+++ plugins/timeout	2008-06-04 07:56:42.000000000 +0200
@@ -0,0 +1,62 @@
+
+=head1 NAME
+
+timeout - set timeouts for plugin hooks
+
+=head1 DESCRIPTION
+
+The B<timeout> plugin can be used to set timeouts for a plugin's hook. This
+may be useful if some plugins are known to take a long time...
+
+If a plugin runs longer than the given time, it's execution will be stopped. 
+Note that this will not clear any open filehandles, so be prepared to check
+in the next possible hook to see if something is left:
+
+  sub hook_queue_pre {
+    my ($self, $transaction) = @_; 
+    my $to = $transaction->notes('plugin_timeouts') || {};
+    if ($to->{$self->plugin_name}->{'data_post'}) {
+      # ... cleanup
+    }
+    return (DECLINED);
+  }
+
+=head1 CONFIGURATION
+
+The C<plugin_timeouts> config file contains three values per line: plugin name,
+hook name and the timeout in seconds. The plugin name B<must> be in the form
+like C<$self-E<gt>plugin_name> returns it, the hook name is the one from 
+C<Qpsmtpd::Plugin>'s C<@hooks> (i.e. not translated to sub routine name). The
+value may be any postitive integer.
+
+No timeout can be applied to the C<config> and C<logging> hooks.
+
+=head1 EXAMPLE
+ 
+ # plugin          hook          timeout in seconds
+ spamassassin      data_post     10    
+ virus::clamdscan  data_post     10
+
+=cut
+
+my %timeout = ();
+
+sub register {
+    my ($self, $qp, @args) = @_;
+    foreach ($self->qp->config("plugin_timeouts")) {
+    	s/^\s*//;
+    	s/\s*$//;
+	my ($plugin, $hook, $value) = split /\s+/, $_, 3;
+	die "invalid line $_" unless defined $value;
+       die "not a valid timeout: $value" unless $value =~ /^\d+$/;
+	$timeout{$plugin}->{$hook} = [$value];
+    }
+}
+
+sub hook_config {
+    my ($self, $transaction, $name) = @_;
+    my ($plugin, $hook) = split /\//, $name, 2;
+    return (DECLINED) unless $hook;
+    return (DECLINED) unless exists $timeout{$plugin}->{$hook};
+    return (OK, @{$timeout{$plugin}->{$hook}});
+}