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
146
147
148
149
150
151
152
153
154
155
156
157
158
|
# -*- cperl -*-
# Copyright (C) 2005-2006 MySQL AB
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
# This is a library file used by the Perl version of drizzle-test-run,
# and is part of the translation of the Bourne shell script with the
# same name.
use Errno;
use strict;
sub dtr_init_timers ();
sub dtr_timer_start($$$);
sub dtr_timer_stop($$);
sub dtr_timer_stop_all($);
##############################################################################
#
# Initiate the structure shared by all timers
#
##############################################################################
sub dtr_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.
#
##############################################################################
sub dtr_timer_start($$$) {
my ($timers,$name,$duration)= @_;
if ( exists $timers->{'timers'}->{$name} )
{
# We have an old running timer, kill it
dtr_warning("There is an old timer running");
dtr_timer_stop($timers,$name);
}
FORK:
{
my $tpid= fork();
if ( ! defined $tpid )
{
if ( $! == $!{EAGAIN} ) # See "perldoc Errno"
{
dtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
sleep(1);
redo FORK;
}
else
{
dtr_error("can't fork timer, error: $!");
}
}
if ( $tpid )
{
# Parent, record the information
dtr_verbose("Starting timer for '$name',",
"duration: $duration, pid: $tpid");
$timers->{'timers'}->{$name}->{'pid'}= $tpid;
$timers->{'timers'}->{$name}->{'duration'}= $duration;
$timers->{'pids'}->{$tpid}= $name;
}
else
{
# Child, install signal handlers and sleep for "duration"
# 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';
$SIG{TERM}= sub {
dtr_verbose("timer $$ woke up, exiting!");
exit(0);
};
$0= "dtr_timer(timers,$name,$duration)";
sleep($duration);
dtr_verbose("timer $$ expired after $duration seconds");
exit(0);
}
}
}
sub dtr_timer_stop ($$) {
my ($timers,$name)= @_;
if ( exists $timers->{'timers'}->{$name} )
{
my $tpid= $timers->{'timers'}->{$name}->{'pid'};
dtr_verbose("Stopping timer for '$name' with pid $tpid");
# FIXME as Cygwin reuses pids fast, maybe check that is
# the expected process somehow?!
kill(15, $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;
}
dtr_error("Asked to stop timer '$name' not started");
}
sub dtr_timer_stop_all ($) {
my $timers= shift;
foreach my $name ( keys %{$timers->{'timers'}} )
{
dtr_timer_stop($timers, $name);
}
return 1;
}
sub dtr_timer_timeout ($$) {
my ($timers,$pid)= @_;
return "" unless exists $timers->{'pids'}->{$pid};
# Got a timeout(the process with $pid is recorded as being a timer)
# return the name of the timer
return $timers->{'pids'}->{$pid};
}
1;
|