Path: utzoo!attcan!uunet!ogicse!hakanson
From: hakanson@ogicse.ogi.edu (Marion Hakanson)
Newsgroups: comp.lang.perl
Subject: Re: perl and pttys
Keywords: ptty
Message-ID: <8069@ogicse.ogi.edu>
Date: 16 Mar 90 19:15:59 GMT
References: <37098@mips.mips.COM>
Organization: Oregon Graduate Institute (formerly OGC), Beaverton, OR
Lines: 103


It's not exactly what you described, but should get you started.  This
must be the third or fourth time I've posted this fragment.  PTY's are
tricky, even if you aren't using Perl.  If you want the middle of the
"pipeline" to be a Perl routine, just replace the "exec 'tr'..." with
your code.

=============ptytst5.pl===========
#!/usr/bin/perl
# Pseudo-tty test program -- 89/12/01
#   Marion Hakanson (hakanson@cse.ogi.edu)
#   Oregon Graduate Institute of Science and Technology

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";
}
=============end of ptytst5.pl===========

=============getpty.pl==========
#
# $Id: getpty.pl,v 1.3 90/01/02 17:18:56 hakanson Exp $
#
# Perl subroutine to allocate a free pseudo-tty (master/slave pair).
#   Marion Hakanson (hakanson@cse.ogi.edu)
#   Oregon Graduate Institute of Science and Technology

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);
}
=============end of getpty.pl==========

-- 
Marion Hakanson         Domain: hakanson@cse.ogi.edu
                        UUCP  : {hp-pcd,tektronix}!ogicse!hakanson