Question

如何在Perl子例程调用上设置时间限制（应用超时处理）？如果它运行的时间太长，我想取消子程序。子例程可以调用C库（例如，基于C的数据库驱动程序），这意味着需要特殊处理。此外，SIGALRM可能已经在使用中，因此我们无法直接使用alarm（）。

Answer 1

以下是我几年前处理此问题的一些工作代码：

our $signal_after_delay= "/path/to/signal_after_delay.pl"; # could be merged into code below

# execute a function call, but abort it if it takes too long to complete
# if a signal other than the default ALRM is given, assume that the function being called uses
# ALRMitself and use the given signal instead; for this case, we fork a child to give us the alternate
# signal at the time of the timeout

sub call_with_timeout {
    my($desc,$fn,$args,$timeout,$verbosity,$sigtouse)= @_;
    return undef unless defined($fn);
    $timeout= 60 unless defined $timeout;
    $verbosity= 1 unless defined $verbosity;
    $sigtouse= 'ALRM' unless defined $sigtouse;
    print "call_with_timeout(",join(',',$desc,$fn,'['.join(',',@{$args}).']',$timeout,$verbosity,$sigtouse),")\n" if $verbosity > 3;

    my @res= ();
    my $start= time();
    my $timeoutpid= undef;
    eval {
        my $sighandler= sub {0 && print "$$: in signal handler for $_[0]\n"; die "$$: $desc timed out with $_[0] after $timeout seconds" };
        if ($sigtouse eq 'ALRM') {
            alarm($timeout);
        } else {
            my $fncallingpid= $$;
            $timeoutpid=fork();
            if ($timeoutpid == 0) { # child
                exec($signal_after_delay,$sigtouse,$fncallingpid,$timeout,$verbosity);
                die "could not exec $signal_after_delay\n";
            }
            # parent
        }
        $SIG{$sigtouse}= $sighandler;

        # on timeout, alarm handler above will execute and we'll fall out of this eval
        # on normal exit, we'll fall out of the bottom of the eval with no error
        print "$desc: starting call\n" if $verbosity > 1;
        UNSAFE_SIGNALS {
            # get signals immediately during this call rather than when Perl thinks it is a good time; this allows us to interrupt C routines such as VMware VIX
            @res= &{$fn}(@{$args});
        };
        print "$desc exited normally: ",join(',',@res),"\n" if $verbosity > 2;
        $SIG{$sigtouse}= 'IGNORE';
        if ($sigtouse eq 'ALRM') {
            alarm(0);
        } else {
            print "$$: canceling signal_after_delay.pl ($timeoutpid)\n" if $verbosity > 2;
            kill 'KILL', $timeoutpid;
        }
    };
    my $elapsed= time()-$start;
    #print "waitpid($timeoutpid)\n" if defined($timeoutpid);
    waitpid($timeoutpid,0) if defined($timeoutpid);
    if ($@) {
        if ($@ =~ /timed out with/) { # we timed out
            print "$@\n";
            return (0);
        } else { # the method call did a die
            # propagate
            $SIG{$sigtouse}= 'IGNORE';
            if ($sigtouse eq 'ALRM') {
                alarm(0);
            } else {
                kill $timeoutpid;     
            }
            die;
        }
    }
    print qq{$desc exited normally [elapsed=$elapsed]\n} if $verbosity;
    return (1,@res);
}

signal_after_delay.pl只是：

#!/usr/bin/perl -w

# send a given signal to a given PID after a given delay

use FileHandle;
STDOUT->autoflush(1);

my($sig,$targetpid,$wait,$verbosity)= @ARGV;
$wait= 60 unless defined($wait);
$verbosity= 1 unless defined($verbosity);

print "$0 ($$): will send SIG$sig to $targetpid after $wait seconds\n" if $verbosity > 1;

my $now= time();
my $end=$now+$wait;
do {
    print "$$: will sleep for ",$end-$now,"\n" if $verbosity > 2;
    sleep($end-$now);
    $now= time();
} while ($now < $end);

print "$$: sending SIG$sig to $targetpid\n" if $verbosity;
kill $sig, $targetpid;

exit(0);

Answer 2

简单的答案是 - 使用alarm :)。然而，由于这不是一个选项，我提供的替代方案是使用一个线程运行您可能想要杀死的代码。

e.g：

#!/usr/bin/perl

use strict;
use warnings;

use threads;

sub my_subroutine_to_timeout {
  $SIG{'USR1'} = sub { print "Got USR1, dying\n"; die };

  my $timeout = rand ( 30 );
  sleep ( $timeout ) ;
  return $timeout; 
}

my $thr = threads -> create ( \&my_subroutine_to_timeout );

sleep 10;
if ( $thr -> is_joinable() ) {
    my $result = $thr -> join(); 
    print "Thread returned before timeout, with $result\n";
}
else { 
    print "Timeout: Killing\n";
    $thr -> kill ( 'SIGUSR1' ); #can trap with a signal handler. 
    $thr -> detach();
}

print "Main program continues, but may not have a result from the thread\n";

以上是说明性的 - 即使它在1s之后完成，也可以保证等待10秒以完成命令。但是有办法解决这个问题。

如何在Perl函数调用上超时

2 个答案: