run_program: add helper routine to terminate/kill a process.

1 files changed, 27 insertions, 0 deletions

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)