2
# Copyright 2004 Apache Software Foundation
4
# Licensed under the Apache License, Version 2.0 (the "License");
5
# you may not use this file except in compliance with the License.
6
# You may obtain a copy of the License at
8
# http://www.apache.org/licenses/LICENSE-2.0
10
# Unless required by applicable law or agreed to in writing, software
11
# distributed under the License is distributed on an "AS IS" BASIS,
12
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13
# See the License for the specific language governing permissions and
14
# limitations under the License.
19
Mail::SpamAssassin::Timeout - safe, reliable timeouts in perl
25
my $t = Mail::SpamAssassin::Timeout->new({ secs => 5 });
28
# code to run with a 5-second timeout...
31
if ($t->timed_out()) {
35
# more non-timeout code...
39
This module provides a safe, reliable and clean API to provide
40
C<alarm(2)>-based timeouts for perl code.
42
Note that C<$SIG{ALRM}> is used to provide the timeout, so this will not
43
interrupt out-of-control regular expression matches.
45
Nested timeouts are supported.
53
package Mail::SpamAssassin::Timeout;
65
###########################################################################
67
=item my $t = Mail::SpamAssassin::Timeout->new({ ... options ... });
69
Constructor. Options include:
73
=item secs => $seconds
75
timeout, in seconds. Optional; if not specified, no timeouts will be applied.
82
my ($class, $opts) = @_;
83
$class = ref($class) || $class;
84
my %selfval = $opts ? %{$opts} : ();
87
bless ($self, $class);
91
###########################################################################
93
=item $t->run($coderef)
95
Run a code reference within the currently-defined timeout.
97
The timeout is as defined by the B<secs> parameter to the constructor.
99
Returns whatever the subroutine returns, or C<undef> on timeout.
100
If the timer times out, C<$t-<gt>timed_out()> will return C<1>.
102
Time elapsed is not cumulative; multiple runs of C<run> will restart the
103
timeout from scratch.
105
=item $t->run_and_catch($coderef)
107
Run a code reference, as per C<$t-<gt>run()>, but also catching any
108
C<die()> calls within the code reference.
110
Returns C<undef> if no C<die()> call was executed and C<$@> was unset, or the
111
value of C<$@> if it was set. (The timeout event doesn't count as a C<die()>.)
115
sub run { $_[0]->_run($_[1], 0); }
117
sub run_and_catch { $_[0]->_run($_[1], 1); }
120
my ($self, $sub, $and_catch) = @_;
122
delete $self->{timed_out};
124
if (!$self->{secs}) { # no timeout! just call the sub and return.
129
if ($self->{secs} < 0) {
130
die "Mail::SpamAssassin::Timeout: oops? neg value for 'secs': $self->{secs}";
136
# bug 4699: under heavy load, an alarm may fire while $@ will contain "",
137
# which isn't very useful. this counter works around it safely, since
138
# it will not require malloc() be called if it fires
142
# note use of local to ensure closed scope here
143
local $SIG{ALRM} = sub { $timedout++; die "__alarm__ignore__\n" };
144
local $SIG{__DIE__}; # bug 4631
146
$oldalarm = alarm($self->{secs});
150
# Unset the alarm() before we leave eval{ } scope, as that stack-pop
151
# operation can take a second or two under load. Note: previous versions
152
# restored $oldalarm here; however, that is NOT what we want to do, since
153
# it creates a new race condition, namely that an old alarm could then fire
154
# while the stack-pop was underway, thereby appearing to be *this* timeout
155
# timing out. In terms of how we might possibly have nested timeouts in
156
# SpamAssassin, this is an academic issue with little impact, but it's
157
# still worth avoiding anyway.
164
if (defined $oldalarm) {
165
# now, we could have died from a SIGALRM == timed out. if so,
166
# restore the previously-active one, or zero all timeouts if none
167
# were previously active.
172
if ($err =~ /__alarm__ignore__/) {
173
$self->{timed_out} = 1;
178
die $@; # propagate any "real" errors
181
} elsif ($timedout) {
182
warn "timeout with empty \$@"; # this is worth complaining about
183
$self->{timed_out} = 1;
193
###########################################################################
195
=item $t->timed_out()
197
Returns C<1> if the most recent code executed in C<run()> timed out, or
198
C<undef> if it did not.
204
return $self->{timed_out};
207
###########################################################################
211
If called within a C<run()> code reference, causes the current alarm timer to
212
be reset to its starting value.
218
alarm($self->{secs});
221
###########################################################################
added
removed
lib/Mail/SpamAssassin/Timeout.pm
