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