| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Object::Remote::WatchDog; |
|
2
|
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
use Object::Remote::MiniLoop; |
|
4
|
|
|
|
|
|
|
use Object::Remote::Logging qw (:log :dlog router); |
|
5
|
|
|
|
|
|
|
use Moo; |
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
has timeout => ( is => 'ro', required => 1 ); |
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
BEGIN { router()->exclude_forwarding; } |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub instance { |
|
12
|
0
|
|
|
0
|
0
|
|
my ($class, @args) = @_; |
|
13
|
|
|
|
|
|
|
|
|
14
|
0
|
|
0
|
|
|
|
return our $WATCHDOG ||= do { |
|
15
|
0
|
|
|
0
|
|
|
log_trace { "Constructing new instance of global watchdog" }; |
|
|
0
|
|
|
|
|
|
|
|
16
|
0
|
|
|
|
|
|
$class->new(@args); |
|
17
|
|
|
|
|
|
|
}; |
|
18
|
|
|
|
|
|
|
}; |
|
19
|
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
#start the watchdog |
|
21
|
|
|
|
|
|
|
sub BUILD { |
|
22
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$SIG{ALRM} = sub { |
|
25
|
|
|
|
|
|
|
#if the Watchdog is killing the process we don't want any chance of the |
|
26
|
|
|
|
|
|
|
#process not actually exiting and die could be caught by an eval which |
|
27
|
|
|
|
|
|
|
#doesn't do us any good |
|
28
|
0
|
|
|
0
|
|
|
log_fatal { "Watchdog has expired, terminating the process" }; |
|
|
0
|
|
|
|
|
|
|
|
29
|
0
|
|
|
|
|
|
exit(1); |
|
30
|
0
|
|
|
|
|
|
}; |
|
31
|
|
|
|
|
|
|
|
|
32
|
0
|
|
|
0
|
|
|
Dlog_debug { "Initializing watchdog with timeout of $_ seconds" } $self->timeout; |
|
|
0
|
|
|
|
|
|
|
|
33
|
0
|
|
|
|
|
|
alarm($self->timeout); |
|
34
|
|
|
|
|
|
|
} |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#invoke at least once per timeout to stop |
|
37
|
|
|
|
|
|
|
#the watchdog from killing the process |
|
38
|
|
|
|
|
|
|
sub reset { |
|
39
|
0
|
0
|
|
0
|
0
|
|
die "Attempt to reset the watchdog before it was constructed" |
|
40
|
|
|
|
|
|
|
unless defined our $WATCHDOG; |
|
41
|
|
|
|
|
|
|
|
|
42
|
0
|
|
|
0
|
|
|
log_debug { "Watchdog has been reset" }; |
|
|
0
|
|
|
|
|
|
|
|
43
|
0
|
|
|
|
|
|
alarm($WATCHDOG->timeout); |
|
44
|
|
|
|
|
|
|
} |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
#must explicitly call this method to stop the |
|
47
|
|
|
|
|
|
|
#watchdog from killing the process - if the |
|
48
|
|
|
|
|
|
|
#watchdog is lost because it goes out of scope |
|
49
|
|
|
|
|
|
|
#it makes sense to still terminate the process |
|
50
|
|
|
|
|
|
|
sub shutdown { |
|
51
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
|
52
|
0
|
|
|
0
|
|
|
log_debug { "Watchdog is shutting down" }; |
|
|
0
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
|
alarm(0); |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
1; |
|
57
|
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|