/usr/share/doc/libipc-run-perl/examples/abuse/blocking_writes is in libipc-run-perl 0.92-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | #!/usr/bin/perl
## Submitted by Borislav Deianov <borislav@users.sourceforge.net>
## This stresses the blocking write to see if it blocks.
use Fcntl;
use IO::Pty;
use IPC::Run qw(run);
sub makecmd {
return ['perl', '-e',
'<STDIN>, print "\n" x '.$_[0].'; while(<STDIN>){last if /end/}'];
}
pipe R, W;
fcntl(W, F_SETFL, O_NONBLOCK);
while (syswrite(W, "\n", 1)) { $pipebuf++ };
print "pipe buffer size is $pipebuf\n";
$in = "\n" x ($pipebuf * 3) . "end\n";
print "reading from scalar via pipe... ";
run(makecmd($pipebuf * 3), '<', \$in, '>', \$out);
print "done\n";
print "reading from code via pipe... ";
run(makecmd($pipebuf * 3), '<', sub { $t = $in; undef $in; $t}, '>', \$out);
print "done\n";
$pty = IO::Pty->new();
$pty->blocking(0);
$slave = $pty->slave();
while ($pty->syswrite("\n", 1)) { $ptybuf++ };
print "pty buffer size is $ptybuf\n";
$in = "\n" x ($ptybuf * 3) . "end\n";
print "reading via pty... ";
run(makecmd($ptybuf * 3), '<pty<', \$in, '>', \$out);
print "done\n";
|