summaryrefslogtreecommitdiffstats
path: root/mysql-test/lib/My/SafeProcess.pm
diff options
context:
space:
mode:
Diffstat (limited to 'mysql-test/lib/My/SafeProcess.pm')
-rw-r--r--mysql-test/lib/My/SafeProcess.pm640
1 files changed, 640 insertions, 0 deletions
diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm
new file mode 100644
index 00000000..e3b46b37
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess.pm
@@ -0,0 +1,640 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2009, 2011 Monty Program Ab
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library 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
+# Library 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-1335 USA
+
+package My::SafeProcess;
+
+#
+# Class that encapsulates process creation, monitoring and cleanup
+#
+# Spawns a monitor process which spawns a new process locally or
+# remote using subclasses My::Process::Local or My::Process::Remote etc.
+#
+# The monitor process runs a simple event loop more or less just
+# waiting for a reason to zap the process it monitors. Thus the user
+# of this class does not need to care about process cleanup, it's
+# handled automatically.
+#
+# The monitor process wait for:
+# - the parent process to close the pipe, in that case it
+# will zap the "monitored process" and exit
+# - the "monitored process" to exit, in which case it will exit
+# itself with same exit code as the "monitored process"
+# - the parent process to send the "shutdown" signal in which case
+# monitor will kill the "monitored process" hard and exit
+#
+#
+# When used it will look something like this:
+# $> ps
+# [script.pl]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+#
+#
+
+use strict;
+use Carp;
+use POSIX qw(WNOHANG);
+
+use My::SafeProcess::Base;
+use base 'My::SafeProcess::Base';
+
+use My::Find;
+use My::Platform;
+
+my %running;
+my $_verbose= 0;
+my $start_exit= 0;
+
+END {
+ # Kill any children still running
+ for my $proc (values %running){
+ if ( $proc->is_child($$) and ! $start_exit){
+ #print "Killing: $proc\n";
+ if ($proc->wait_one(0)){
+ $proc->kill();
+ }
+ }
+ }
+}
+
+
+sub is_child {
+ my ($self, $parent_pid)= @_;
+ croak "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self);
+ return ($self->{PARENT} == $parent_pid);
+}
+
+
+our @safe_process_cmd;
+my $safe_kill;
+my $bindir;
+
+if(defined $ENV{MTR_BINDIR})
+{
+ # This is an out-of-source build. Build directory
+ # is given in MTR_BINDIR env.variable
+ $bindir = $ENV{MTR_BINDIR}."/mysql-test";
+}
+else
+{
+ use Cwd;
+ $bindir = getcwd();
+}
+
+# Find the safe process binary or script
+sub find_bin {
+ if (IS_WINDOWS)
+ {
+ # Use my_safe_process.exe
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+
+ # Use my_safe_kill.exe
+ $safe_kill= my_find_bin($bindir, "lib/My/SafeProcess", "my_safe_kill");
+ }
+ else
+ {
+ # Use my_safe_process
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+ }
+}
+
+
+sub new {
+ my $class= shift;
+
+ my %opts=
+ (
+ verbose => 0,
+ @_
+ );
+
+ my $path = delete($opts{'path'}) or croak "path required @_";
+ my $args = delete($opts{'args'}) or croak "args required @_";
+ my $input = delete($opts{'input'});
+ my $output = delete($opts{'output'});
+ my $error = delete($opts{'error'});
+ my $verbose = delete($opts{'verbose'}) || $::opt_verbose;
+ my $nocore = delete($opts{'nocore'});
+ my $host = delete($opts{'host'});
+ my $shutdown = delete($opts{'shutdown'});
+ my $user_data= delete($opts{'user_data'});
+ my $envs = delete($opts{'envs'});
+
+# if (defined $host) {
+# $safe_script= "lib/My/SafeProcess/safe_process_cpcd.pl";
+# }
+
+ if (IS_CYGWIN){
+ $path= mixed_path($path);
+ $input= mixed_path($input);
+ $output= mixed_path($output);
+ $error= mixed_path($error);
+ }
+
+ my @safe_args;
+ my ($safe_path, $safe_script)= @safe_process_cmd;
+ push(@safe_args, $safe_script) if defined $safe_script;
+
+ push(@safe_args, "--verbose") if $verbose > 0;
+ push(@safe_args, "--nocore") if $nocore;
+
+ # Point the safe_process at the right parent if running on cygwin
+ push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN;
+
+ foreach my $env_var (@$envs) {
+ croak("Missing = in env string") unless $env_var =~ /=/;
+ croak("Env string $env_var seen, probably missing value for --mysqld-env")
+ if $env_var =~ /^--/;
+ push @safe_args, "--env $env_var";
+ }
+
+ push(@safe_args, "--");
+ push(@safe_args, $path); # The program safe_process should execute
+
+ if ($start_exit) { # Bypass safe_process instead, start program directly
+ @safe_args= ();
+ $safe_path= $path;
+ }
+ push(@safe_args, @$$args);
+
+ print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n"
+ if $verbose > 1;
+
+ my $pid= create_process(
+ path => $safe_path,
+ input => $input,
+ output => $output,
+ error => $error,
+ append => $opts{append},
+ args => \@safe_args,
+ );
+
+ my $name = delete($opts{'name'}) || "SafeProcess$pid";
+ my $proc= bless
+ ({
+ SAFE_PID => $pid,
+ SAFE_WINPID => $pid, # Inidicates this is always a real process
+ SAFE_NAME => $name,
+ SAFE_SHUTDOWN => $shutdown,
+ PARENT => $$,
+ SAFE_USER_DATA => $user_data,
+ }, $class);
+
+ # Put the new process in list of running
+ $running{$pid}= $proc;
+ return $proc;
+
+}
+
+
+sub run {
+ my $proc= new(@_);
+ $proc->wait_one();
+ return $proc->exit_status();
+}
+
+#
+# Shutdown process nicely, and wait for shutdown_timeout seconds
+# If processes hasn't shutdown, kill them hard and wait for return
+#
+sub shutdown {
+ my $shutdown_timeout= shift;
+ my @processes= @_;
+ _verbose("shutdown, timeout: $shutdown_timeout, @processes");
+
+ return if (@processes == 0);
+
+ # Call shutdown function if process has one, else
+ # use kill
+ foreach my $proc (@processes){
+ _verbose(" proc: $proc");
+ my $shutdown= $proc->{SAFE_SHUTDOWN};
+ if ($shutdown_timeout > 0 and defined $shutdown){
+ $shutdown->();
+ $proc->{WAS_SHUTDOWN}= 1;
+ }
+ else {
+ $proc->start_kill();
+ }
+ }
+
+ my @kill_processes= ();
+
+ # Wait max shutdown_timeout seconds for those process
+ # that has been shutdown
+ foreach my $proc (@processes){
+ next unless $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one($shutdown_timeout);
+ if ($ret != 0) {
+ push(@kill_processes, $proc);
+ }
+ # Only wait for the first process with shutdown timeout
+ $shutdown_timeout= 0;
+ }
+
+ # Wait infinitely for those process
+ # that has been killed
+ foreach my $proc (@processes){
+ next if $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one(undef);
+ if ($ret != 0) {
+ warn "Wait for killed process failed!";
+ push(@kill_processes, $proc);
+ # Try one more time, best option...
+ }
+ }
+
+ # Return if all servers has exited
+ return if (@kill_processes == 0);
+
+ foreach my $proc (@kill_processes){
+ $proc->start_kill();
+ }
+
+ foreach my $proc (@kill_processes){
+ $proc->wait_one(undef);
+ }
+
+ return;
+}
+
+
+sub _winpid ($) {
+ my ($pid)= @_;
+
+ # In win32 perl, the pid is already the winpid
+ return $pid unless IS_CYGWIN;
+
+ # In cygwin, the pid is the pseudo process ->
+ # get the real winpid of my_safe_process
+ return Cygwin::pid_to_winpid($pid);
+}
+
+
+#
+# Tell the process to die as fast as possible
+#
+sub start_kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self);
+ _verbose("start_kill: $self");
+ my $ret= 1;
+
+ my $pid= $self->{SAFE_PID};
+ die "INTERNAL ERROR: no pid" unless defined $pid;
+
+ if (IS_WINDOWS and defined $self->{SAFE_WINPID})
+ {
+ die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill;
+
+ my $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+
+ if ($ret == 3){
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, try one more time\n";
+ sleep(1);
+ $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, continue and see what happens...\n";
+ }
+ }
+ else
+ {
+ $pid= $self->{SAFE_PID};
+ die "Can't kill not started process" unless defined $pid;
+ $ret= kill("TERM", $pid);
+ }
+
+ return $ret;
+}
+
+
+sub dump_core {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ die "Can't get core from not started process" unless defined $pid;
+
+ if (IS_WINDOWS) {
+ system("$safe_kill $pid dump");
+ return 1;
+ }
+
+ _verbose("Sending ABRT to $self");
+ kill ("ABRT", $pid);
+ return 1;
+}
+
+
+#
+# Kill the process as fast as possible
+# and wait for it to return
+#
+sub kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self);
+
+ $self->start_kill();
+ $self->wait_one();
+ return 1;
+}
+
+
+sub _collect {
+ my ($self, $exit_code)= @_;
+
+ $self->{EXIT_STATUS}= $exit_code;
+ _verbose("_collect: $self");
+
+ # Take the process out of running list
+ my $pid= $self->{SAFE_PID};
+ die unless delete($running{$pid});
+}
+
+
+# Wait for process to exit
+# optionally with a timeout
+#
+# timeout
+# undef -> wait blocking infinitely
+# 0 -> just poll with WNOHANG
+# >0 -> wait blocking for max timeout seconds
+#
+# RETURN VALUES
+# 0 Not running
+# 1 Still running
+#
+sub wait_one {
+ my ($self, $timeout, $keep)= @_;
+ croak "usage: \$safe_proc->wait_one([timeout] [, keep])" unless ref $self;
+
+ _verbose("wait_one $self, $timeout, $keep");
+
+ if ( ! defined($self->{SAFE_PID}) ) {
+ # No pid => not running
+ _verbose("No pid => not running");
+ return 0;
+ }
+
+ if ( defined $self->{EXIT_STATUS} ) {
+ # Exit status already set => not running
+ _verbose("Exit status already set => not running");
+ return 0;
+ }
+
+ my $pid= $self->{SAFE_PID};
+
+ my $use_alarm;
+ my $blocking;
+ if (defined $timeout)
+ {
+ if ($timeout == 0)
+ {
+ # 0 -> just poll with WNOHANG
+ $blocking= 0;
+ $use_alarm= 0;
+ }
+ else
+ {
+ # >0 -> wait blocking for max timeout seconds
+ $blocking= 1;
+ $use_alarm= 1;
+ }
+ }
+ else
+ {
+ # undef -> wait blocking infinitely
+ $blocking= 1;
+ $use_alarm= 0;
+ }
+ #_verbose("blocking: $blocking, use_alarm: $use_alarm");
+
+ my $retpid;
+ my $exit_code;
+ eval
+ {
+ # alarm should break the wait
+ local $SIG{ALRM}= sub { die "waitpid timeout"; };
+
+ alarm($timeout) if $use_alarm;
+
+ $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG);
+ $exit_code= $?;
+
+ alarm(0) if $use_alarm;
+ };
+
+ if ($@)
+ {
+ die "Got unexpected: $@" if ($@ !~ /waitpid timeout/);
+ if (!defined $retpid) {
+ # Got timeout
+ _verbose("Got timeout");
+ return 1;
+ }
+ # Got pid _and_ alarm, continue
+ _verbose("Got pid and alarm, continue");
+ }
+
+ if ( $retpid == 0 ) {
+ # 0 => still running
+ _verbose("0 => still running");
+ return 1;
+ }
+
+ #if ( not $blocking and $retpid == -1 ) {
+ # # still running
+ # _verbose("still running");
+ # return 1;
+ #}
+
+ #warn "wait_one: expected pid $pid but got $retpid"
+ # unless( $retpid == $pid );
+
+ $self->_collect($exit_code) unless $keep;
+ return 0;
+}
+
+
+#
+# Wait for any process to exit
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub wait_any {
+ my $ret_pid;
+ my $exit_code;
+
+ if (IS_WIN32PERL) {
+ # Can't wait for -1 => use a polling loop
+ do {
+ Win32::Sleep(10); # 10 milli seconds
+ foreach my $pid (keys %running){
+ $ret_pid= waitpid($pid, &WNOHANG);
+ last if $pid == $ret_pid;
+ }
+ } while ($ret_pid == 0);
+ $exit_code= $?;
+ }
+ else
+ {
+ $ret_pid= waitpid(-1, 0);
+ if ($ret_pid <= 0){
+ # No more processes to wait for
+ print STDERR "wait_any, got invalid pid: $ret_pid\n";
+ return undef;
+ }
+ $exit_code= $?;
+ }
+
+ # Look it up in "running" table
+ my $proc= $running{$ret_pid};
+ unless (defined $proc){
+ print STDERR "Could not find pid: $ret_pid in running list\n";
+ print STDERR "running: ". join(", ", keys(%running)). "\n";
+ return undef;
+ }
+ $proc->_collect($exit_code);
+ return $proc;
+}
+
+
+#
+# Wait for any process to exit, or a timeout
+#
+# Returns a reference to the SafeProcess that
+# exited or a pseudo-process with $proc->{timeout} == 1
+#
+
+sub wait_any_timeout {
+ my $class= shift;
+ my $timeout= shift;
+ my $proc;
+ my $millis=10;
+
+ do {
+ ::mtr_milli_sleep($millis);
+ # Slowly increse interval up to max. 1 second
+ $millis++ if $millis < 1000;
+ # Return a "fake" process for timeout
+ if (::has_expired($timeout)) {
+ $proc= bless
+ ({
+ SAFE_PID => 0,
+ SAFE_NAME => "timer",
+ timeout => 1,
+ }, $class);
+ } else {
+ $proc= check_any();
+ }
+ } while (! $proc);
+
+ return $proc;
+}
+
+
+#
+# Wait for all processes to exit
+#
+sub wait_all {
+ while(keys %running)
+ {
+ wait_any();
+ }
+}
+
+#
+# Set global flag to tell all safe_process to exit after starting child
+#
+
+sub start_exit {
+ $start_exit= 1;
+}
+
+#
+# Check if any process has exited, but don't wait.
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub check_any {
+ for my $proc (values %running){
+ if ( $proc->is_child($$) ) {
+ if (not $proc->wait_one(0)) {
+ _verbose ("Found exited $proc");
+ return $proc;
+ }
+ }
+ }
+ return undef;
+}
+
+
+# Overload string operator
+# and fallback to default functions if no
+# overloaded function is found
+#
+use overload
+ '""' => \&self2str,
+ fallback => 1;
+
+
+#
+# Return the process as a nicely formatted string
+#
+sub self2str {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ my $winpid= $self->{SAFE_WINPID};
+ my $name= $self->{SAFE_NAME};
+ my $exit_status= $self->{EXIT_STATUS};
+
+ my $str= "[$name - pid: $pid";
+ $str.= ", winpid: $winpid" if defined $winpid;
+ $str.= ", exit: $exit_status" if defined $exit_status;
+ $str.= "]";
+}
+
+sub _verbose {
+ return unless $_verbose;
+ print STDERR " ## @_\n";
+}
+
+
+sub pid {
+ my ($self)= @_;
+ return $self->{SAFE_PID};
+}
+
+sub user_data {
+ my ($self)= @_;
+ return $self->{SAFE_USER_DATA};
+}
+
+
+1;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-24 02:02:14 +0000