hakanson@ogicse.ogc.edu (Marion Hakanson) (12/13/89)
This is Perl-3.0, patchlevel 6. Below I have a script which uses
pseudo-tty's to feed input to a program, and accept output back
from that program. The example script uses "tr A-Z a-z" as the
program on the slave side of the pty, but you can imagine that a
more complicated program might be put there instead.
Here's the script, with the getpty.pl following at the end of this
message:
====================================
#!/usr/bin/perl
do 'getpty.pl';
die "$@, aborted" if $@;
$MAST = 'MASTER';
$SLAV = 'SLAVE';
($mast,$slav) = do getpty($MAST,$SLAV);
print STDERR "getpty returns '$mast','$slav'\n";
die 'Cannot get pty, aborted' if ($mast eq '');
if ( fork ) { # parent
close($SLAV); # not needed
if ( fork ) { # still parent
open(MASTOUT, "+>&$MAST") || die "Cannot dup $MAST to MASTOUT, aborted";
close($MAST);
select(MASTOUT); $| = 1;
select(STDOUT); $| = 1;
for ($i=0; $i<10; $i++ ) {
print MASTOUT "LINE out $i\n" || die "Cannot print to $mast, aborted";
sleep(1);
}
exit(0);
} else { # child 2
open(MASTIN, "+>&$MAST") || die "Cannot dup $MAST to MASTIN, aborted";
close($MAST);
while ($mastin = <MASTIN>) {
print STDOUT "$$: $mastin";
}
exit(0);
}
} else { # child 1
close($MAST); # not needed
open(STDOUT, "+>&$SLAV") || die "Cannot dup $SLAV to STDOUT, aborted";
open(STDIN, "+>&$SLAV") || die "Cannot dup $SLAV to STDIN, aborted";
close($SLAV);
select(STDOUT); $| = 1;
exec ('tr','A-Z','a-z') || die "Cannot start 'tr', aborted";
}
====================================
The script does just the right thing when run on both MtXinu-4.3bsd
(uVAX-II) and on DYNIX-3.0.12 (4.2bsd, Sequent S81), namely it prints
out the following, with nice 1-second intervals between each line.
getpty returns '/dev/ptyp0','/dev/ttyp0'
12481: line out 0
12481: line out 1
12481: line out 2
12481: line out 3
12481: line out 4
12481: line out 5
12481: line out 6
12481: line out 7
12481: line out 8
12481: line out 9
But under SunOS-4.0.3 (Sun-3), everything which gets put into the
master side, also comes out unchanged, in addition to the output
of the "tr" program, again with 1-second intervals between each
pair of output lines:
getpty returns '/dev/ptyp2','/dev/ttyp2'
1963: LINE out 0
1963: line out 0
1963: LINE out 1
1963: line out 1
1963: LINE out 2
1963: line out 2
1963: LINE out 3
1963: line out 3
1963: LINE out 4
1963: line out 4
1963: LINE out 5
1963: line out 5
1963: LINE out 6
1963: line out 6
1963: LINE out 7
1963: line out 7
1963: LINE out 8
1963: line out 8
1963: LINE out 9
1963: line out 9
So, the question is, is this a SunOS bug, or a Perl bug with how it
interacts with SunOS? A pty bug, a stdio bug, or a Perl-shared-FH
bug? How about a workaround?
Larry: It's looking more and more to me like you should think about
packaging up a PD stdio package with Perl, in the same manner as the
regexp package. Or build Perl I/O on top of file descriptors, instead
of file pointers, so when you fork you don't get all those shared
pointers, etc. In case you couldn't tell, I've had a bit of trouble
with forked filehandles lately, although in this case I've rearranged
the order of forks in various permutations, all with the same results.
====================================
sub getpty {
local ($MASTER,$SLAVE) = @_;
local ($master,$slave);
$master = '';
$slave = '';
pty: while ( </dev/pty*> ) {
# print STDERR "trying '$_'\n";
$master = $_;
unless ( open($MASTER,"+>$master") ) {
# print STDERR "open failed: $master\n";
$master = '';
next pty;
}
s/pty/tty/;
$slave = $_;
last pty if ( open($SLAVE,"+>$slave") );
# print STDERR "open failed: $slave\n";
close($MASTER);
$master = '';
$slave = '';
}
# print STDERR "getpty returning '$master','$slave'\n";
($master,$slave);
}
====================================
--
Marion Hakanson Domain: hakanson@cse.ogi.edu
UUCP : {hp-pcd,tektronix}!ogicse!hakanson