如何在Perl中的进程stdin / stdout / stderr中读取和写入大缓冲区?

时间:2013-11-20 00:06:32

标签: perl ipc

我想启动一个程序,将一些数据发送到它的stdin,读取它的stdout / stderr并返回所有内容。如果它运行的时间太长,我想杀死它。

我使用低级无缓冲的io功能,在块中做所有事情,在使用select进行写入/阅读之前检查但仍然失败....

使用以下脚本,在写回5000字节后,bash手册页(300KB)上的cat超时。 为什么

$ perl bar.pl
timeout :( at bar.pl line 119.
RES = 9
ERR = <>
IN  = <BASH(1)                       ...> (294439 chars)
OUT = <BASH(1)                       ...> (5000 chars)    

UPDATE :当我使用单个IO :: Select对象并停止捕获stderr时,它几乎可以在没有超时的情况下返回所有内容。

差异:

--- 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) {

剧本:

#!/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);
}

4 个答案:

答案 0 :(得分:1)

我已经沉溺了很久,并且可以通过替换用于select()调用的3个变量来使其工作,使用单个变量添加所有3个文件描述符。所以代码看起来像这样:

my $sel = IO::Select->new();
$sel->add($fdin);
$sel->add($fdout);
$sel->add($fderr);

以及后来:

$sel->can_write($select_timeout);

$sel->can_read($select_timeout)

答案 1 :(得分:1)

好的,我再看了一遍,每次都有效,不会遗漏任何字节。我会让你重新加入错误处理的东西。

#!/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);
}

答案 2 :(得分:0)

由于没有人设法完成这项工作,我在CPAN中看起来更难,并找到了IPC::Run模块。

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);    
}

答案 3 :(得分:-1)

行:

  if ($len > 0 && $insel->can_write($select_timeout)) {

不应该是

...outsel->can_write...