1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
# -*- cperl -*-
# This is a library file used by the Perl version of mysql-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.
use Carp qw(cluck);
use Socket;
use Errno;
use strict;
#use POSIX ":sys_wait_h";
use POSIX 'WNOHANG';
sub mtr_init_timers ();
sub mtr_timer_start($$$);
sub mtr_timer_stop($$);
sub mtr_timer_stop_all($);
sub mtr_timer_waitpid($$$);
##############################################################################
#
# Initiate a structure shared by all timers
#
##############################################################################
sub mtr_init_timers () {
my $timers = { timers => {}, pids => {}};
return $timers;
}
##############################################################################
#
# Start, stop and poll a timer
#
# As alarm() isn't portable to Windows, we use separate processes to
# implement timers. That is why there is a mtr_timer_waitpid(), as this
# is where we catch a timeout.
#
##############################################################################
sub mtr_timer_start($$$) {
my ($timers,$name,$duration)= @_;
if ( exists $timers->{'timers'}->{$name} )
{
# We have an old running timer, kill it
mtr_timer_stop($timers,$name);
}
FORK:
{
my $tpid= fork();
if ( ! defined $tpid )
{
if ( $! == $!{EAGAIN} ) # See "perldoc Errno"
{
mtr_debug("Got EAGAIN from fork(), sleep 1 second and redo");
sleep(1);
redo FORK;
}
else
{
mtr_error("can't fork");
}
}
if ( $tpid )
{
# Parent, record the information
$timers->{'timers'}->{$name}->{'pid'}= $tpid;
$timers->{'timers'}->{$name}->{'duration'}= $duration;
$timers->{'pids'}->{$tpid}= $name;
}
else
{
# Child, redirect output and exec
# FIXME do we need to redirect streams?
# Don't do the ^C cleanup in the timeout child processes!
# There is actually a race here, if we get ^C after fork(), but before
# clearing the signal handler.
$SIG{INT}= 'DEFAULT';
$0= "mtr_timer(timers,$name,$duration)";
sleep($duration);
exit(0);
}
}
}
sub mtr_timer_stop ($$) {
my ($timers,$name)= @_;
if ( exists $timers->{'timers'}->{$name} )
{
my $tpid= $timers->{'timers'}->{$name}->{'pid'};
# FIXME as Cygwin reuses pids fast, maybe check that is
# the expected process somehow?!
kill(9, $tpid);
# As the timers are so simple programs, we trust them to terminate,
# and use blocking wait for it. We wait just to avoid a zombie.
waitpid($tpid,0);
delete $timers->{'timers'}->{$name}; # Remove the timer information
delete $timers->{'pids'}->{$tpid}; # and PID reference
return 1;
}
else
{
mtr_debug("Asked to stop timer \"$name\" not started");
return 0;
}
}
sub mtr_timer_stop_all ($) {
my $timers= shift;
foreach my $name ( keys %{$timers->{'timers'}} )
{
mtr_timer_stop($timers, $name);
}
return 1;
}
sub mtr_timer_timeout ($$) {
my ($timers,$pid)= @_;
return "" unless exists $timers->{'pids'}->{$pid};
# We got a timeout
my $name= $timers->{'pids'}->{$pid};
mtr_timer_stop($timers, $timers->{'timers'}->{$name});
return $name;
}
1;
|
