I want to start a program, send some data to its stdin, read its stdout/stderr and return everything. And if it runs for too long I want to kill it.
I use the low-level unbuffered io function, do everything in chunks, check before writing/reading using select but it still fails....
With the following script, cat
timeouts on the bash man page (300KB) after writing back 5000 bytes. Why ?
$ perl bar.pl
timeout :( at bar.pl line 119.
RES = 9
ERR = <>
IN = <BASH(1) ...> (294439 chars)
OUT = <BASH(1) ...> (5000 chars)
UPDATE : When I use a single IO::Select object and stop capturing stderr, it get almost everything back without a timeout.
Diff:
--- old.pl 2013-11-20 17:08:19.000000000 +0100
+++ new.pl 2013-11-20 17:07:58.000000000 +0100
@@ -26,10 +26,6 @@
my $bufsize = 100;
- my $insel = IO::Select->new();
- my $outsel = IO::Select->new();
- my $errsel = IO::Select->new();
-
$fderr = gensym;
my $pid = open3($fdin, $fdout, $fderr, $cmd, @args) or die "open3 $!";
@@ -39,9 +35,9 @@
my $len = length($progin);
my $off = 0;
- $insel->add($fdin);
- $outsel->add($fdout);
- $errsel->add($fderr);
+ my $sel = IO::Select->new();
+ $sel->add($fdin);
+ $sel->add($fdout);
if ($len <= 0) {
close $fdin;
@@ -59,7 +55,7 @@
last;
}
- if ($len > 0 && $insel->can_write($select_timeout)) {
+ if ($len > 0 && $sel->can_write($select_timeout)) {
$ret = syswrite $fdin, $progin, $bufsize, $off;
if (!defined $ret) {
warn "in ndef";
@@ -74,7 +70,7 @@
}
}
- if ($outsel->can_read($select_timeout)) {
+ if ($sel->can_read($select_timeout)) {
my $buf;
$ret = sysread($fdout, $buf, $bufsize);
if(!defined $ret) {
@@ -84,16 +80,6 @@
$progout .= $buf;
}
- if ($errsel->can_read($select_timeout)) {
- my $buf;
- $ret = sysread($fderr, $buf, $bufsize);
- if(!defined $ret) {
- warn "err ndef";
- last;
- }
- $progerr .= $buf;
- }
-
$ret = waitpid($pid, WNOHANG);
# still exists, continue
if ($ret == 0) {
The script:
#!/usr/bin/perl
use Data::Dumper;
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
use Time::HiRes 'time';
use POSIX ':sys_wait_h';
use IO::Select;
use Getopt::Std;
use File::Temp;
my $in = `man -P cat bash`;
my ($res, $out, $err) = run_prog($in, 5, 'cat');
print "RES = $res\n";
print "ERR = <$err>\n";
printf "IN = <%s...> (%d chars)\n", substr($in, 0, 30), length($in);
printf "OUT = <%s...> (%d chars)\n", substr($out, 0, 30), length($out);
sub run_prog {
my ($progin, $timeout, $cmd, @args) = @_;
my ($progres, $progout, $progerr);
my ($fdin, $fdout, $fderr);
my $bufsize = 100;
my $insel = IO::Select->new();
my $outsel = IO::Select->new();
my $errsel = IO::Select->new();
$fderr = gensym;
my $pid = open3($fdin, $fdout, $fderr, $cmd, @args) or die "open3 $!";
my $start = time;
my $ret;
my $len = length($progin);
my $off = 0;
$insel->add($fdin);
$outsel->add($fdout);
$errsel->add($fderr);
if ($len <= 0) {
close $fdin;
}
$progout = '';
$progerr = '';
my $select_timeout = 0.1;
my $toolong = 0;
while (1) {
if (time - $start > $timeout) {
$toolong = 1;
last;
}
if ($len > 0 && $insel->can_write($select_timeout)) {
$ret = syswrite $fdin, $progin, $bufsize, $off;
if (!defined $ret) {
warn "in ndef";
last;
}
$off += $ret;
$len -= $ret;
if ($len <= 0) {
close $fdin;
}
}
if ($outsel->can_read($select_timeout)) {
my $buf;
$ret = sysread($fdout, $buf, $bufsize);
if(!defined $ret) {
warn "out ndef";
last;
}
$progout .= $buf;
}
if ($errsel->can_read($select_timeout)) {
my $buf;
$ret = sysread($fderr, $buf, $bufsize);
if(!defined $ret) {
warn "err ndef";
last;
}
$progerr .= $buf;
}
$ret = waitpid($pid, WNOHANG);
# still exists, continue
if ($ret == 0) {
next;
}
# process exited/signaled
# make a last read
elsif ($ret > 0) {
$progres = $?;
next;
}
# process doesn't exists anymore
else {
last;
}
}
close $fdout;
close $fderr;
# timeout
if ($toolong) {
warn "timeout :(";
kill 9, $pid;
waitpid($pid, 0);
$progres = $?;
}
return ($progres, $progout, $progerr);
}
I have dinked around with this for ages, and can get it to work by replacing the 3 variables that you use for the select() call, with a single variable to which you add all 3 file descriptors. So the code looks like this:
my $sel = IO::Select->new();
$sel->add($fdin);
$sel->add($fdout);
$sel->add($fderr);
and later on:
$sel->can_write($select_timeout);
and
$sel->can_read($select_timeout)
Ok, I looked at it some more and this works every time and doesn't miss any bytes. I'll leave you to add back in the error handling stuff.
#!/usr/bin/perl
use Data::Dumper;
use strict;
use warnings;
use IPC::Open3;
use Symbol 'gensym';
use Time::HiRes 'time';
use POSIX ':sys_wait_h';
use IO::Select;
use Getopt::Std;
use File::Temp;
my $in = 'a' x 300000; # Just get 300000 bytes without messing around
my ($res, $out, $err) = run_prog($in, 5, 'cat');
print "RES = $res\n";
print "ERR = <$err>\n";
printf "IN = <%s...> (%d chars)\n", substr($in, 0, 30), length($in);
printf "OUT = <%s...> (%d chars)\n", substr($out, 0, 30), length($out);
sub run_prog {
my ($progin, $timeout, $cmd, @args) = @_;
my ($progres, $progout, $progerr);
my ($fdin, $fdout, $fderr);
my $bufsize = 100; # Or use 4, or 800,000 - they all work now!
$fderr = gensym;
my $pid = open3($fdin, $fdout, $fderr, $cmd, @args) or die "open3 $!";
my $write_set = IO::Select->new($fdin);
my $read_set = IO::Select->new($fdout);
my $start = time;
my $ret;
my $len = length($progin);
my $off = 0;
if ($len <= 0) {
close $fdin;
}
$progout = '';
$progerr = '';
my $select_timeout = 0.1;
my $toolong = 0;
while (1) {
if (time - $start > $timeout) {
$toolong = 1;
last;
}
if ($len > 0 && IO::Select->select(undef,$write_set,undef,$select_timeout)) {
$ret = syswrite $fdin, $progin, $bufsize, $off;
if (!defined $ret) {
warn "in ndef";
last;
}
$off += $ret;
$len -= $ret;
if ($len <= 0) {
close $fdin;
}
}
if (IO::Select->select($read_set,undef,undef,$select_timeout)) {
my $buf;
$ret = sysread($fdout, $buf, $bufsize);
if(!defined $ret) {
warn "out ndef";
last;
}
$progout .= $buf;
}
$ret = waitpid($pid, WNOHANG);
# still exists, continue
if ($ret == 0) {
next;
}
# process exited/signaled
# make a last read
elsif ($ret > 0) {
$progres = $?;
next;
}
# process doesn't exists anymore
else {
last;
}
}
close $fdout;
close $fderr;
# timeout
if ($toolong) {
warn "timeout :(";
kill 9, $pid;
waitpid($pid, 0);
$progres = $?;
}
return ($progres, $progout, $progerr);
}
Since no one managed to make this work I've looked harder in CPAN and found the IPC::Run
module.
use IPC::Run;
sub run_prog {
my ($in, $t, $cmd, @args) = @_;
my ($out, $err);
IPC::Run::run([$cmd, @args], \$in, \$out, \$err, IPC::Run::timeout($t));
return ($?, $out, $err);
}
Line:
if ($len > 0 && $insel->can_write($select_timeout)) {
shouldn't that be
...outsel->can_write...
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.