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