mtr_timer.pl 4.1 KB
Newer Older
1
# -*- cperl -*-
unknown's avatar
unknown committed
2 3 4 5 6 7 8 9 10 11 12 13 14 15
# 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
16 17 18 19 20 21 22 23 24 25 26 27

# 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 Socket;
use Errno;
use strict;

sub mtr_init_timers ();
sub mtr_timer_start($$$);
sub mtr_timer_stop($$);
28
sub mtr_timer_stop_all($);
unknown's avatar
unknown committed
29

30 31 32

##############################################################################
#
unknown's avatar
unknown committed
33
#  Initiate the structure shared by all timers
34 35 36 37 38 39 40 41 42 43 44 45 46 47
#
##############################################################################

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
unknown's avatar
unknown committed
48
#  implement timers.
49 50 51 52 53 54
#
##############################################################################

sub mtr_timer_start($$$) {
  my ($timers,$name,$duration)= @_;

unknown's avatar
unknown committed
55 56
  mtr_verbose("mtr_timer_start: $name, $duration");

57 58 59
  if ( exists $timers->{'timers'}->{$name} )
  {
    # We have an old running timer, kill it
unknown's avatar
unknown committed
60
    mtr_verbose("There is an old timer running");
61 62 63 64 65 66 67 68 69 70 71
    mtr_timer_stop($timers,$name);
  }

 FORK:
  {
    my $tpid= fork();

    if ( ! defined $tpid )
    {
      if ( $! == $!{EAGAIN} )           # See "perldoc Errno"
      {
unknown's avatar
unknown committed
72
        mtr_warning("Got EAGAIN from fork(), sleep 1 second and redo");
73 74 75 76 77 78 79 80 81 82 83 84
        sleep(1);
        redo FORK;
      }
      else
      {
        mtr_error("can't fork");
      }
    }

    if ( $tpid )
    {
      # Parent, record the information
unknown's avatar
unknown committed
85
      mtr_verbose("timer parent, record info($name, $tpid, $duration)");
86 87 88 89 90 91 92 93
      $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?
94 95 96 97 98 99

      # 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';

100 101 102 103 104
      $SIG{TERM}= sub {
	mtr_verbose("timer woke up, exiting!");
	exit(0);
      };

105 106
      $0= "mtr_timer(timers,$name,$duration)";
      sleep($duration);
107
      mtr_verbose("timer expired after $duration seconds");
108 109 110 111 112 113 114 115 116
      exit(0);
    }
  }
}


sub mtr_timer_stop ($$) {
  my ($timers,$name)= @_;

unknown's avatar
unknown committed
117 118
  mtr_verbose("mtr_timer_stop: $name");

119 120 121
  if ( exists $timers->{'timers'}->{$name} )
  {
    my $tpid= $timers->{'timers'}->{$name}->{'pid'};
unknown's avatar
unknown committed
122
    mtr_verbose("Stopping timer with pid $tpid");
123 124 125

    # FIXME as Cygwin reuses pids fast, maybe check that is
    # the expected process somehow?!
126
    kill(15, $tpid);
127 128 129 130 131 132 133 134 135 136 137 138

    # 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
  {
unknown's avatar
unknown committed
139
    mtr_error("Asked to stop timer \"$name\" not started");
140 141 142 143 144
    return 0;
  }
}


145 146 147 148 149 150 151 152 153 154 155
sub mtr_timer_stop_all ($) {
  my $timers= shift;

  foreach my $name ( keys %{$timers->{'timers'}} )
  {
    mtr_timer_stop($timers, $name);
  }
  return 1;
}


156 157 158 159 160
sub mtr_timer_timeout ($$) {
  my ($timers,$pid)= @_;

  return "" unless exists $timers->{'pids'}->{$pid};

161 162
  # We got a timeout, return the name ot the timer
  return $timers->{'pids'}->{$pid};
163 164 165
}

1;