Path: utzoo!utgpu!jarvis.csri.toronto.edu!cs.utexas.edu!uwm.edu!uakari.primate.wisc.edu!caesar.cs.montana.edu!ogicse!hakanson
From: hakanson@ogicse.ogc.edu (Marion Hakanson)
Newsgroups: comp.lang.perl
Subject: Re: Question about two-sided connections to perl
Keywords: popen pseudo-ttys process-connection
Message-ID: <6701@ogicse.ogc.edu>
Date: 17 Jan 90 18:52:54 GMT
References: <3196@taux01.UUCP>
Reply-To: hakanson@cse.ogi.edu (Marion Hakanson)
Organization: Oregon Graduate Institute (formerly OGC), Beaverton, OR
Lines: 129

In article <3196@taux01.UUCP> arielf@taux01.UUCP (Ariel Faigon) writes:
>Is there a simple way to connect a perl program to both sides of a process ?

Not without creating your own pipeline.  And even then, under some
OS's (SunOS-4, for example), there are still a few problems with
"forked" filehandles.  But read on.

>--- Question no. 2:
>Can I make 'some_program' that is connected to Perl, think it is writing into
>a pty instead of a pipe (actually what I need is that 'some_program' _output_
>be unbuffered - note, I'm not asking about unbuffering perl-output which
>is simple).
>
>I'm afraid I'll need to write all the 'pty' stuff myself which I
>can do in 'C' in the first place.

I had exactly this in mind when I built the following as a test
program.  It works in my "real" application, as well.  I may have
posted this script before, but it was in a different context.  Note
that the original parent perl is doing the input (writing to the
middle process), the "child 2" is collecting the output from the
middle process, and "child 1" just sets up the filehandles and exec's
your "some_program".

As I hinted above, under SunOS-4, whatever the parent writes in also
comes back to child 2, in addition to going to the middle process, so
child 2 may have to filter some garbage mixed with the output from the
middle process.  This seems to be related to stdio, and not to PTY's
(I've gotten the same results from using plain Perl pipes).

Anyway, first comes my "ptytst5.pl", followed by my "getpty.pl".  No,
you don't need any C code to use pty's.  The only difficulty (other
than that described above) is that sometimes not all stages of the
pipeline will die when one of them does.  Sigh.

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

===========cut here============
#!/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";
}
===========cut here============
#
# $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);
}
===========cut here============