/usr/share/doc/libio-pty-perl/examples/try is in libio-pty-perl 1:1.08-1.1+b2.
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 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | #!/usr/bin/perl
use blib;
use IO::Pty;
require POSIX;
$^W = 1;
my $pty = new IO::Pty;
my $pid;
unless (@ARGV) {
{
my $slave = $pty->slave;
print %{*$pty},"\n";
print "master $pty $$pty ",$pty->ttyname,"\n";
print "slave $slave $$slave ",$slave->ttyname,"\n";
foreach $val (1..10) {
print $pty "$val\n";
$_ = <$slave>;
print "$_";
}
}
close $pty;
print "Done.\n";
exit 0;
} else {
pipe(STAT_RDR, STAT_WTR)
or die "Cannot open pipe: $!";
STAT_WTR->autoflush(1);
$pid = fork();
die "Cannot fork" if not defined $pid;
unless ($pid) {
close STAT_RDR;
$pty->make_slave_controlling_terminal();
my $slave = $pty->slave();
close $pty;
$slave->clone_winsize_from(\*STDIN);
$slave->set_raw();
open(STDIN,"<&". $slave->fileno())
or die "Couldn't reopen STDIN for reading, $!\n";
open(STDOUT,">&". $slave->fileno())
or die "Couldn't reopen STDOUT for writing, $!\n";
open(STDERR,">&". $slave->fileno())
or die "Couldn't reopen STDERR for writing, $!\n";
close $slave;
{ exec(@ARGV) };
print STAT_WTR $!+0;
die "Cannot exec(@ARGV): $!";
}
close STAT_WTR;
$pty->close_slave();
$pty->set_raw();
# now wait for child exec (eof due to close-on-exit) or exec error
my $errstatus = sysread(STAT_RDR, $errno, 256);
die "Cannot sync with child: $!" if not defined $errstatus;
close STAT_RDR;
if ($errstatus) {
$! = $errno+0;
die "Cannot exec(@ARGV): $!";
}
$SIG{WINCH} = \&winch;
parent($pty);
}
sub winch {
$pty->slave->clone_winsize_from(\*STDIN);
kill WINCH => $pid if $pid;
print "STDIN terminal size changed.\n";
$SIG{WINCH} = \&winch;
}
sub process
{
my ($rin,$src,$dst) = @_;
my $buf = '';
my $read = sysread($src, $buf, 1);
if (defined $read && $read)
{
syswrite($dst,$buf,$read);
syswrite(LOG,$buf,$read);
}
else
{
# print STDERR "Nothing for $src i.e. $read\n";
vec($rin, fileno($src), 1) = 0;
}
return $rin;
}
sub parent
{
open(LOG,">log") || die;
my ($pty) = @_;
my $tty = $pty;
my ($rin,$win,$ein) = ('','','');
vec($rin, fileno(STDIN), 1) = 1;
vec($rin, fileno($tty), 1) = 1;
vec($win, fileno($tty), 1) = 1;
vec($ein, fileno($tty), 1) = 1;
select($tty);
$| = 1;
select(STDOUT);
$| = 1;
while (1)
{
my ($rout,$wout,$eout,$timeleft);
($nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,3600);
die "select failed:$!" if ($nfound < 0);
if ($nfound > 0)
{
if (vec($eout, fileno($tty), 1))
{
# print STDERR "Exception on $tty\n";
}
if (vec($rout, fileno($tty), 1))
{
$rin = process($rin,$tty,STDOUT);
last unless (vec($rin, fileno($tty), 1));
}
elsif (vec($rout, fileno(STDIN), 1) && vec($wout, fileno($tty), 1))
{
$rin = process($rin,STDIN,$tty);
}
}
}
close(LOG);
}
|