1# -*- cperl -*- 2# Copyright (c) 2007, 2011, Oracle and/or its affiliates. 3# Copyright (c) 2009, 2011 Monty Program Ab 4# 5# This program is free software; you can redistribute it and/or 6# modify it under the terms of the GNU Library General Public 7# License as published by the Free Software Foundation; version 2 8# of the License. 9# 10# This program is distributed in the hope that it will be useful, 11# but WITHOUT ANY WARRANTY; without even the implied warranty of 12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13# Library General Public License for more details. 14# 15# You should have received a copy of the GNU General Public License 16# along with this program; if not, write to the Free Software 17# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA 18 19package My::SafeProcess; 20 21# 22# Class that encapsulates process creation, monitoring and cleanup 23# 24# Spawns a monitor process which spawns a new process locally or 25# remote using subclasses My::Process::Local or My::Process::Remote etc. 26# 27# The monitor process runs a simple event loop more or less just 28# waiting for a reason to zap the process it monitors. Thus the user 29# of this class does not need to care about process cleanup, it's 30# handled automatically. 31# 32# The monitor process wait for: 33# - the parent process to close the pipe, in that case it 34# will zap the "monitored process" and exit 35# - the "monitored process" to exit, in which case it will exit 36# itself with same exit code as the "monitored process" 37# - the parent process to send the "shutdown" signal in which case 38# monitor will kill the "monitored process" hard and exit 39# 40# 41# When used it will look something like this: 42# $> ps 43# [script.pl] 44# - [monitor for `mysqld`] 45# - [mysqld] 46# - [monitor for `mysqld`] 47# - [mysqld] 48# - [monitor for `mysqld`] 49# - [mysqld] 50# 51# 52 53use strict; 54use Carp; 55use POSIX qw(WNOHANG); 56 57use My::SafeProcess::Base; 58use base 'My::SafeProcess::Base'; 59 60use My::Find; 61use My::Platform; 62 63my %running; 64my $_verbose= 0; 65my $start_exit= 0; 66 67END { 68 # Kill any children still running 69 for my $proc (values %running){ 70 if ( $proc->is_child($$) and ! $start_exit){ 71 #print "Killing: $proc\n"; 72 if ($proc->wait_one(0)){ 73 $proc->kill(); 74 } 75 } 76 } 77} 78 79 80sub is_child { 81 my ($self, $parent_pid)= @_; 82 croak "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self); 83 return ($self->{PARENT} == $parent_pid); 84} 85 86 87our @safe_process_cmd; 88my $safe_kill; 89my $bindir; 90 91if(defined $ENV{MTR_BINDIR}) 92{ 93 # This is an out-of-source build. Build directory 94 # is given in MTR_BINDIR env.variable 95 $bindir = $ENV{MTR_BINDIR}."/mysql-test"; 96} 97else 98{ 99 use Cwd; 100 $bindir = getcwd(); 101} 102 103# Find the safe process binary or script 104sub find_bin { 105 if (IS_WIN32PERL or IS_CYGWIN) 106 { 107 # Use my_safe_process.exe 108 my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"], 109 "my_safe_process"); 110 push(@safe_process_cmd, $exe); 111 112 # Use my_safe_kill.exe 113 $safe_kill= my_find_bin($bindir, "lib/My/SafeProcess", "my_safe_kill"); 114 } 115 else 116 { 117 # Use my_safe_process 118 my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"], 119 "my_safe_process"); 120 push(@safe_process_cmd, $exe); 121 } 122} 123 124 125sub new { 126 my $class= shift; 127 128 my %opts= 129 ( 130 verbose => 0, 131 @_ 132 ); 133 134 my $path = delete($opts{'path'}) or croak "path required @_"; 135 my $args = delete($opts{'args'}) or croak "args required @_"; 136 my $input = delete($opts{'input'}); 137 my $output = delete($opts{'output'}); 138 my $error = delete($opts{'error'}); 139 my $verbose = delete($opts{'verbose'}) || $::opt_verbose; 140 my $nocore = delete($opts{'nocore'}); 141 my $host = delete($opts{'host'}); 142 my $shutdown = delete($opts{'shutdown'}); 143 my $user_data= delete($opts{'user_data'}); 144 my $envs = delete($opts{'envs'}); 145 146# if (defined $host) { 147# $safe_script= "lib/My/SafeProcess/safe_process_cpcd.pl"; 148# } 149 150 if (IS_CYGWIN){ 151 $path= mixed_path($path); 152 $input= mixed_path($input); 153 $output= mixed_path($output); 154 $error= mixed_path($error); 155 } 156 157 my @safe_args; 158 my ($safe_path, $safe_script)= @safe_process_cmd; 159 push(@safe_args, $safe_script) if defined $safe_script; 160 161 push(@safe_args, "--verbose") if $verbose > 0; 162 push(@safe_args, "--nocore") if $nocore; 163 164 # Point the safe_process at the right parent if running on cygwin 165 push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN; 166 167 foreach my $env_var (@$envs) { 168 croak("Missing = in env string") unless $env_var =~ /=/; 169 croak("Env string $env_var seen, probably missing value for --mysqld-env") 170 if $env_var =~ /^--/; 171 push @safe_args, "--env $env_var"; 172 } 173 174 push(@safe_args, "--"); 175 push(@safe_args, $path); # The program safe_process should execute 176 177 if ($start_exit) { # Bypass safe_process instead, start program directly 178 @safe_args= (); 179 $safe_path= $path; 180 } 181 push(@safe_args, @$$args); 182 183 print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n" 184 if $verbose > 1; 185 186 my $pid= create_process( 187 path => $safe_path, 188 input => $input, 189 output => $output, 190 error => $error, 191 append => $opts{append}, 192 args => \@safe_args, 193 ); 194 195 my $name = delete($opts{'name'}) || "SafeProcess$pid"; 196 my $proc= bless 197 ({ 198 SAFE_PID => $pid, 199 SAFE_WINPID => $pid, # Inidicates this is always a real process 200 SAFE_NAME => $name, 201 SAFE_SHUTDOWN => $shutdown, 202 PARENT => $$, 203 SAFE_USER_DATA => $user_data, 204 }, $class); 205 206 # Put the new process in list of running 207 $running{$pid}= $proc; 208 return $proc; 209 210} 211 212 213sub run { 214 my $proc= new(@_); 215 $proc->wait_one(); 216 return $proc->exit_status(); 217} 218 219# 220# Shutdown process nicely, and wait for shutdown_timeout seconds 221# If processes hasn't shutdown, kill them hard and wait for return 222# 223sub shutdown { 224 my $shutdown_timeout= shift; 225 my @processes= @_; 226 _verbose("shutdown, timeout: $shutdown_timeout, @processes"); 227 228 return if (@processes == 0); 229 230 # Call shutdown function if process has one, else 231 # use kill 232 foreach my $proc (@processes){ 233 _verbose(" proc: $proc"); 234 my $shutdown= $proc->{SAFE_SHUTDOWN}; 235 if ($shutdown_timeout > 0 and defined $shutdown){ 236 $shutdown->(); 237 $proc->{WAS_SHUTDOWN}= 1; 238 } 239 else { 240 $proc->start_kill(); 241 } 242 } 243 244 my @kill_processes= (); 245 246 # Wait max shutdown_timeout seconds for those process 247 # that has been shutdown 248 foreach my $proc (@processes){ 249 next unless $proc->{WAS_SHUTDOWN}; 250 my $ret= $proc->wait_one($shutdown_timeout); 251 if ($ret != 0) { 252 push(@kill_processes, $proc); 253 } 254 # Only wait for the first process with shutdown timeout 255 $shutdown_timeout= 0; 256 } 257 258 # Wait infinitely for those process 259 # that has been killed 260 foreach my $proc (@processes){ 261 next if $proc->{WAS_SHUTDOWN}; 262 my $ret= $proc->wait_one(undef); 263 if ($ret != 0) { 264 warn "Wait for killed process failed!"; 265 push(@kill_processes, $proc); 266 # Try one more time, best option... 267 } 268 } 269 270 # Return if all servers has exited 271 return if (@kill_processes == 0); 272 273 foreach my $proc (@kill_processes){ 274 $proc->start_kill(); 275 } 276 277 foreach my $proc (@kill_processes){ 278 $proc->wait_one(undef); 279 } 280 281 return; 282} 283 284 285sub _winpid ($) { 286 my ($pid)= @_; 287 288 # In win32 perl, the pid is already the winpid 289 return $pid unless IS_CYGWIN; 290 291 # In cygwin, the pid is the pseudo process -> 292 # get the real winpid of my_safe_process 293 return Cygwin::pid_to_winpid($pid); 294} 295 296 297# 298# Tell the process to die as fast as possible 299# 300sub start_kill { 301 my ($self)= @_; 302 croak "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self); 303 _verbose("start_kill: $self"); 304 my $ret= 1; 305 306 my $pid= $self->{SAFE_PID}; 307 die "INTERNAL ERROR: no pid" unless defined $pid; 308 309 if (IS_WINDOWS and defined $self->{SAFE_WINPID}) 310 { 311 die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill; 312 313 my $winpid= _winpid($pid); 314 $ret= system($safe_kill, $winpid) >> 8; 315 316 if ($ret == 3){ 317 print "Couldn't open the winpid: $winpid ". 318 "for pid: $pid, try one more time\n"; 319 sleep(1); 320 $winpid= _winpid($pid); 321 $ret= system($safe_kill, $winpid) >> 8; 322 print "Couldn't open the winpid: $winpid ". 323 "for pid: $pid, continue and see what happens...\n"; 324 } 325 } 326 else 327 { 328 $pid= $self->{SAFE_PID}; 329 die "Can't kill not started process" unless defined $pid; 330 $ret= kill("TERM", $pid); 331 } 332 333 return $ret; 334} 335 336 337sub dump_core { 338 my ($self)= @_; 339 my $pid= $self->{SAFE_PID}; 340 die "Can't get core from not started process" unless defined $pid; 341 342 if (IS_WINDOWS) { 343 system("$safe_kill $pid dump"); 344 return 1; 345 } 346 347 _verbose("Sending ABRT to $self"); 348 kill ("ABRT", $pid); 349 return 1; 350} 351 352 353# 354# Kill the process as fast as possible 355# and wait for it to return 356# 357sub kill { 358 my ($self)= @_; 359 croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self); 360 361 $self->start_kill(); 362 $self->wait_one(); 363 return 1; 364} 365 366 367sub _collect { 368 my ($self, $exit_code)= @_; 369 370 $self->{EXIT_STATUS}= $exit_code; 371 _verbose("_collect: $self"); 372 373 # Take the process out of running list 374 my $pid= $self->{SAFE_PID}; 375 die unless delete($running{$pid}); 376} 377 378 379# Wait for process to exit 380# optionally with a timeout 381# 382# timeout 383# undef -> wait blocking infinitely 384# 0 -> just poll with WNOHANG 385# >0 -> wait blocking for max timeout seconds 386# 387# RETURN VALUES 388# 0 Not running 389# 1 Still running 390# 391sub wait_one { 392 my ($self, $timeout, $keep)= @_; 393 croak "usage: \$safe_proc->wait_one([timeout] [, keep])" unless ref $self; 394 395 _verbose("wait_one $self, $timeout, $keep"); 396 397 if ( ! defined($self->{SAFE_PID}) ) { 398 # No pid => not running 399 _verbose("No pid => not running"); 400 return 0; 401 } 402 403 if ( defined $self->{EXIT_STATUS} ) { 404 # Exit status already set => not running 405 _verbose("Exit status already set => not running"); 406 return 0; 407 } 408 409 my $pid= $self->{SAFE_PID}; 410 411 my $use_alarm; 412 my $blocking; 413 if (defined $timeout) 414 { 415 if ($timeout == 0) 416 { 417 # 0 -> just poll with WNOHANG 418 $blocking= 0; 419 $use_alarm= 0; 420 } 421 else 422 { 423 # >0 -> wait blocking for max timeout seconds 424 $blocking= 1; 425 $use_alarm= 1; 426 } 427 } 428 else 429 { 430 # undef -> wait blocking infinitely 431 $blocking= 1; 432 $use_alarm= 0; 433 } 434 #_verbose("blocking: $blocking, use_alarm: $use_alarm"); 435 436 my $retpid; 437 my $exit_code; 438 eval 439 { 440 # alarm should break the wait 441 local $SIG{ALRM}= sub { die "waitpid timeout"; }; 442 443 alarm($timeout) if $use_alarm; 444 445 $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG); 446 $exit_code= $?; 447 448 alarm(0) if $use_alarm; 449 }; 450 451 if ($@) 452 { 453 die "Got unexpected: $@" if ($@ !~ /waitpid timeout/); 454 if (!defined $retpid) { 455 # Got timeout 456 _verbose("Got timeout"); 457 return 1; 458 } 459 # Got pid _and_ alarm, continue 460 _verbose("Got pid and alarm, continue"); 461 } 462 463 if ( $retpid == 0 ) { 464 # 0 => still running 465 _verbose("0 => still running"); 466 return 1; 467 } 468 469 #if ( not $blocking and $retpid == -1 ) { 470 # # still running 471 # _verbose("still running"); 472 # return 1; 473 #} 474 475 #warn "wait_one: expected pid $pid but got $retpid" 476 # unless( $retpid == $pid ); 477 478 $self->_collect($exit_code) unless $keep; 479 return 0; 480} 481 482 483# 484# Wait for any process to exit 485# 486# Returns a reference to the SafeProcess that 487# exited or undefined 488# 489sub wait_any { 490 my $ret_pid; 491 my $exit_code; 492 493 if (IS_WIN32PERL) { 494 # Can't wait for -1 => use a polling loop 495 do { 496 Win32::Sleep(10); # 10 milli seconds 497 foreach my $pid (keys %running){ 498 $ret_pid= waitpid($pid, &WNOHANG); 499 last if $pid == $ret_pid; 500 } 501 } while ($ret_pid == 0); 502 $exit_code= $?; 503 } 504 else 505 { 506 $ret_pid= waitpid(-1, 0); 507 if ($ret_pid <= 0){ 508 # No more processes to wait for 509 print STDERR "wait_any, got invalid pid: $ret_pid\n"; 510 return undef; 511 } 512 $exit_code= $?; 513 } 514 515 # Look it up in "running" table 516 my $proc= $running{$ret_pid}; 517 unless (defined $proc){ 518 print STDERR "Could not find pid: $ret_pid in running list\n"; 519 print STDERR "running: ". join(", ", keys(%running)). "\n"; 520 return undef; 521 } 522 $proc->_collect($exit_code); 523 return $proc; 524} 525 526 527# 528# Wait for any process to exit, or a timeout 529# 530# Returns a reference to the SafeProcess that 531# exited or a pseudo-process with $proc->{timeout} == 1 532# 533 534sub wait_any_timeout { 535 my $class= shift; 536 my $timeout= shift; 537 my $proc; 538 my $millis=10; 539 540 do { 541 ::mtr_milli_sleep($millis); 542 # Slowly increse interval up to max. 1 second 543 $millis++ if $millis < 1000; 544 # Return a "fake" process for timeout 545 if (::has_expired($timeout)) { 546 $proc= bless 547 ({ 548 SAFE_PID => 0, 549 SAFE_NAME => "timer", 550 timeout => 1, 551 }, $class); 552 } else { 553 $proc= check_any(); 554 } 555 } while (! $proc); 556 557 return $proc; 558} 559 560 561# 562# Wait for all processes to exit 563# 564sub wait_all { 565 while(keys %running) 566 { 567 wait_any(); 568 } 569} 570 571# 572# Set global flag to tell all safe_process to exit after starting child 573# 574 575sub start_exit { 576 $start_exit= 1; 577} 578 579# 580# Check if any process has exited, but don't wait. 581# 582# Returns a reference to the SafeProcess that 583# exited or undefined 584# 585sub check_any { 586 for my $proc (values %running){ 587 if ( $proc->is_child($$) ) { 588 if (not $proc->wait_one(0)) { 589 _verbose ("Found exited $proc"); 590 return $proc; 591 } 592 } 593 } 594 return undef; 595} 596 597 598# Overload string operator 599# and fallback to default functions if no 600# overloaded function is found 601# 602use overload 603 '""' => \&self2str, 604 fallback => 1; 605 606 607# 608# Return the process as a nicely formatted string 609# 610sub self2str { 611 my ($self)= @_; 612 my $pid= $self->{SAFE_PID}; 613 my $winpid= $self->{SAFE_WINPID}; 614 my $name= $self->{SAFE_NAME}; 615 my $exit_status= $self->{EXIT_STATUS}; 616 617 my $str= "[$name - pid: $pid"; 618 $str.= ", winpid: $winpid" if defined $winpid; 619 $str.= ", exit: $exit_status" if defined $exit_status; 620 $str.= "]"; 621} 622 623sub _verbose { 624 return unless $_verbose; 625 print STDERR " ## @_\n"; 626} 627 628 629sub pid { 630 my ($self)= @_; 631 return $self->{SAFE_PID}; 632} 633 634sub user_data { 635 my ($self)= @_; 636 return $self->{SAFE_USER_DATA}; 637} 638 639 6401; 641