From 5c0de23eeee977ebfe2da45adfb8487419fb59c7 Mon Sep 17 00:00:00 2001
From: Martin Whitaker <mageia@martin-whitaker.me.uk>
Date: Sat, 26 Nov 2022 21:04:18 +0000
Subject: run_program: add optional callback when waiting for program to
 terminate

This allows GUI applications to respond to check-alive pings (mga#31105)
---
 perl-install/run_program.pm | 57 +++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 55 insertions(+), 2 deletions(-)

(limited to 'perl-install/run_program.pm')

diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
index f323bace6..5ac4bf972 100644
--- a/perl-install/run_program.pm
+++ b/perl-install/run_program.pm
@@ -7,6 +7,7 @@ use c;
 use MDK::Common;
 use common; # for get_parent_uid()
 use log;
+use Time::HiRes qw(ualarm);
 
 =head1 SYNOPSYS
 
@@ -63,6 +64,30 @@ sub set_default_timeout {
     $default_timeout = $seconds;
 }
 
+my $callback_routine;
+my $callback_interval = 1 * 1000;
+
+=item set_wait_loop_callback($routine, $o_interval)
+
+Sets a callback routine that will be called at regular intervals whilst
+waiting for a program being run in the foreground. Optionally sets the
+interval in milliseconds between callbacks. If not set, the interval is
+1 second.
+
+The callback routine will be passed one argument which is the pid of
+the program being run.
+
+The callback routine should not call sleep() or abort(), as that may
+prevent it being called again.
+
+=cut
+
+sub set_wait_loop_callback {
+    my ($routine, $o_interval) = @_;
+    $callback_routine = $routine;
+    $callback_interval = $o_interval if $o_interval;
+}
+
 =item run_or_die($name, @args)
 
 Runs $name with @args parameterXs. Dies if it exit code is not 0.
@@ -231,19 +256,47 @@ sub raw {
 	} else {
 	    my $ok;
 	    add2hash_($options, { timeout => $default_timeout });
+
+            my $remaining = $options->{timeout} if $options->{timeout} ne 'never';
+            #- We count in milliseconds when using a callback routine.
+            $remaining *= 1000 if $remaining && $callback_routine;
+
+            #- Preserve any pre-existing alarm.
+            my $old_remaining = alarm(0) if $remaining;
+
+            wait_again:
+
 	    eval {
 		local $SIG{ALRM} = sub { die "ALARM" };
-		my $remaining = $options->{timeout} && $options->{timeout} ne 'never' &&  alarm($options->{timeout});
+		if ($callback_routine) {
+                    ualarm($callback_interval * 1000);
+                } elsif ($remaining) {
+                    alarm($remaining);
+                }
 		waitpid $pid, 0;
 		$ok = $? == -1 || ($? >> 8) == 0;
-		alarm $remaining;
+		if ($callback_routine) {
+                    ualarm(0);
+                } elsif ($remaining) {
+                    alarm(0);
+                }
 	    };
 	    if ($@) {
+                if ($@ =~ /^ALARM/ && $callback_routine) {
+                    $callback_routine->($pid);
+                    $remaining -= $callback_interval if $remaining;
+                    goto wait_again if !defined $remaining || $remaining > 0;
+                }
 		log::l("ERROR: killing runaway process (process=$real_name, pid=$pid, args=@args, error=$@)");
 		kill 9, $pid;
+                #- Restore any pre-existing alarm.
+                alarm($old_remaining) if $old_remaining;
 		return;
 	    }
 
+            #- Restore any pre-existing alarm.
+            alarm($old_remaining) if $old_remaining;
+
 	    if ($stdout_raw && ref($stdout_raw)) {	    
 		if (ref($stdout_raw) eq 'ARRAY') { 
 		    @$stdout_raw = cat_($stdout);
-- 
cgit v1.2.1