Mini Shell Moded By TiGER HeX
Home
||
Turbo Force
||
B-F Config_Cpanel
Current Path :
/
usr
/
share
/
doc
/
libipc-run-perl
/
examples
/
abuse
/
Linux midnightridazz 4.19.0-11-cloud-amd64 #1 SMP Debian 4.19.146-1 (2020-09-17) x86_64
Upload File :
New :
File
Dir
//usr/share/doc/libipc-run-perl/examples/abuse/blocking_writes
#!/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";