1# -*- cperl -*-
2# Copyright (c) 2005, 2006 MySQL AB, 2008 Sun Microsystems, Inc.
3# Use is subject to license terms.
4#
5# This program is free software; you can redistribute it and/or modify
6# it under the terms of the GNU General Public License as published by
7# the Free Software Foundation; version 2 of the License.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program; if not, write to the Free Software
16# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1335  USA
17
18# This is a library file used by the Perl version of mysql-test-run,
19# and is part of the translation of the Bourne shell script with the
20# same name.
21
22use Errno;
23use strict;
24
25sub mtr_init_timers ();
26sub mtr_timer_start($$$);
27sub mtr_timer_stop($$);
28sub mtr_timer_stop_all($);
29
30
31##############################################################################
32#
33#  Initiate the structure shared by all timers
34#
35##############################################################################
36
37sub mtr_init_timers () {
38  my $timers = { timers => {}, pids => {}};
39  return $timers;
40}
41
42
43##############################################################################
44#
45#  Start, stop and poll a timer
46#
47#  As alarm() isn't portable to Windows, we use separate processes to
48#  implement timers.
49#
50##############################################################################
51
52sub mtr_timer_start($$$) {
53  my ($timers,$name,$duration)= @_;
54
55  if ( exists $timers->{'timers'}->{$name} )
56  {
57    # We have an old running timer, kill it
58    mtr_warning("There is an old timer running");
59    mtr_timer_stop($timers,$name);
60  }
61
62 FORK:
63  {
64    my $tpid= fork();
65
66    if ( ! defined $tpid )
67    {
68      if ( $! == $!{EAGAIN} )           # See "perldoc Errno"
69      {
70        mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
71        sleep(1);
72        redo FORK;
73      }
74      else
75      {
76        mtr_error("can't fork timer, error: $!");
77      }
78    }
79
80    if ( $tpid )
81    {
82      # Parent, record the information
83      mtr_verbose("Starting timer for '$name',",
84		  "duration: $duration, pid: $tpid");
85      $timers->{'timers'}->{$name}->{'pid'}= $tpid;
86      $timers->{'timers'}->{$name}->{'duration'}= $duration;
87      $timers->{'pids'}->{$tpid}= $name;
88    }
89    else
90    {
91      # Child, install signal handlers and sleep for "duration"
92
93      # Don't do the ^C cleanup in the timeout child processes!
94      # There is actually a race here, if we get ^C after fork(), but before
95      # clearing the signal handler.
96      $SIG{INT}= 'DEFAULT';
97
98      $SIG{TERM}= sub {
99	mtr_verbose("timer $$ woke up, exiting!");
100	exit(0);
101      };
102
103      $0= "mtr_timer(timers,$name,$duration)";
104      sleep($duration);
105      mtr_verbose("timer $$ expired after $duration seconds");
106      exit(0);
107    }
108  }
109}
110
111
112sub mtr_timer_stop ($$) {
113  my ($timers,$name)= @_;
114
115  if ( exists $timers->{'timers'}->{$name} )
116  {
117    my $tpid= $timers->{'timers'}->{$name}->{'pid'};
118    mtr_verbose("Stopping timer for '$name' with pid $tpid");
119
120    # FIXME as Cygwin reuses pids fast, maybe check that is
121    # the expected process somehow?!
122    kill(15, $tpid);
123
124    # As the timers are so simple programs, we trust them to terminate,
125    # and use blocking wait for it. We wait just to avoid a zombie.
126    waitpid($tpid,0);
127
128    delete $timers->{'timers'}->{$name}; # Remove the timer information
129    delete $timers->{'pids'}->{$tpid};   # and PID reference
130
131    return 1;
132  }
133
134  mtr_error("Asked to stop timer '$name' not started");
135}
136
137
138sub mtr_timer_stop_all ($) {
139  my $timers= shift;
140
141  foreach my $name ( keys %{$timers->{'timers'}} )
142  {
143    mtr_timer_stop($timers, $name);
144  }
145  return 1;
146}
147
148
149sub mtr_timer_timeout ($$) {
150  my ($timers,$pid)= @_;
151
152  return "" unless exists $timers->{'pids'}->{$pid};
153
154  # Got a timeout(the process with $pid is recorded as being a timer)
155  # return the name of the timer
156  return $timers->{'pids'}->{$pid};
157}
158
1591;
160