How can I terminate a system command with alarm in Perl?

Question

I am running the below code snippet on Windows. The server starts listening continuously after reading from client. I want to terminate this command after a time period.

If I use alarm() function call within main.pl, then it terminates the whole Perl program (here main.pl), so I called this system command by placing it in a separate Perl file and calling this Perl file (alarm.pl) in the original Perl File using the system command.

But in this way I was unable to take the output of this system() call neither in the original Perl File nor in called one Perl File.

Could anybody please let me know the way to terminate a system() call or take the output in that way I used above?

main.pl

my @output = system("alarm.pl");
print"one iperf completed\n";

open FILE, ">display.txt" or die $!; 
print FILE @output_1; 
close FILE;

alarm.pl

alarm 30;
my @output_1 = readpipe("adb shell cd /data/app; ./iperf -u -s -p 5001");

open FILE, ">display.txt" or die $!; 
print FILE @output_1; 
close FILE;

In both ways display.txt is always empty.

Answer 1

There are a few separate issues here.

First, to keep the alarm from killing your script, you need to handle the ALRM signal. See the alarm documentation. You shouldn't need two scripts for this.

Second, system doesn't capture output. You need one of the backtick variants or a pipe if you want to do that. There are answers for that on Stackoverflow already.

Third, if alarm.pl puts anything in display.txt, you discard it in main.pl when you re-open the file in write mode. You only need to create the file in one place. When you get rid of the extra script, you won't have this problem.

I recently had some problems with alarm and system, but switching to IPC::System::Simple fixed that.

Good luck, :)

Answer 2

Might use "timeout -n " for wrapping your commands if thats already common on your system.

Answer 3

I tried your way but it did not work:

#! /usr/bin/perl -w

my $command = "iperf.exe -u -s -p 5001 ";

my @output;
eval {
    local $SIG{ALRM} = sub { die "Timeout\n" };
    alarm 20;
    #@output = `$command`;
    #@output = readpipe("iperf.exe -u -c 127.0.0.1 -p 5001 -b 3600k -t 10 -i 1");
    #@output = system("iperf.exe -u -s -p 5001 -i 1");
    #@output = readpipe("iperf.exe -u -s -p 5001 -i 1");
    @output = readpipe($command);

    open FILE, ">display_DL.txt" or die $!; 
    print FILE @output; 
    close FILE;
    alarm 0;
};
if ($@) {
    warn "$command timed out.\n";
} else {
    print "$command successful. Output was:\n", @output;
}




@output = system("iperf.exe -u -s -p 5001 -i 1");

This command works fine as below but as with system command we can't capture the output in a text file which is my aim after the alarm expires

D:\_IOT_SESSION_RELATED\SEEM_ELEMESNTS_AT_COMM_PORT_CONF\Tput_Related_Tools\AUTO
MATION_APP_\AUTOMATION_UTILITY>alarm_test.pl
------------------------------------------------------------
Server listening on UDP port 5001
Receiving 1470 byte datagrams
UDP buffer size: 8.00 KByte (default)
------------------------------------------------------------
[1896] local 127.0.0.1 port 5001 connected with 127.0.0.1 port 4347
[ ID] Interval       Transfer     Bandwidth       Jitter   Lost/Total Datagrams
[1896]  0.0- 1.0 sec   445 KBytes  3.65 Mbits/sec  0.000 ms 1701409391/  310 (5.
5e+008%)
[1896]  1.0- 2.0 sec   441 KBytes  3.61 Mbits/sec  0.000 ms    0/  307 (0%)
[1896]  2.0- 3.0 sec   439 KBytes  3.60 Mbits/sec  0.000 ms    0/  306 (0%)
[1896]  3.0- 4.0 sec   439 KBytes  3.60 Mbits/sec  0.000 ms    0/  306 (0%)
[1896]  0.0- 5.0 sec  2.15 MBytes  3.60 Mbits/sec  0.000 ms    0/ 1532 (0%)
iperf.exe -u -s -p 5001  timed out.

So I tried readpipe() function but again it displayed nothing and also no output in the txt file

@output = readpipe("iperf.exe -u -s -p 5001 -i 1");

Answer 4

I run into a similar problem that requires:

• run a system command and get its output
• time out the system command after x seconds
• kill the system command process and all child processes

After much reading about Perl IPC and manual fork & exec, I came out with this solution. It is implemented as a simulated 'backtick' subroutine.

use Error qw(:try);

$SIG{ALRM} = sub {
    my $sig_name = shift;
    die "Timeout by signal [$sig_name]\n";
};

# example
my $command = "vmstat 1 1000000";
my $output = backtick( 
                 command => $command, 
                 timeout => 60, 
                 verbose => 0 
             );

sub backtick {

    my %arg = (
        command => undef,
        timeout => 900,
        verbose => 1,
        @_,
    );

    my @output;

    defined( my $pid = open( KID, "-|" ) )
        or die "Can't fork: $!\n";

    if ($pid) {

        # parent

        # print "parent: child pid [$pid]\n" if $arg{verbose};

        try {
            alarm( $arg{timeout} );
            while (<KID>) {
                chomp;
                push @output, $_;
            }

            alarm(0);
        }
        catch Error with {
            my $err = shift;
            print $err->{-text} . "\n";

            print "Killing child process [$pid] ...\n" if $arg{verbose};
            kill -9, $pid;
            print "Killed\n" if $arg{verbose};

            alarm(0);
        }
        finally {};
    }
    else {

        # child

        # set the child process to be a group leader, so that
        # kill -9 will kill it and all its descendents
        setpgrp( 0, 0 );

        # print "child: pid [$pid]\n" if $arg{verbose};
        exec $arg{command};
        exit;
    }

    wantarray ? @output : join( "\n", @output );
}