Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!think.com!snorkelwacker.mit.edu!bloom-beacon!eru!hagbard!sunic!mcsun!ukc!newcastle.ac.uk!colman!des0mpw
From: des0mpw@colman.newcastle.ac.uk (M.P. Ward)
Newsgroups: comp.lang.perl
Subject: Re: PERL expect
Keywords: expect
Message-ID: <1991Apr5.084457.25138@newcastle.ac.uk>
Date: 5 Apr 91 08:44:57 GMT
References: <1991Apr3.195446.23461@magnus.acs.ohio-state.edu>
Sender: news@newcastle.ac.uk
Organization: Computing Laboratory, University of Newcastle upon Tyne, UK, NE1 7RU
Lines: 251


If you just can't wait for Randell's supercharged chat script, here's
what I use to communicate interactively with another process using ptys:

An example script which logs into another machine, using another username,
and sends me some files via FTP:

#! /usr/bin/perl -s
require "waitfor.pl";

# get a password:
$password = &get_password();

# start up the program we are talking to:
&start_command("rlogin colman -l des0mpw");

$logging = 0;	# don't echo chars sent
$timeout = 10;	# time out if nothing happens for 10 seconds
&wait_for("colman>");	# wait for the prompt to appear
if ($#ARGV == -1) { # no arguments, so send all:
  &send_ln ("tar cf ftpme.all ftp");
  &wait_for("colman>");
} else {
  &send_ln ("cd ftp");
  &wait_for("colman>");
}
&send_ln ("ftp dur.ws_mw");
&wait_for("Password:");
&send_ln ("$password");
&wait_for("ftp> ");
&send_ln ("prompt");
&wait_for("ftp> "); 
&send_ln ("hash");
&wait_for("ftp> "); 
&send_ln ("bin");
&wait_for("ftp>"); 
if ($#ARGV == -1) {
  &send_ln ("put ftpme.all");
  &wait_for("ftp>");
} else {
  foreach $file (@ARGV) {
    &send_ln ("put $file");
    &wait_for("ftp> ");
  }
}
&send_ln ("quit");	# quit from FTP

# log out from colman:
&wait_for("colman>");
if ($#ARGV == -1) {
  &send_ln ("rm ftpme.all");
  &wait_for("colman>");
}
&send_ln ("exit");
close (IN);
close (F);
exit;

################## END OF SCRIPT ##################################


And here's waitfor.pl:
Note there are more functions than were used in the example,
in particular, you can wait for a pattern or a list of strings or patterns
(the function returns the pattern/list found).

You can recover from a timeout using eval, eg:

eval '&wait_for("may not be found")';
if ($@ eq "Timed out.\n") {
  ... recover from timeout, eg re-send command
} else {
  # pass on the death:
  die $@;
}

##################### START OF waitfor.pl #####################
#
#       Get some chars from the program and build string
#       received so far.

sub get_char {
  local($rmask, $nfound, $timeleft, $thisbuf);
  $endtime = time + $timeout;
  $rmask = "";
  vec($rmask,fileno(IN),1) = 1;
  ($nfound, $timeleft) = select($rmask, undef, undef, $endtime - time);
  die "Timed out.\n" if ((0 + $endtime - time) <= 0);
  if ($nfound) {
    $nread = sysread(IN, $thisbuf, 1024);
    if (defined($nread)) {
      print $thisbuf;
      $str .= $thisbuf;
      return "" if $nread == 0; # eof
    }
  } else {
    return undef; # timeout ?
  }
}

# Get a password from the terminal (Don't echo it!):
sub get_password {
  local($password);
  open(TERM,"/dev/tty") || return("anonymous"); # no terminal
  system "stty -echo";
  select(TERM);$|=1;select(STDOUT);
  print "Password?\n";
  $password = <TERM>;
  chop($password);
  system "stty echo pass8";	# you may just need "stty echo" here
  return($password);
}

# wait_for(string ...) - Eat chars until a string is matched.
# $str is the buffer, remove up to the match when found,
# return the string which matched
sub wait_for {
  local(@strings) = @_;
  local(@patterns);
  local($i, $pattern);
  for ($i = 0; $i <= $#strings; $i++) {
    ($patterns[$i] = $strings[$i]) =~ s/(\W)/\\$1/g;
  }
  print "Waiting for: @strings\n" if ($debug);
  print "Patterns = @patterns\n" if ($debug); 
  while (1) {
    for ($i = 0; $i <= $#patterns; $i++) {
      $pattern = $patterns[$i];
      if ($str =~ /$pattern/) {
        $str = $'; # strip all up to and including the match from $str
        return ($strings[$i]);
      } # fi
    } # next match
    &get_char;
  }
}

# wait_pat(pattern ...) - Eat chars until pattern is matched.
# $str is the buffer, remove up to the match when found:
sub wait_pat {
  local(@patterns) = @_;
  local($i, $pattern);
  print "Waiting for: @strings\n" if ($debug);
  while (1) {
    for ($i = 0; $i <= $#patterns; $i++) {
      $pattern = $patterns[$i];
      if ($str =~ /$pattern/) {
        $str = $'; # strip all up to and including the match from $str
        return ($pattern);
      } # fi
    } # next match
    &get_char;
  }
}

# Switch to interactive mode - take input from stdin:
# select on both STDIN and IN (output of telnet).
# No timeout.
sub interact {
  local($escape) = @_;
  local($rmask, $nfound, $thisbuf);
  print "\n### begin interactive mode ###\n";
  $str = "";
  system "stty raw -echo";
  for(;;) {
    $rmask = "";
    vec($rmask,fileno(IN),1) = 1;
    vec($rmask,fileno(STDIN),1) = 1;
    $nfound = select($rmask, undef, undef, undef);
    if ($nfound) {
      if (vec($rmask,fileno(IN),1) == 1) {
        $nread = sysread(IN, $thisbuf, 1024);
        if (defined($nread)) {
          print $thisbuf;
        }
      } elsif (vec($rmask,fileno(STDIN),1) == 1) {
        $nread = sysread(STDIN, $thisbuf, 1024);
        if (defined($nread)) {
          # check for escape character
          last if ($thisbuf =~ /$escape/);
          &send ($thisbuf);
        } # fi $nread
      } # fi IN
    } # fi select
  } # od
  system "stty -raw echo pass8";
  print "\n### end interactive mode ###\n";
}

 

#       Disconnect

sub quit {
        close(IN);;close(F);
}


#      Get a pseudo terminal connection.. (Borrowed code from expect.pl)

sub getpty {
        local($PTY,$TTY) = @_;
        # don't adjust $PTY,$TTY with main', but use caller when available
        local($pty,$tty);
        for $bank (112..127) {
                next unless -e sprintf("/dev/pty%c0", $bank);
                for $unit (48..57) {
                        $pty = sprintf("/dev/pty%c%c", $bank, $unit);
                        open(PTY,"+>$pty") || next;
                        close(PTY); 
                        ($tty = $pty) =~ s/pty/tty/;
                        return ($pty,$tty);
                }
        }
        $err = 75; &quit;
}

# start the command:
sub start_command {
  local ($command) = @_;
  local($pty,$tty) = &getpty($PTY,$TTY);
  open(IN,"+>$pty") || die "Can't get pty";
  open(F,"|$command >$tty");
  select(F);$|=1;select(STDOUT);$|=1;
}

# send a string to command:

sub send {
  local ($send) = @_;
  print F "$send";
}

# send a line command telnet:

sub send_ln {
  local ($send) = @_;
  print "$send\n" if ($logging);
  print F "$send\r";
}

######################## END OF waitfor.pl ######################

Enjoy!

		Martin.

JANET: Martin.Ward@uk.ac.durham    Internet (eg US): Martin.Ward@durham.ac.uk
or if that fails:  Martin.Ward%uk.ac.durham@nfsnet-relay.ac.uk  
or even: Martin.Ward%DURHAM.AC.UK@CUNYVM.CUNY.EDU
BITNET: Martin.Ward%durham.ac.uk@UKACRL UUCP:...!ukc!durham!Martin.Ward