diff options
| -rw-r--r-- | perl-install/NEWS | 1 | ||||
| -rw-r--r-- | perl-install/run_program.pm | 27 |
2 files changed, 28 insertions, 0 deletions
diff --git a/perl-install/NEWS b/perl-install/NEWS index cab9f1e85..f01dbb2d4 100644 --- a/perl-install/NEWS +++ b/perl-install/NEWS @@ -1,6 +1,7 @@ - run_program: o add optional callback when waiting for program to terminate * this allows GUI applications to respond to check-alive pings (mga#31105) + o add helper routine to terminate/kill a process - make installer routines for selecting a mirror and downloader available for use by draklive-install - use better algorithm for determining nearest mirror (taken from urpmi) diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm index 5ac4bf972..b3a65d13a 100644 --- a/perl-install/run_program.pm +++ b/perl-install/run_program.pm @@ -368,6 +368,33 @@ sub raw { } +=item terminate($pid, $o_timeout) + +Sends the TERM signal to the process identified by $pid and waits for it +to terminate. If it hasn't terminated in $o_timeout seconds, sends the +KILL signal and returns without waiting. If $o_timeout is not specified, +the default timeout is 5 seconds. If $o_timeout is less than or equal to +zero, the TERM signal is not sent and the process is killed immediately. + +=cut + +sub terminate { + my ($pid, $o_timeout) = @_; + + if (!defined $o_timeout || $o_timeout > 0) { + kill 'TERM', $pid; + eval { + local $SIG{ALRM} = sub { die "ALARM" }; + my $old_remaining = alarm($o_timeout || 5); + waitpid $pid, 0; + alarm($old_remaining); + }; + return if !$@; + log::l("ERROR: killing runaway process (pid=$pid, error=$@)"); + } + kill 'KILL', $pid; +} + package bg_command; =item bg_command::new($class, $sub) |