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