My pipe (filehandle, socket) breaks (sometimes). I can reproduce it with the following code:
my $counter = 5;
alarm(1);
open(FH,"while(sleep 2); do date; done |") or die $!;
while (<FH>) { print; }
close(FH);
BEGIN {
$SIG{ALRM} = sub {
print "alarm!\n";
exit if --$counter == 0;
alarm(1);
};
}
Which will produce:
alarm!
alarm!
Thu Feb 7 11:46:29 EST 2013
alarm!
alarm!
alarm!
If I strace this process, I see that the spawned shell gets a SIGPIPE. However, the Perl process happily continues. How do I fix this?
The problem is that <FH> is returning false because of an interrupted system call. I am not sure if this is the idiomatic way to handle this in perl (and would love to see a better answer), but the following seems to work:
my $counter = 5;
alarm 1;
open my $fh, '-|', 'while(sleep 2); do date; done' or die $!;
loop:
while (<$fh>) { print; }
goto loop if $!{EINTR};
close $fh;
BEGIN {
$SIG{ALRM} = sub {
print "alarm!\n";
alarm 1;
exit if --$counter <= 0;
};
}
Related
My task is to start a program from perl and keep control flow to the starting task as well as capturing the output of the program in scalar variables. The script should only use perl modules available in perl base package.
My first approach was
use POSIX;
use IPC::Open3;
use strict;
my ($invar, $outvar, $errvar, $in, $out, $err, $pid, $pidr);
open($in, "<",\$invar);
open($out, ">",\$outvar);
open($err, ">",\$errvar);
my $cmd = "sleep 5; echo Test; sleep 5; echo Test; sleep 5;";
$pid = open3($in, $out, $err, $cmd);
my $num = 0;
for($pidr = $pid; $pidr >= 0;)
{
sleep(1) if ($pidr = waitpid($pid, WNOHANG)) >= 0;
print "$num: $outvar" if $outvar;
++$num;
}
close($in);
close($out);
close($err);
When started nothing happens. The output of the started program does not go into $outvar. To test if my basic idea fails I tried this:
my $outvar = "";
my $out;
open($out, ">", \$outvar);
print $out "Test\n";
print "--1--\n$outvar";
print $out "Test2\n";
print "--2--\n$outvar";
which correctly outputs as expected:
--1--
Test
--2--
Test
Test2
The question is: Why does the above program not work as the test example and output the text which should be in $outvar?
A working solution is much more complex (when you add all the security checks left out for this example):
use POSIX;
use IPC::Open3;
use strict;
my ($invar, $outvar, $errvar, $in, $out, $err, $pid, $pidr);
open($in, "<",\$invar);
open($out, ">",\$outvar);
open($err, ">",\$errvar);
my $cmd = "sleep 5; echo Test; sleep 5; echo Test; sleep 5;";
$pid = open3($in, $out, $err, $cmd);
my $num = 0;
for($pidr = $pid; $pidr >= 0;)
{
sleep(1) if ($pidr = waitpid($pid, WNOHANG)) >= 0;
my $obits; vec($obits, fileno($out), 1) = 1;
if(select($obits, undef, undef, 0) > 0)
{
my $buffer;
sysread($out, $buffer, 10240);
print "$num: $buffer" if $buffer;
}
++$num;
}
close($in);
close($out);
close($err);
It correctly prints (as should do the first one as well in similar way):
5: Test
10: Test
For the examples I removed much of the error handling and the similar code for STDERR.
open($out, ">", \$outvar); does not create a system file handle. You'll notice that fileno($out) is -1. One process can't write to another's memory, much less manipulate its variables, so the whole concept is flawed. Use IPC::Run3 or IPC::Run; they effectively implement the select loop for you. open3 is far too low-level for most applications.
The second snippet works because open3 is behaving as if $in, $out and $err are unopened handles. You might as well have done
$in = gensym();
$out = gensym();
$err = gensym();
But again, you should be using IPC::Run3 or IPC::Run. Your hand-rolled version suffers from some bugs, including one that can lead to a deadlock.
myb.py
import time
import sys
stime = time.time()
run_until = 600
cnt = 0
while True:
dur = time.time() - stime
if dur > run_until:
break
cnt += 1
print cnt
time.sleep(1)
if cnt == 10:
sys.exit(2) <---- capture 2
mya.pl
use FileHandle;
my $myexe = 'myb.py';
my $FH = FileHandle->new;
open $FH, q{-|},
"$myexe 2>&1"
or print "Cannot open\n";
process_output($FH);
close $FH or warn $!;
sub process_output {
my ($fh) = #_;
while (my $line = <$fh>) {
chomp $line;
print "$line\n";
}
}
OUTPUT:
1
2
3
4
5
6
7
8
9
10
Warning: something's wrong at ./mya.pl line 10.
if i change the line to:
my $err = close $FH;
it gives me a blank for $err.
Question: How can I capture the return code 2 from myb.py in mya.pl?
As documented in http://perldoc.perl.org/functions/close.html, the exit value is available as part of $?. But it can be more convenient to use a wrapper:
use IPC::System::Simple qw(capture $EXITVAL EXIT_ANY);
my #output = capture([0,2], "$myexe 2>&1");
print #output;
print "Program exited with value $EXITVAL\n";
The [0,2] says that exit values 0 or 2 are expected, and anything else is a fatal error; you can use EXIT_ANY instead.
This does get all the output at the end, rather than when it is produced, though.
When open creates a child, close functions as waitpid and sets $? accordingly.
$ perl -e'
open(my $fh, "-|", #ARGV)
or die $!;
print while <$fh>;
close($fh);
if ($? == -1 ) { die $!; }
elsif ($? & 0x7F) { die "Killed by signal ".($? & 0x7F)."\n"; }
elsif ($? >> 8 ) { die "Exited with error ".($? >> 8)."\n"; }
' perl -E'
$| = 1;
for (1..5) {
say;
sleep 1;
}
exit 2;
'
1
2
3
4
5
Exited with error 2
I'm trying to implement custom handlers for given keystrokes so that I can change mode when my script is fetching data from file. How is that possible without any WHILE loop?
I was looking into Term::ReadKey but I dont think it does what I need. Maybe I should connect it with something though I can't find any solution on google.
I've just started with perl scripting :)
Here is an example of how to avoid busy waiting when waiting for a keyboard input:
use strict;
use warnings;
use IPC::Open2;
my $pid1 = run_cmd('read_key');
my $pid2 = run_cmd('counter');
print "Master: waiting for keyboard event..\n";
waitpid $pid1, 0;
print "Master: Done.\n";
kill 'TERM', $pid2;
sub run_cmd {
my ($cmd) = #_;
open(OUT, ">&STDOUT") or die "Could not duplicate STDOUT: $!\n";
open(IN, ">&STDIN") or die "Could not duplicate STDIN: $!\n";
my $pid = open2('>&OUT', '<&IN', $cmd);
return $pid;
}
where read_key is:
use strict;
use warnings;
use Term::ReadKey;
ReadMode 4;
END { ReadMode 0 }
my $key = ReadKey(0);
print "$key\n";
and counter is:
use strict;
use warnings;
$SIG{TERM} = sub { die "Child (counter): Caught a sigterm. Abort.\n" };
my $i = 0;
while (++$i) {
sleep 1;
print "$i\n";
}
Example output:
Name "main::IN" used only once: possible typo at ./p.pl line 19.
Name "main::OUT" used only once: possible typo at ./p.pl line 18.
Master: waiting for keyboard event..
1
2
3
q
Master: Done.
Child (counter): Caught a sigterm. Abort.
I have a command that I'm executing using OPEN with pipe, and I want to set a timeout of 10 seconds and have the sub process aborted if the execution time exceeds this. However, my code just causes the program to hang- Why is my ALARM not getting delivered properly?
my $pid = 0;
my $cmd = "someCommand";
print "Running Command # $num";
eval {
local $SIG{ALRM} = sub {
print "alarm \n";
kill 9, $pid;
};
alarm 10;
pid = open(my $fh, "$cmd|");
alarm 0;
};
if($#) {
die unless $# eq "alarm \n";
} else {
print $_ while(<$fh>);
}
EDIT:
So From the answers below, This is what I have:
my $pid = open(my $fh, qq(perl -e 'alarm 10; exec \#ARGV; die "exec: $!\n" ' $cmd |));
print $_ while(<$fh>);
But this print ALARM CLOCK to the console when the alarm times out...whereas I dont specify this anywhere in the code...how can I get rid of this, and where would I put the custom alarm event handler?
Thanks!
I want to set a timeout of 10seconds and have the sub process aborted if the execution time exceeds this
A different approach is to set the alarm on the subprocess itself, with a handy scripting language you already have:
my $cmd = "someCommand";
my $pid = open(my $child_stdout, '-|',
'perl', '-e', 'alarm 10; exec #ARGV; die "exec: $!"', $cmd);
...
Your child process will initially be perl (well, the shell and then perl), which will set an alarm on itself and then exec (replace itself with) $someCommand. Pending alarms, however, are inherited across exec()s.
All your code is doing is setting a 10 second timeout on the open call, not on the whole external program. You want to bring the rest of your interaction with the external command into the eval block:
eval {
local $SIG{ALRM} = sub {
print "alarm \n";
kill 9, $pid;
};
alarm 10;
$pid = open(my $fh, "$cmd|");
print while <$fh>;
close $fh;
alarm 0;
};
if($#) {
die unless $# eq "alarm \n";
}
I need to run a program, feed some strings on its stdin, read its stdout/stderr and know how it ended. I have to know if it received a signal (segfault, etc) and its exit code. Also, if the program runs for more than some amount of time, I have to know it (and kill it).
How would you do that? Is there a module that handles this kind of things?
Re. exit codes and signals, see here. In particular:
Exit codes in the range 129-255 represent jobs terminated by Unix
"signals". Each type of signal has a number, and what's reported as
the job exit code is the signal number plus 128. Signals can arise
from within the process itself (as for SEGV, see below) or be sent to
the process by some external agent (such as the batch control system,
or your using the "bkill" command).
By way of example, then, exit code 64 means that the job deliberately
terminated its execution by calling "exit(64)", exit code 137 means
that the job received a signal 9, and exit code 140 represents signal
12.
Ok here's what I came up with: (usage example at the end)
#!/usr/bin/perl
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
use Time::HiRes 'time';
use POSIX ':sys_wait_h';
use IO::Select;
sub run_prog {
my ($progin, $timeout, $cmd, #args) = #_;
my ($progres, $progout, $progerr);
my ($fdin, $fdout, $fderr);
my $outsel = IO::Select->new();
my $errsel = IO::Select->new();
$fderr = gensym;
my $pid = open3($fdin, $fdout, $fderr, $cmd, #args);
my $start = time;
syswrite $fdin, $progin;
close $fdin;
$outsel->add($fdout);
$errsel->add($fderr);
$progout = '';
$progerr = '';
my $last_activity = $start;
my $select_timeout = 0.1;
my $ret;
while(time - $last_activity < $timeout) {
if($outsel->can_read($select_timeout)) {
my $buf;
$ret = sysread($fdout, $buf, 1000);
if(!defined $ret) {
warn "out ndef";
last;
}
$progout .= $buf;
$last_activity = time;
}
if($errsel->can_read($select_timeout)) {
my $buf;
$ret = sysread($fderr, $buf, 1000);
if(!defined $ret) {
warn "err ndef";
last;
}
$progerr .= $buf;
$last_activity = time;
}
$ret = waitpid($pid, WNOHANG);
# still exists, continue
if($ret == 0) {
next;
}
# process exited/signaled
elsif($ret > 0) {
$progres = $?;
last;
}
# process doesn't exists??
else {
die "wat";
}
}
close $fdout;
close $fderr;
# timeout
if(time - $last_activity >= $timeout) {
kill 9, $pid;
waitpid($pid, 0);
$progres = $?;
}
return ($progres, $progout, $progerr);
}
my #r = run_prog("qsdjkqsodj\nqsdqsd\n", 0.9, './bbb', $ARGV[0] || 0);
printf "out: <%s>\nerr: <%s>\n", $r[1], $r[2];
my $x = $r[0];
if ($x == -1) {
print "failed to execute: $!\n";
}
elsif ($x & 127) {
printf "child died with signal %d, %s coredump\n",
($x & 127), ($x & 128) ? 'with' : 'without';
}
else {
printf "child exited with value %d\n", $x >> 8;
}