# -*-Fundamental-*-

#
#   Copyright (c) 1996 Network Appliance, Inc.
#
#   You may distribute under the terms of the Artistic License, as
#   specified in the README file included in the ttt distribution.
#

use English;

$ttt_vers .= "\$Id: //depot/tools/main/p4bench/tttAgents.pl#1 $/";

# tttAgents.pl
        
#ttt###########################################################################
#ttt#
#ttt#  The following functions comprise a "package" (though they are *not*
#ttt#  currently implemented a a separate perl "package") that provides
#ttt#  services useful for managing (possibly remote) remote execution of
#ttt#  multiple child processes. The following data structures are central
#ttt#  to the service:
#ttt#
#ttt#  An $agentid is the process number of the child process on the local
#ttt#  host. (For remote processes, this is the pid of the rsh running on
#ttt#  the local host.)
#ttt#
#ttt#  A tuple of information about each agent is stored in the associative
#ttt#  array %agents:
#
#    $agents{$agentid,"STDIN"}   filehandle for writing to the agent's stdin
#    $agents{$agentid,"STDOUT"}  filehandle for reading the agent's stdout
#    $agents{$agentid,"STDERR"}  filehandle for reading the agent's stderr
#
#ttt#
#ttt#  While the above filehandle names are useful for I/O calls, the file
#ttt#  numbers are useful for constructing the proper bit vector masks.
#ttt#  (The convention of using names "<handle>f" for the second index in
#ttt#  psuedo-multidemsional array is useful as it allows the bit to be
#ttt#  accessed given an $agentid and $filehandle, i.e.,"$agents{$agenid,
#ttt#  $filehandle."f"}".
#ttt#
#
#    $agents{$agentid,"STDINf"}  file number for writing the agent's stdin
#    $agents{$agentid,"STDOUTf"} file number for reading the agent's stdout
#    $agents{$agentid,"STDERRf"} file number reading the agent's stderr
#    $agents{$agentid,"STDINb"}  buffer for writing the agent's stdin
#    $agents{$agentid,"STDOUTb"} buffer for reading the agent's stdout
#    $agents{$agentid,"STDERRb"} buffer for reading the agent's stderr
#    $agents{$agentid,"STDINt"}  bit vec mask bit for selecting agents STDIN
#    $agents{$agentid,"STDOUTt"} bit vec mask bit for selecting agents STDOUT
#    $agents{$agentid,"STDERRt"} bit vec mask bit for selecting agents STDERR
#    $agents{$agentid,"as"}      who the cmd was run as remotely
#    $agents{$agentid,"cmdPID"}  PID of the command on the remote side
#    $agents{$agentid,"last"}    time() value for agent's latest event time
#    $agents{$agentid,"name"}    human-readable name for this agent
#    $agents{$agentid,"onKill"}  action to be taken upon call to ttt_kill_agents
#    $agents{$agentid,"stattag"} status tag line from remote shell
#    $agents{$agentid,"statval"} exit status tag line read from remote shell
#
#ttt#  If you add anything to the above list, please update &ttt_clear_agent
#ttt#  to reflect it.
#ttt#
#ttt#  The %agentids array is the list of known agents. For agents which have
#ttt#  not yet terminated, it is "running". For remote agents which have
#ttt#  terminated, but whose output has not been entirely consumed, or whose
#ttt#  remote shell terminated abnormally before writing the special in-band
#ttt#  status tag line, it is "terminated.$?"; otherwise, it is the exit
#ttt#  status of the child (i.e., the full 8-bit value reterned by wait(2)).
#ttt#  
#
#    %agentids  (keyed by $agentid; "running" | "terminated.$?" | exit status )
#

#ttt#  This function is a perl version of the pipe system call, using
#ttt#  "socketpair". It's used internally by ttt_start_agent:
#ttt#

sub ttt_pipe
{
  $_[0] = &ttt_handle;
  $_[1] = &ttt_handle;

  #if (! socketpair($_[0], $_[1], &AF_UNIX, &SOCK_STREAM, 0))
  # am now using pipe instead of socketpair, since when using socketpair, when
  # one end of the stream is closed (typically the writer), the data not yet read
  # by the other end (the reader) is lost. pipe, on the other hand, retains the data
  # even after one end is closed.
  if (! pipe($_[0], $_[1]) )
    { &ttt_notest("ttt_pipe: pipe failed, errno = $!\n"); }

  select ($_[0]); $| = 1; #  set unbuffered IO
  select ($_[1]); $| = 1; #
  select STDOUT; # (always leave STDOUT selected)
  return 1;
}

if ($MPW) { $STDINbit = 0; $STDOUTbit = 1; $STDERRbit = 2; $maccpids = 0; }

#ttt#  $agentid = &ttt_start_agent_mac($hostname, $cmd, $tell, $as, $name);
#ttt#
#ttt#  This function provides a spoof of the agent stuff for use under MPW.
#ttt#
sub ttt_start_agent_mac
{
  local($onhost, $cmd, $tell, $as, $name) = @_;
  local($cpid);
  
  $cpid = ++$maccpids;
  
  if ($#ttt_eng_agents > 0)
    {
      &ttt_exit("Can't yet support multiple agents under MPW", "notest");
      exit 1;
    }
  
  if ($myhostname ne "localhost")
    {
      &ttt_exit("Can't yet run remote agents under MPW", "notest");
      exit 1;
    }
  
  if (defined($as) && $as ne $user)
    {
      &ttt_exit("Can't yet run as a different user under MPW", "notest");
      exit 1;
    }
  
  if ($tell) { &ttt_msg ("execute", "$cpid on $onhost: $cmd\n"); }
  eval 'toolserver $cmd;';

  $agentids{$cpid} = "running";

  #  These "file numbers" are bogus, but may be useful someday...
  $fno = $cpid + $STDINbit;
  vec($agents{$cpid,"STDINt"},$fno,1) = 1;
  $agents{$cpid,"STDINf"} = $fno; $agents{$cpid,"STDINb"} = "";

  $fno = $cpid + $STDOUTbit;
  vec($agents{$cpid,"STDOUTt"},$fno,1) = 1;
  $agents{$cpid,"STDOUTf"} = $fno; $agents{$cpid,"STDOUTb"} = "";

  $fno = $cpid + $STDERRbit;
  vec($agents{$cpid,"STDERRt"},$fno,1) = 1;
  $agents{$cpid,"STDERRf"} = $fno; $agents{$cpid,"STDERRb"} = "";

  $agents{$cpid,"last"} = time;
  undef $eofbits;

  if (defined($name)) { $agents{$cpid,"name"} = $name; }
  else { $agents{$cpid,"name"} = $cpid; }  # default the agent's name to its pid

  return($cpid);
}


#ttt#  $agentid = &ttt_start_agent($hostname, $cmd, $tell, $as, $name);
#ttt#
#ttt#    > $hostname            the name of the host on which run the process
#ttt#    > $cmd                 is a shell command to be executed
#ttt#    > $tell                tell the world what we're starting (boolean)
#ttt#    > $as                  if present, specifies a user to run the command
#ttt#    > $name                human-readable name for this agent
#ttt#    < $agentid             the agent id of the newly created agent.
#ttt#
#ttt#  This function is used to create a child process ("agent"). The idea
#ttt#  is that the caller need not be aware of whether the agent will run
#ttt#  on the local host or a remote one; the semantics (command line args,
#ttt#  STDIN, STDOUT, STDERR, and exit status) are identical either way.
#ttt#
#ttt#  If $hostname specifies the local host, ttt_start_agent() will start
#ttt#  the agent with a simple fork/exec; otherwise, rsh is used to start the
#ttt#  agent on the specified remote host. In this case, $cmd is modified so
#ttt#  that the remote shell appends a line containing the exit status of the
#ttt#  $cmd pipeline before terminating. This extra line has a special format
#ttt#  recognizable to the agent_ routines, and allows them to ascertain the
#ttt#  exist status of the remote $cmd itself. (This was inspired by "ersh".)
#ttt#

sub ttt_start_agent
{
  if ($MPW) { return &ttt_start_agent_mac(@_); };

  local($onhost, $cmd, $tell, $as, $name) = @_;

  #&ttt_msg("DEBUG", sprintf("&ttt_start_agent(%s, %s, %s, %s);\n\n", @_));

  local($cpid, $fno);
  local(@CSTDIN, @CSTDOUT, @CSTDERR); # handle pairs for "ttt_pipe()"
  local($RD, $WR, $fno);

  if (defined($as) && "$user" eq "$as") { undef($as); }

  &ttt_pipe($RD, $WR); $CSTDIN[0] = $RD;  $CSTDIN[1] = $WR;
  &ttt_pipe($RD, $WR); $CSTDOUT[0] = $RD; $CSTDOUT[1] = $WR;
  &ttt_pipe($RD, $WR); $CSTDERR[0] = $RD; $CSTDERR[1] = $WR;

  if (($cpid = fork) == 0)
    {
      #  we're in the child...
      #

      #  "close(); close(); dup(); close();" to set up STD* in child
      #
      close($CSTDIN[1]); close(STDIN);
      open(STDIN, "<&$CSTDIN[0]"); close($CSTDIN[0]);

      close($CSTDOUT[0]); close(STDOUT);
      open(STDOUT, ">&$CSTDOUT[1]"); close($CSTDOUT[1]);

      close($CSTDERR[0]); close(STDERR);
      open(STDERR, ">&$CSTDERR[1]"); close($CSTDERR[1]);

      #  is this agent supposed to run on the local host?
      #
      if (
       ($onhost eq $myhostname) || ($onhost eq "localhost")
             && ! defined($as)
         )
        {
          #&ttt_msg("DEBUG", "execing \"$cmd\"\n");
          exec "$cmd";
          printf STDERR "\"exec $cmd\" failed\n"; close(STDERR);
          exit 1;          
        }
      else
        {
          #ttt#
          #ttt#  The format of the special status tag line passed to the
          #ttt#  remote side for echo is funky so as to handle either sh or
          #ttt#  csh (since the rsh will execute the remote user's
          #ttt#  preferred shell as set in passwd). csh will echo the $?0
          #ttt#  as "0" and the $status as "<exit status>", while sh will
          #ttt#  echo the $?0 as "<exit status>0" and the $status as "". We
          #ttt#  detect on this side which was used, and parse the tab
          #ttt#  appropriately when it is returned.
          #ttt#
          local($stattag) = "$$:remote:$onhost";
          local($remcmd) = "echo \"ttt_cmdPID:\$\$\"; ( $cmd ); echo \"$stattag:\$?0#\$status\"";
          #&ttt_msg("DEBUG", "$tttrsh $onhost $remcmd\n"); #debug#
          if (defined($as))
            { exec("$tttrsh", "$onhost", "-l", $as, "$remcmd"); }
          else
            { exec("$tttrsh", "$onhost", "$remcmd"); }
          printf STDOUT "$stattag:10#\n"; close(STDOUT);
          printf STDERR "\"exec $cmd\" failed\n"; close(STDERR);
          exit 1; 
        }
    }
  else
    {
      #  we're in the parent...

      #  close the unused sides of our pipes...
      #
      &ttt_closehandle($CSTDIN[0]);
      &ttt_closehandle($CSTDOUT[1]);
      &ttt_closehandle($CSTDERR[1]);

      #  record the attempt to start the agent
      #
      if ($tell)
        { 
          if (defined($as))
            { &ttt_msg
                ("execute", "$cpid on $onhost: $cmd (as user \"$as\")\n"); }
          else
            { &ttt_msg
                ("execute", "$cpid on $onhost: $cmd\n"); }
        }

      $agentids{$cpid} = "running";

      if ($onhost eq $myhostname && ! defined($as))
        { $agents{$cpid,"stattag"} = "local"; }
      else
        { $agents{$cpid,"stattag"} = "$cpid:remote:$onhost"; }

      $agents{$cpid,"STDIN"} = $CSTDIN[1];
      $fno = fileno($agents{$cpid,"STDIN"});
      $agents{$cpid,"STDINt"} = "";
      vec($agents{$cpid,"STDINt"},$fno,1) = 1;
      $agents{$cpid,"STDINf"} = $fno; $agents{$cpid,"STDINb"} = "";

      $agents{$cpid,"STDOUT"} = $CSTDOUT[0];
      $fno = fileno($agents{$cpid,"STDOUT"});
      $agents{$cpid,"STDOUTt"} = "";
      vec($agents{$cpid,"STDOUTt"},$fno,1) = 1;
      $agents{$cpid,"STDOUTf"} = $fno; $agents{$cpid,"STDOUTb"} = "";

      $agents{$cpid,"STDERR"} = $CSTDERR[0];
      $fno = fileno($agents{$cpid,"STDERR"});
      $agents{$cpid,"STDERRt"} = "";
      vec($agents{$cpid,"STDERRt"},$fno,1) = 1;
      $agents{$cpid,"STDERRf"} = $fno; $agents{$cpid,"STDERRb"} = "";

      if (defined($name)) { $agents{$cpid,"name"} = $name; }
      else { $agents{$cpid,"name"} = $cpid; }  # default agent's name to its pid

      # for local agents, cmdPID can just be the command's PID
      # this will allow ttt_kill_agents to still kill all processes
      # it has spawned
      if ($agents{$cpid,"stattag"} eq "local")
        {
          $agents{$cpid,"cmdPID"} = $cpid;
        }
      elsif (defined($as)) { $agents{$cpid,"as"} = $as; }

      $agents{$cpid,"last"} = time;

      return $cpid;
    }
}


sub ttt_get_statval
{
  local($agentid) = @_;

  $agentids{$agentid} = $agents{$agentid,"statval"};
  if ($agentids{$agentid} =~ /0#\n$/) # remote was bourne shell
    { 
      $agentids{$agentid} =~
        s/$agents{$agentid,"stattag"}:(.*)0#\n$/$1/;
    }
  else
    { 
      $agentids{$agentid} =~
        s/$agents{$agentid,"stattag"}:(.*)#(.*)\n$/$2/;
    }
}


#ttt#  $agentid = &ttt_start_agent_windows($hostname, $windowshostname, $cmd, 
#ttt#                                          [$tell, [$as, [$name]]]);
#ttt#
#ttt#    > $hostname            the name of the UNIX host from which to rshell
#ttt#    > $windowshostname     the windows host on which to run the command
#ttt#    > $cmd                 is a shell command to be executed
#ttt#    > $tell                tell the world what we're starting (boolean)
#ttt#    > $as                  if present, specifies a user to run the command
#ttt#    > $name                human-readable name for this agent
#ttt#    < $agentid             the agent id of the newly created agent.
#ttt#
#ttt#  This function is used as a wrapper to call ttt_start_agent with the correct
#ttt#  input to get it to talk to a Windows machine.

sub ttt_start_agent_windows
{
  my ($onhost, $windowshostname, $cmd, $tell, $as, $name) = @_;

  $cmd = "$tttroot/winrsh $windowshostname $cmd";

  return(&ttt_start_agent($onhost,$cmd,$tell,$as,$name));
}


#ttt#  $status = &ttt_close_agent($agentid[, $do_wait]);
#ttt#  
#ttt#    > $agentid     The agentid of the agent to deallocate
#ttt#    > $do_wait     Whether to wait politely for the agent
#ttt#    < $status      The exit status of the agent
#ttt#
#ttt#  This function closes the file descriptors of an agent.
#ttt#

sub ttt_close_agent
{
  my ($agentid, $do_wait) = @_;

  #&ttt_msg("DEBUG", sprintf("&ttt_close_agent(%s, %s);\n\n", @_));

  if (! defined($do_wait))
    {
      if ($UNIX) { $do_wait = 1; }
      if ($MPW) { $do_wait = 0; }
    }
  local ($status);

  #  close the file descriptors
  #

  if ($do_wait) { &ttt_wait_agent($agentid); }

  if ($MPW)  { $status = 0; } # spooferino
  
  if ($UNIX)
    {
      $status = $agentids{$agentid};
      &ttt_closehandle($agents{$agentid,"STDIN"});
      &ttt_closehandle($agents{$agentid,"STDOUT"});
      &ttt_closehandle($agents{$agentid,"STDERR"});
      close($agents{$agentid,"STDIN"});
      close($agents{$agentid,"STDOUT"});
      close($agents{$agentid,"STDERR"});
    }
  &ttt_clear_agent($agentid);
  return ($status);
}


sub ttt_clear_agent
{
  my ($agentid) = @_;

  if ($UNIX)
    {
      delete $agents{$agentid,"STDIN"};
      delete $agents{$agentid,"STDOUT"};
      delete $agents{$agentid,"STDERR"};
      delete $agents{$agentid,"stattag"};
      delete $agents{$agentid,"statval"};
    }

  delete $agents{$agentid,"STDINf"};
  delete $agents{$agentid,"STDOUTf"};
  delete $agents{$agentid,"STDERRf"};
  delete $agents{$agentid,"STDINb"};
  delete $agents{$agentid,"STDOUTb"};
  delete $agents{$agentid,"STDERRb"};
  delete $agents{$agentid,"STDINt"};
  delete $agents{$agentid,"STDOUTt"};
  delete $agents{$agentid,"STDERRt"};
  if (defined($agents{$agentid,"as"})) { delete $agents{$agentid,"as"}; }
  delete $agents{$agentid,"cmdPID"};
  delete $agents{$agentid,"last"};
  delete $agents{$agentid,"name"};
  delete $agents{$agentid,"onKill"};
  delete $agentids{$agentid};
}


#ttt#  ($line, $buf) = &ttt_nextline($buf);
#ttt#
#ttt#    > $buf                 the buffer a (string) to return next line from
#ttt#    < $line                the returned line
#ttt#    < $buf                 the updated buffer
#ttt#
#ttt#  A utility routine used by ttt_readline_agents. Removes the next full
#ttt#  line (as delimited by a newline) out of the buffer, updating the
#ttt#  buffer, and returns it.
#ttt#

sub ttt_nextline
{
  my ($buf) = @_;
  my ($line);
  my ($nlindex) = index($buf, "\n");
  if ($nlindex == -1) { return ($buf, ""); }
  $line = substr($buf, 0, $nlindex+1);
  $buf  = substr($buf, $nlindex+1, length($buf) - $nlindex);
  #&ttt_msg("DEBUG", "line == $line\n");
  return ($line, $buf);
}

if ($H_OS eq "SunOS")
  { $WNOHANG = 0100; }
elsif ($H_OS eq "IRIX" && $H_OSVER =~ /^5./)
  { $WNOHANG = 0100; }
else
  { $WNOHANG = 1; }

#ttt#  &ttt_agent_exits($rbits);
#ttt#
#ttt#    > $rbits            only act on agents selected by $rbits vector
#ttt#
#ttt#  For all terminated remote agents, if we saw the
#ttt#  $agents{$agentid,"statval"}, then record the agent's exit status in
#ttt#  %agentids. If $rbits in undefined, will act on all agents.
#ttt#

sub ttt_agent_exits
{
  local ($rbits) = @_;

  reapstat: foreach $agentid (keys(%agentids))
    {
      #  record the status tag (if applicable)
      #
      if ($agentids{$agentid} eq "running") { next reapstat; }
      
      #  If any agent has terminated, and we have the status tag in the
      #  special status tag buffer, that's what it really is! Record it in
      #  %agentids.
      #
      if (
          (defined($agentids{$agentid})) and
          ($agentids{$agentid} =~ /^terminated\./) and
          (defined($agents{$agentid,"statval"})) and
          ($agents{$agentid,"statval"}) and
          ((! defined($rbits)) or vec($rbits, $agents{$agentid,$H."f"}, 1))
         )
        { 
          &ttt_get_statval($agentid);
        }
    }
}


sub ttt_readline_agents_mac
{
  local($rbits, $timeout) = @_;
  local($theagentid);
  
  #  First, do we already have a line in our buffers that can satisfy the
  #  request? (The foreach loop is there for the day when we add multiple
  #  agent support).
  #
  foreach $agentid (keys(%agentids))
    {
      $theagentid = $agentid; # An egregious assumption that we have only one! 
      foreach $H ("STDERR","STDOUT")
        {
          #printf "checking buffer for --> $agentid.$H <--\n";
          if ($agents{$agentid,$H."b"} ne "")
            {
               #  Note: this assumes we never have partial lines in the
               #  buffers!
               #
              ($line, $agents{$agentid,$H."b"}) =
                &ttt_nextline($agents{$agentid,$H."b"});
                          return($line, $agentid, $H);
            }
        }
    }

  #  Now get an event...
  #
  # TBD - handle > 1 started agent someday - the following all assumes only 1:
  #
  getevent: while (1)
    {
      if (defined($eofbits)) { last getevent; }
      eval '$event = gethlevent
        (5, "TSEE", "cout", "TSEE", "cerr", "TSEE", "dump", "aevt", "ansr")';
          $agentid = $theagentid; # (for now)
      if (substr($event,0,8)  eq "aevtansr")
        {
          # An agent terminated... implies EOF on it's descriptors...
          #printf "ttt_readline_agents_mac(): pid $agentid terminated\n";
          #printf "ttt_readline_agents_mac(): event was <$event>\n"; #debug#
          $agentids{$agentid} = "terminated"; #TBD# need to get real status
          $agents{$agentid,"last"} = time;
          $eofbits = $eofbits | $agents{$agentid,"STDOUT"."t"};
          $eofbits = $eofbits | $agents{$agentid,"STDERR"."t"};
          last getevent;
        }
      ($eclass, $eid, $_) = &ttt_splitevent($event);
          if ($eid eq "cout" || $eid eq "dump")
            { $H = "STDOUT"; } else { $H = "STDERR"; }
          if (vec($rbits, $agents{$agentid,$H."f"}, 1))
            { return ($_."\n", $agentid, $H); }
          $agents{$agentid,$H."b"} = $agents{$agentid,$H."b"}.$_."\n";
        }
        
  chkeof: foreach $agentid (keys(%agentids))
    {
      #  Now, if we have dribbles left over in the buffers we've see eof on,
      #  return them (subject to the $rbits), OR return eof. (But return eof
      #  on a given descriptor ONLY once.
      #
      #  Note: Under MPW, with the current mechanism that we read input, we
      #  should be getting partial lines of output, so the "check for dribbles"
      #  part proabably isn't necessary, but it doesn't hurt anything either.
      #  And since it may be useful in the future, (depending on how multiple
      #  agent support is implemented), let's leave it in. OK?
      #
      #  I just knew you'd agree.
      #
      foreach $H ("STDERR","STDOUT")
        {
          if (vec($rbits, $agents{$agentid,$H."f"}, 1)
                && (vec($eofbits, $agents{$agentid,$H."f"}, 1)))
            {
              if (defined ($agents{$agentid,$H."b"}))
                {
                  if ($agents{$agentid,$H."b"})
                    {
                      $buf = $agents{$agentid,$H."b"};
                      # leave buffer empty, but def
                      $agents{$agentid,$H."b"} = "";
                    }
                  else
                    {
                      delete $agents{$agentid,$H."b"};
                      return (undef, $agentid, $H); # return EOF
                    }
                }
              return($buf, $agentid, $H);
            }
        }
    }

  return(""); # "timeout" return
  
}


#ttt#  ($line,$agentid,$stream) = &ttt_readline_agents($rbits,$timeout,$dontwait,$stoponerr,$partial);
#ttt#
#ttt#     >$rbits       a bit vector specifying streams to read
#ttt#     >$timeout     a timeout value is seconds; 0 = return immed.
#ttt#     >$dontwait    if defined, don't do wait for child status
#ttt#     >$stoponerr   if defined, override error code for select
#ttt#     >$partial     whether the caller will except partial lines
#ttt#     <$line        the line of output retrieved, or undef if agent is 
#ttt#                   terminated
#ttt#     <$agentid     the ID of the agent which has provided the output
#ttt#     <$stream      "STDOUT" or "STDERR" where appropriate
#ttt#                         
#ttt#  This function is used to read input from one or more of the running
#ttt#  agents, and to handle termination of agents.
#ttt#
#ttt#  If a complete line of output can be formed from one of the selected
#ttt#  agents, then it will be returned in the $line element of the
#ttt#  function value list, with $agentid and $stream ("STDOUT" or
#ttt#  "STDERR") indicating which stream the line comes from.
#ttt#
#ttt#  Otherwise, if an agent corresponding to one of the selected streams
#ttt#  has terminated, and some data (not containing a newline) from the
#ttt#  selected stream remains in the buffer, it will be returned.  in
#ttt#  $line (again with $agentid and $stream identifying the stream).
#ttt#
#ttt#  Otherwise, if an agent corresponding to one of the selected streams
#ttt#  has terminated, and no data from the selected stream remains in the
#ttt#  buffer, $line will be returned undefined as an end of file
#ttt#  indicator. (Again with $agentid and $stream identifying the stream).
#ttt#  This indication will only be returned on the first attempt to read a
#ttt#  stream after all data for the stream has been returned. (This is
#ttt#  important since it allows processing to proceed to other streams
#ttt#  which may have been selected and have a partial line buffered or a
#ttt#  pending EOF condition; otherwise, they would never get their chance
#ttt#  to return EOF.)
#ttt#
#ttt#  Otherwise, if $partial is set, and, after the expiry of the timeout
#ttt#  limit, data is present in the buffer for any of the selected streams
#ttt#  (but lacking a newline -- else it would have been returned, above),
#ttt#  then the data for one of the streams is returned.
#ttt#
#ttt#  Otherwise, $line returns "", indicating that no data was read, and nor
#ttt#  did any agent corresponding to one of the selected streams terminate,
#ttt#  within the timeout limit.
#ttt#
#ttt#  $stoponerr is used to determine how to handle errors from select.
#ttt#  Most of the time, if select returns an error, it's indicative that
#ttt#  we've been interupted by a signal and the current way we handle that
#ttt#  is by calling &ttt_notest which will exit (implicitly assuming the 
#ttt#  signal was meant to stop the works).  There can be a situation
#ttt#  where we want the ability to be interupted by a signal and not to 
#ttt#  exit - rather, we want to continue execution.  We default to the old
#ttt#  behaviour and you can override the error handling code by defining
#ttt#  that parameter.
#ttt#
#ttt#  THIS FUNCTION SHOULD BE USED FOR ALL IO READING THE OUTPUT OF
#ttt#  AGENTS. Other functions, with different calling semantics, but which
#ttt#  observe the same protocols, may be implemented in the future.
#ttt#

sub ttt_readline_agents
{
  if ($MPW) { return &ttt_readline_agents_mac(@_); };

  local ($rbits, $timeout, $dontwait, $stoponerr, $partial) = @_;
  #&ttt_msg("DEBUG", sprintf("&ttt_readline_agents(%s, %s);\n\n", @_));

  local ($buf, $line, $rout, $agentid, $cpid, $H, $selbits, $eofbits);
  local ($gotdata, $sel, $n);
  local ($rdbufsize) = 8*1024;
  local ($exstat);

  #  First, do we already have a line in our buffers that can satisfy the
  #  request?
  #
  #&ttt_msg("DEBUG", "check buffers...\n");
  foreach $agentid (keys(%agentids))
    {
      foreach $H ("STDERR","STDOUT")
        {
          if (vec($rbits, $agents{$agentid,$H."f"}, 1)
                && $agents{$agentid,$H."b"} =~ "\n")
            {
              ($line, $agents{$agentid,$H."b"}) =
                &ttt_nextline($agents{$agentid,$H."b"});
              if ($ttt_readline_nocrs) { $line =~ s/\r//g; }
              return($line, $agentid,$H);
            }
        }
    }

  #&ttt_msg("DEBUG", "check for terminated children...<$WNOHANG>\n");
  #
  #  Any terminated children?
  #  (only if $dontwait is not defined (usual case))
  #
  if (! defined($dontwait))
    {
      while (($agentid = waitpid(-1, $WNOHANG)) > 0)
        {
          $exstat = $?;
          #&ttt_msg("DEBUG", "ttt_readline_agents(): pid $agentid termed $?\n");

          if ($agents{$agentid,"stattag"} ne "local")
            { $agentids{$agentid} = "terminated.$?"; }
          else
            { $agentids{$agentid} = $exstat; }
          $agents{$agentid,"last"} = time;
        }
    }

  #&ttt_msg("DEBUG", "check ttt_agent_exits...\n");
  &ttt_agent_exits($rbits);

  #  If we have any agents who have terminated, but have not yet returned
  #  eof on both descriptors, set the select timeout to 0, since we can
  #  return an eof for sure if nothing selects for reading.
  #
  #&ttt_msg("DEBUG", "check eof s...\n");
  checkeof: foreach $agentid (keys(%agentids))
    {
      foreach $H ("STDERR","STDOUT")
        {
          if (($agentids{$agentid} ne "running")
                && (vec($rbits, $agents{$agentid,$H."f"}, 1))
                  && ($agents{$agentid,$H."b"}))
                { $timeout = 0; last checkeof; }
        }
    }

  #  If we get here, we didn't have a line already. Let's fish for a file
  #  ready to read...
  #
  $selbits = $rbits; $eofbits = "";
  #&ttt_msg("DEBUG", "go fish...\n");
  fishing: while (1)
    {
      #  $gotdata insures that we don't hang in this loop selecting on
      #  streams that only have "eof" to return!
      #
      $gotdata = 0; 
      #&ttt_msg("DEBUG", "select(\$rout = $selbits, undef, undef, $timeout)\n");
      $sel = select($rout = $selbits, undef, undef, $timeout);

      #  This stoponerr stuff was added by someone else between Magic
      #  and Netapp... ? - rmg
      #  
      if ($sel < 0)
        { 
          if (!defined($stoponerr))
            { &ttt_notest("select failed, errno = $!\n"); }
          else { next fishing; }
        }
      elsif ($sel == 0) 
        { last fishing; } # the select timed out
      else # ($sel > 0)   # there's something to read that won't block
        { 
          # somebody's ready to read... who is it?
          #
          agent: foreach $agentid (keys(%agentids))
            {
              stream: foreach $H ("STDERR","STDOUT")
                {
                  #  Anything to read on this file descriptor?
                  #
                  if (vec($rout, $agents{$agentid,$H."f"}, 1))
                    {
                      #  Now do the read....
                      #
                      #&ttt_msg("DEBUG", "read agentid=$agentid $H..."); #debug#
        
                      $buf = "";
                      if (! defined ($n =
                              sysread($agents{$agentid,$H}, $buf, $rdbufsize)))
                        {
                          if ( $H_OS eq "SunOS" && $H_OSVER =~ /^5/ )
                            { $! = &EIO; } # added by dag #
                          if (($H_OS eq "SunOS" && $H_OSVER =~ /^5/) &&
                            $! eq "I/O error")
                            {
                              # apparently, read() on Solaris will only return
                              # a zero-length read for "eof" once; after that,
                              # you get an I/O error, though select will keep
                              # returning "ready to read" until the fd is
                              # closed. Hence, we recognize this, and fake it:
                              $n = 0;
                            }
                          else { &ttt_notest("read failed, errno = $!\n"); }
                        }
                      if ($n == 0)
                        {
                          $eofbits = $eofbits | $agents{$agentid,$H."t"};
                          next stream;
                        }

                      $gotdata = 1;

                      #  OK, do we have a bogus stashed status return?
                      #  (cause it really isn't one, if more came from this
                      #  file!
                      #
                      if (($H eq "STDOUT") && $agents{$agentid,"statval"})
                        {
                          #  ...yes, so put it back in the buffer
                          $agents{$agentid,$H."b"} = 
                          $agents{$agentid,$H."b"}.$agents{$agentid,"statval"};
                          $agents{$agentid,"statval"} = "";
                        }

                      $agents{$agentid,"last"} = time; # note time of read
                      $agents{$agentid,$H."b"} = $agents{$agentid,$H."b"}.$buf;
                   
                      #  Is this the PID of the command on the remote side?
                      #
                      if (($H eq "STDOUT") &&
                          ($agents{$agentid,$H."b"}
                            =~ /ttt_cmdPID:([0-9]+)\n/) &&
                          (!defined($agents{$agentid,"cmdPID"}))
                         )
                        {
                          # yep, let's store it, and remove it from the buffer
                          $agents{$agentid,"cmdPID"} = $1;
                          $agents{$agentid,$H."b"}
                            =~ s/ttt_cmdPID:[0-9]+\n//;
                          #&ttt_msg("DEBUG",$agents{$agentid,"name"} . 
                          #            " cmdPID set to " . 
                          #            $agents{$agentid,"cmdPID"} .
                          #            "\n"
                          #         );
                        }

                      #  Could this be the special remote status return?
                      #
                      #printf "IS... <".$agents{$agentid,$H."b"}.">\n"; #debug#

                      if (($H eq "STDOUT") &&
                         ($agents{$agentid,$H."b"}
                          =~ /($agents{$agentid,"stattag"}:[0-9]+#[0-9]*\n)$/))
                        { 
                          #  ...yes, stash it in the special value buffer
                          #
                          $agents{$agentid,"statval"} = $1;
                          $agents{$agentid,$H."b"}
                          =~ s/$agents{$agentid,"stattag"}:[0-9]+#[0-9]*\n$//;
                        }

                      #  Do we now have a full line in the buffer?
                      #
                      if ($agents{$agentid,$H."b"} =~ /\n/)
                        {
                          #  we now have a line to return
                          #
                          ($line, $agents{$agentid,$H."b"}) =
                             &ttt_nextline($agents{$agentid,$H."b"});
                          if ($ttt_readline_nocrs) { $line =~ s/\r//g; }
                          return($line, $agentid, $H);
                        }
                    }
                }
            }
        }
      if (! $gotdata) { last fishing; }

      #  If we got something with partial set, then wait at most 1 second
      #  more for anything to arrive...
      #
      if ($partial && $timeout > 0) { $timeout = 1; }
    }

  #  OK. When we get here, we can't be ready to return a whole line to
  #  satisfy the request, because we'd have returned it.

  chkeof: foreach $agentid (keys(%agentids))
    {
      #  Now, if we have dribbles left over in the buffers we've see eof on,
      #  return them (subject to the rbits), OR return eof. (But return eof
      #  on a given descriptor ONLY once.
      #
      foreach $H ("STDERR","STDOUT")
        {
          if (vec($rbits, $agents{$agentid,$H."f"}, 1)
                && (vec($eofbits, $agents{$agentid,$H."f"}, 1)))
            {
              if (defined ($agents{$agentid,$H."b"}))
                {
                  if ($agents{$agentid,$H."b"})
                    {
                      $buf = $agents{$agentid,$H."b"};
                      # leave buffer empty, but def
                      $agents{$agentid,$H."b"} = "";
                    }
                  else
                    {
                      delete $agents{$agentid,$H."b"};
                      return (undef, $agentid, $H); # return EOF
                    }
                }
          if ($ttt_readline_nocrs) { $buf =~ s/\r//g; }
              return($buf, $agentid, $H);
            }
        }
    }

  #
  #
  if ($partial)
    {
      chkpartail: foreach $agentid (keys(%agentids))
        {
          #  If we have partial lines in the buffer for any selected stream,
          #  return *it*...
          #
          foreach $H ("STDERR","STDOUT")
            {
              if (vec($rbits, $agents{$agentid,$H."f"}, 1))
                {
                  if (defined ($agents{$agentid,$H."b"}))
                    {
                      if ($agents{$agentid,$H."b"})
                        {
                          $buf = $agents{$agentid,$H."b"};
                          # leave buffer empty, but def
                          $agents{$agentid,$H."b"} = "";
                      if ($ttt_readline_nocrs) { $buf =~ s/\r//g; }
                          return($buf, $agentid, $H);
                        }
                    }
                }
            }
        }
    }
  return(""); # timeout return
}


#ttt#  &ttt_wait_agent($agentid);
#ttt#
#ttt#    > $agentid             the pid (agent id) of the agent to wait for.
#ttt#    < void                 the pid (agent id) of the agent to wait for.
#ttt#
#ttt#  This routine can be used to insure that an agent has terminated,
#ttt#  and had its exit status recorded in $agents{$agentid,"statval"}.
#ttt#

sub ttt_wait_agent
{
  my ($agentid) = @_;
  my ($pid, $exstat);
  
  if ($MPW) { return; } # Maybe wait until all EOFS someday...

  &ttt_agent_exits;

  #&ttt_msg("DEBUG", "ttt_wait_agent():  waitpid($agentid, 0)\n"); #debug#
  #&ttt_msg("DEBUG", "ttt_wait_agent():  stattag: <$agents{$agentid,'stattag'}>...\n");

  #ttt#  Wait for the agent...
  #ttt#
  $pid = waitpid($agentid, 0);
  $exstat = $?;

  #ttt#  Had it already been reaped?
  #ttt#
  if ($pid != $agentid)
    {
      #printf "ttt_wait_agent(): no such agent\n"; #debug#

      #ttt#  Yes; if it was remote, see if we can get the status for it;
      #ttt#      if ($agentids{$agentid} =~ /^terminated/) 
        {
          #ttt#  In case the remote sh never really ran, use the rsh exit
          #ttt#  status, which was saved in $agentids{$agentid} as
          #ttt#  "terminated.<status>".
          #ttt#
          $agentids{$agentid} =~ s/^terminated.//;

          #ttt#  Now, if we -did- see the special status tag line, use it.
          #ttt#
          if ($agents{$agentid,"statval"})
            { &ttt_get_statval($agentid); }
        }

      #ttt#  If the agent was local, we already saved the exist status;
      #ttt#  nothing more to do!
      #ttt#
    }
  else #ttt#  We just reaped the agent.
    {
      $agents{$agentid,"last"} = time;

      if ($agents{$agentid,"stattag"} eq "local")
        #ttt#
        #ttt#  For local agents, it's simply the status returned by waitpid...
        #ttt#  
        { $agentids{$agentid} = $exstat; }
      else
        {
          #ttt#  But for remotes, it depends on whether we have the
          #ttt#  special status tag line...
          #ttt#
          if ($agents{$agentid,"statval"})
            #ttt#
            #ttt#  If so, use it!
            #ttt#
            { &ttt_get_statval($agentid); }
          else
            #ttt#
            #ttt#  Otherwise, just use the waitpid return
            #ttt#
            { $agentids{$agentid} = $exstat; }  #ttt# otherwise, use 
        }
    }
}



#ttt#  $rbits = &ttt_read_agents
#ttt#             ($rbits,[$timeo,[$online,[$oneof,[$ontimeo,[$dontwait,[$partial,
#ttt#              [$expectre,[$nixpectre,[$expectimeo,[$checkRbits,[$mode]]]]]]]]]]);
#ttt#
#ttt#  $rbits = &ttt_read_agents(\%params);
#ttt#
#ttt#    > \%params             reference to a hash which specifies the parameters by name
#ttt#
#ttt#    > $rbits               a bit vector specifying streams to read
#ttt#    > $timeo               the timeout (secs) value between agent output
#ttt#    > $online              text to be eval'ed in the loop for lines read
#ttt#    > $oneof               text to be eval'ed in the loop for eof
#ttt#    > $ontimeo             text to be eval'ed in the loop for timeouts
#ttt#    > $dontwait            if defined, don't wait for child to change status
#ttt#    > $partial             accept partial line date
#ttt#    > $expectre            "expect" text we're looking for
#ttt#    > $nixpectre           if $expectre ne "" && this matches, return (-1, $line)
#ttt#    > $expectimeo          total timeout interval, in seconds. (Also applies
#ttt#                           if set in non "expect" mode)
#ttt#    > $checkRbits          rbits for agents which are to be checked, but which do
#ttt#                           not impact the continuation of the while loop (below)
#ttt#    > $mode                the mode in which this function should operate
#ttt#    < ($rbits, @ret)       the $rbits vector, reflecting any eof files
#ttt#
#ttt#      Note: the practice of having $online contain code doing return()s
#ttt#      has become pervasive, despite the fact that the original
#ttt#      interface did not allow this. Unfortunately, this broke when we
#ttt#      converted to perl5, since in perl5 return in an eval simply
#ttt#      terminates the eval - it does *not* blow back to the caller of
#ttt#      the routine that is doing the eval, as it did in perl4. To
#ttt#      accomodate this, and as a general improvement in the service,
#ttt#      $online (etc) can now contain a string naming a function to be
#ttt#      called-back into. If this function wishes to do a "blow back"
#ttt#      return, it need merely return a list containing a defined first
#ttt#      element (but, the "blow-back" return list will have $rbits first!)
#ttt#      If it wishes ttt_read_agents to continue, it should
#ttt#      return an undef.
#ttt#
#ttt#  This routine encapsulates the while { ttt_readline_agents } loop
#ttt#  commonly used to read the output of one or more agents until all have
#ttt#  returned eof on a set of file descriptors. Since the basic structure
#ttt#  of the loop is the same, but the particular actions desired when a
#ttt#  line is read, an eof is encountered, or the ttt_readline_agents()
#ttt#  times out, these actions can be specified as text to exec in the $on*
#ttt#  arguments.
#ttt#
#ttt#  Only the $rbits argument is mandatory; the remaining arguments can be
#ttt#  elided (or passed as "undef"), to get the following defaults:
#ttt#
#ttt#    $timeo       30 seconds
#ttt#    $online:     print the line read (using ttt_msg())
#ttt#    $oneof:      print an eof notice identifying the descriptor returning eof
#ttt#    $ontimeo:    print a "timeout" message (but doesn't exit the loop).
#ttt#    $dontwait:   do wait for the child process to change status
#ttt#    $partial:    false (require full line output from agents)
#ttt#    $expectre:   do "expect" pattern matching
#ttt#    $nixpectre:  don't do "expect" pattern matching
#ttt#    $expectimeo: undef...: if $expectre is undef (or ""), the first $timeo
#ttt#                           timeout will terminate the "expect";
#ttt#                           otherwise, no effect.
#ttt#    $mode:       0 : old-style (see below)
#ttt#
#ttt#  More explanation of unusual parameters:
#ttt#    $checkRbits: rbits which correspond to agents to display output from, but
#ttt#                 which do not count w/r/t determining whether the subroutine
#ttt#                 should continue to try to grab more output from any agents.
#ttt#
#ttt#  ttt_read_agents now has the concept of modes which dictate its behavior.
#ttt#  here are the current modes:
#ttt#    0 (undef) : This mode, also known as "original flavor," will preserve
#ttt#                the original functionality of ttt_read_agents.  Features of
#ttt#                this mode are actually better defined by other modes, and how
#ttt#                they differ from this mode.
#ttt#
#ttt#    1         : This mode, known as "Traffic Cop Mode," will impose strict
#ttt#                timeout rules on the monitored agents.  It differs from
#ttt#                original flavor in that the passed timeout value is considered
#ttt#                to be the maximum allowable run time for the function.  In
#ttt#                original flavor, timeouts only occur when nothing is heard
#ttt#                from the agent in the specified interval.  If a value is passed
#ttt#                in the $expectimeo parameter, that value will be the time
#ttt#                limit for the function, with periodic timeouts every $timeo
#ttt#                seconds (like original flavor).
#ttt#
#ttt#    2         : This mode, known as "L.A. Traffic Cop Mode," is really a
#ttt#                modification to mode 1.  Mode 1 will just cause a return
#ttt#                from the function if the loop times out.  This mode will
#ttt#                instead kill any agents specified in the $rbits parameter
#ttt#                which have timed out before returning.
#ttt#
#ttt#  Return values:
#ttt#    - $rbits will always be returned, with the terminated agents' rbits masked
#ttt#      out where appropriate
#ttt#    - @ret is the relatively strange return value:
#ttt#      - $ret[0] == 0  => failure
#ttt#      - $ret[0] == -1 => $nixpectre matched, $ret[1] contains the matched line
#ttt#      - $ret[0] == 1  => $expectre matched, $ret[1] contains the matched line
#ttt#
sub ttt_read_agents
{
  local($rbits, $timeo, $online, $oneof, $ontimeo, 
            $dontwait, $partial, $expectre, $nixpectre, 
            $expectimeo, $checkRbits, $mode) = @_;
  local($line, $stream, $agentid, $H, @ret);
  my($expectimer, $time_to_stop);

  if (ref($_[0]) eq "HASH")  # all parameters passed in a hash instead of a list
    {
       $rbits = ${$_[0]}{rbits};
       $timeo = ${$_[0]}{timeo};
       $online = ${$_[0]}{online};
       $oneof = ${$_[0]}{oneof};
       $ontimeo = ${$_[0]}{ontimeo};
       $dontwait = ${$_[0]}{dontwait};
       $partial = ${$_[0]}{partial};
       $expectre = ${$_[0]}{expectre};
       $nixpectre = ${$_[0]}{nixpectre};
       $expectimeo = ${$_[0]}{expectimeo};
       $checkRbits = ${$_[0]}{checkRbits};
       $mode = ${$_[0]}{mode};
    }  

  if (!defined($checkRbits)) { $checkRbits = ""; }

  my ($new_rbits) = $rbits | $checkRbits;

  if (! defined($timeo)) { $timeo = 30; }

  if (! defined($online))
    { $online="&ttt_msg(\$agents{\$agentid,\"name\"}, \"\$stream: \$line\");"; }

  if (! defined($oneof))
    { $oneof = "&ttt_msg(\$agents{\$agentid,\"name\"}, \"\$stream: EOF\\n\");"; }

  if (! defined($ontimeo))
    { $ontimeo="&ttt_msg(\" \", \"timeout\n\")"; }

  if (! defined($expectre)) { $expectre = ""; } 

  if (! defined($nixpectre)) { $nixpectre = ""; }

  if (! defined($mode)) { $mode = 0; }

  if (! defined($expectimeo) and (($mode == 1) or ($mode == 2)))
    {
      $expectimeo = $timeo;
    }

  # make sure that $checkRbits is 0 padded to the correct length
  # to match $new_rbits as a string
  if (defined($checkRbits))
    {
      my $length = length(unpack("b*",$new_rbits));
      $checkRbits = pack("b$length",unpack("b*",$checkRbits));
    }

  $expectimer = 0;

  if (($mode == 1) or ($mode == 2))
    {
      #  okay, let's make sure this darn thing times out after the
      #  specified interval, rather than if it receives no output from
      #  any agents in the specified interval.
      $time_to_stop = time + $expectimeo;
    }

  #  The somewhat obfuscated approach to doing the "return @ret" is a
  #  workaround for our favorite perl5.001e bug (see the comment
  #  containing /perl5/ in tttLib.pl)
  #
  reader: while (! defined($ret[0]))
    {
      if (($mode == 1) or ($mode == 2))
        {
          if (($time_to_stop - time) < $timeo) { $timeo = $time_to_stop - time; }

          if ($timeo > 0)
            {
              ($line, $agentid, $stream) = &ttt_readline_agents($new_rbits, $timeo, $dontwait, undef, $partial);
            }
          elsif ($mode == 1) { @ret = (0); last reader; }
          elsif ($mode == 2)  # kill off any agents which we don't want anymore
            {
              my (@doomed_pids);
    
              # don't want to kill the agents we didn't expect to die
              $new_rbits &= $rbits;  # so, we select only those in rbits left in new_bits
    
              findopen: foreach $agentid (keys(%agentids))
                {
                  if (vec($new_rbits, $agents{$agentid,"STDOUTf"}, 1) or
                      vec($new_rbits, $agents{$agentid,"STDERRf"}, 1))
                    {
                      push @doomed_pids, $agentid;
                    }
                }
    
              if (defined(@doomed_pids))
                {
                  &ttt_msg("info","MOO HA HA!, killing " . join(",",@doomed_pids) . "\n");
                  # kill them off, but let the caller call ttt_close_agent on each
                  &ttt_kill_agents("KILL", @doomed_pids);  # KILL might be a bit harsh
                }
    
              @ret = (0); last reader;
            }
        }
      else  # original flavor
        {
          ($line, $agentid, $stream) = &ttt_readline_agents($new_rbits, $timeo, $dontwait, undef, $partial);
        }

      if (! defined($line)) # a stream was terminated (an agent finished)
        {
          my $tmp_rbits;

          #&ttt_msg(
          #           "DEBUG","stream was terminated, name: ".
          #           $agents{$agentid,"name"}.
          #           ", stream: ".
          #           $stream.
          #           "\n"
          #        );

          # this will pull out agents from checkRbits if they end first, and
          # although this was never the intention of checkRbits, I should handle
          # it properly.  However, if I don't mask out bits from checkRbits,
          # new_rbits will become useless if an agent in checkRbits ends.
          #     - mlewin 1998/01/16
          $new_rbits = $new_rbits ^ $agents{$agentid, $stream."t"};

          if (defined(&$oneof)) { @ret = &$oneof(); }
          else { eval $oneof; }

          # if all of the agents we care about have stopped spewing, leave reader
          if (defined($checkRbits))  # mask out the bits we are just checking
            {
              $tmp_rbits = $new_rbits & ~$checkRbits;
            }
          else { $tmp_rbits = $new_rbits; }

          if ($tmp_rbits eq ($tmp_rbits ^ $tmp_rbits)) { last reader; }
        }
      elsif ($line ne "")  # got a line of text
        {
          if ($expectre ne "")
            {
              if ($line =~ /$expectre/)                       { @ret = (1, $line); }
              elsif ($nixpectre ne "" && $line =~ $nixpectre) { @ret = (-1, $line); }
              else { $expectimer = 0; }
           }
          elsif ($rbits & $agents{$agentid, $stream."t"}) { $expectimer = 0; }

          if ($partial && $line !~ /\n$/) { $line .= "\n"; }

          if (defined(&$online)) { @ret = &$online(); }
          else { eval $online; }
        }
      else  # the return was a timeout
        {
          if ($mode == 0) { $expectimer += $timeo; }

          if ($expectre ne "")
            {
              if ($expectimer >= $expectimeo)
                { @ret = (0); }
            }
          else
            {
               if ($mode == 0)
                 {
                   if (defined($expectimeo))
                     {
                       if ($expectimer >= $expectimeo)
                         { @ret = (0); last reader; }
                     }
                 }

              if (defined(&$ontimeo)) { @ret = &$ontimeo(); }
              else { eval $ontimeo; }
            }
        }

      if (defined($ret[0])) { last reader; }

      findopen: foreach $agentid (keys(%agentids))
        {
          foreach $H ("STDERR","STDOUT")
            { if (vec($new_rbits, $agents{$agentid,$H."f"}, 1)) { next reader; } }
        }

      last reader; 
    }

  if (defined($checkRbits))  # mask out the bits we are just checking
    {
      $rbits = $new_rbits & ~$checkRbits;
    }
  else { $rbits = $new_rbits; }

  return ($rbits, @ret);
}


#ttt#  ($status[, $output]) = &ttt_rexec($hostname, $cmd, [$tell, [$timeo,
#ttt#                          [$online, [$oneof, [$ontimeo, [$as, [$ltimeo,
#ttt#                          [$checkRbits, [$mode, [$name]]]]]]]]]]);
#ttt#
#ttt#  ($status[, $output]) = &ttt_rexec(\%params);
#ttt#
#ttt#    > \%params             reference to a hash which specifies the parameters by name
#ttt#
#ttt#    > $hostname            the name of the host on which run the process
#ttt#    > $cmd                 is a shell command to be executed
#ttt#    > $tell                tell the world what we're starting (boolean)
#ttt#    > $timeo               max time (secs) to wait for command output
#ttt#    > $online              arguments to be passed to &ttt_read_agents  
#ttt#    > $oneof                 (see above)
#ttt#    > $ontimeo               ""        ""
#ttt#    > $as                  argument to ttt_start_agent
#ttt#    > $ltimeo              argument to ttt_read_agents
#ttt#    > $checkRbits            ""        ""
#ttt#    > $mode                  ""        ""
#ttt#    > $name                argument to ttt_start_agent
#ttt#    < $status              the exit status of the command
#ttt#    < $output              the output (stdout + stderr) of the command;
#ttt#                           will be valid if $online is undef
#ttt#
#ttt#  This routine can be used to run a command on a test target system.
#ttt#  It's intended for situations where you just want run a single shell
#ttt#  command, and aren't interested in demultiplexing or interpreting the
#ttt#  output (at least, within ttt_rexec())
#ttt#
#ttt#  Only the $hostname and $cmd arguments are mandatory; the remaining
#ttt#  arguments can be elided (or passed as "undef"), to get the following
#ttt#  defaults:
#ttt#
#ttt#    $tell          1 (true)
#ttt#    $timeo         (default value in ttt_read_agents())
#ttt#    $online        (default value in ttt_read_agents())
#ttt#    $oneof         (default value in ttt_read_agents())
#ttt#    $ontimeo       (default value in ttt_read_agents())
#ttt#    $as            (default value in ttt_start_agent())
#ttt#    $ltimeo        (default value in ttt_read_agents())
#ttt#    $checkRbits    (default value in ttt_read_agents())
#ttt#    $mode          (default value in ttt_read_agents())
#ttt#

sub ttt_rexec
{
  local ($hostname, $cmd, $tell, $timeo, $online, $oneof, $ontimeo, $as, 
             $ltimeo, $checkRbits, $mode, $name) = @_;
  local ($agentid, $rbits, $status);
  local ($output) = "";

  if (ref($_[0]) eq "HASH")  # all parameters passed in a hash instead of a list
    {
       $hostname = ${$_[0]}{hostname};
       $cmd = ${$_[0]}{cmd};
       $tell = ${$_[0]}{"tell"};
       $timeo = ${$_[0]}{timeo};
       $online = ${$_[0]}{online};
       $oneof = ${$_[0]}{oneof};
       $ontimeo = ${$_[0]}{ontimeo};
       $as = ${$_[0]}{as};
       $ltimeo = ${$_[0]}{ltimeo};
       $checkRbits = ${$_[0]}{checkRbits};
       $mode = ${$_[0]}{mode};
       $name = ${$_[0]}{name};
    }  

  if (! defined($online))
    { $online="&ttt_msg(\$agents{\$agentid,\"name\"}, \"\$stream: \$line\"); \$output .= \$line"; }

  if (! defined($tell)) { $tell = 1; }

  if (! defined($ltimeo)) { $ltimeo = $timeo; }

  $agentid = &ttt_start_agent($hostname, $cmd, $tell, $as, $name);
  $rbits = $agents{$agentid,"STDOUTt"} | $agents{$agentid,"STDERRt"};

  ($rbits, @ret) = 
     &ttt_read_agents($rbits, $timeo, $online, $oneof, $ontimeo,
                        undef, undef, undef, undef, $ltimeo, $checkRbits, $mode);

  if ($#ret == 0 && $ret[0] == 0)
    {
      #  It timed out - kill it! kill it!
      #  (May want to try SIGTERM first to be polite some day!)
      #
      &ttt_kill_agents("KILL", $agentid);

      $status = 1;
    }

  $status |= &ttt_close_agent($agentid);

  if ($output ne "")
    { return ($status, $output); }
  else
    { return ($status); }
}


#ttt#  ($status[, $output]) = &ttt_rexec_windows($unixhostname, $windowshostname, $cmd,
#ttt#                           [$tell, [$timeo, [$online, [$oneof, [$ontimeo, [$as, 
#ttt#                           [$ltimeo, [$checkRbits, [$mode, [$name]]]]]]]]]]);
#ttt#
#ttt#  ($status[, $output]) = &ttt_rexec_windows(\%params);
#ttt#
#ttt#    > \%params             reference to a hash which specifies the parameters by name
#ttt#
#ttt#    > $unixhostname        the name of the UNIX host which r-shells to the windows machine
#ttt#    > $windowshostname     the name of the Windows host which executes the command
#ttt#    > $cmd                 is a shell command to be executed
#ttt#    > $tell                tell the world what we're starting (boolean)
#ttt#    > $timeo               max time (secs) to wait for command output
#ttt#    > $online              arguments to be passed to &ttt_read_agents  
#ttt#    > $oneof                 (see above)
#ttt#    > $ontimeo               ""        ""
#ttt#    > $as                  argument to ttt_start_agent
#ttt#    > $ltimeo              argument to ttt_read_agents
#ttt#    > $checkRbits            ""        ""
#ttt#    > $mode                  ""        ""
#ttt#    > $name                argument to ttt_start_agent
#ttt#    < $status              the exit status of the command
#ttt#    < $output              the output (stdout + stderr) of the command;
#ttt#                           will be valid if $online is undef
#ttt#
#ttt#  This routine can be used to run a command on a windows test system via a path
#ttt#  through a UNIX host.  This routine is very similar to ttt_rexec (above),
#ttt#  so what Richard put there applies here.
#ttt#
#ttt#  The windows machine must have a RSHD on it.
#ttt#
#ttt#  Currently, the windows machine must have SPAWNER.EXE in it's C:\TTT directory.
#ttt#
#ttt#  Only the $unixhostname, $windowshostname, and $cmd arguments are mandatory; the remaining
#ttt#  arguments can be elided (or passed as "undef"), to get the following
#ttt#  defaults:
#ttt#
#ttt#    $tell          1 (true)
#ttt#    $timeo         (default value in ttt_read_agents())
#ttt#    $online        (default value in ttt_read_agents())
#ttt#    $oneof         (default value in ttt_read_agents())
#ttt#    $ontimeo       (default value in ttt_read_agents())
#ttt#

sub ttt_rexec_windows
{
  local ($unixhostname, $windowshostname, $cmd, $tell, $timeo, $online, $oneof, 
             $ontimeo, $as, $ltimeo, $checkRbits, $mode, $name) = @_;
  local (%param_hash);
  local ($status);
  local ($output) = "";

  if (ref($_[0]) eq "HASH")  # parameters passed in a hash
    {
      my ($key,$value);

      # first copy the whole hash
      while (($key,$value) = each %{$_[0]}) { $param_hash{$key} = $value; }

      $param_hash{hostname} = $param_hash{unixhostname};
      $param_hash{cmd} = "rsh " . $param_hash{windowshostname} . " '<[DOS]>' C:\\\\TTT\\\\SPAWNER.EXE " . $param_hash{cmd};

      delete $param_hash{unixhostname};
      delete $param_hash{windowshostname};

      ($status, $output) =
            &ttt_rexec(\%param_hash);
    }
  else  # params passed as a list (normal), so cut up the list and use it the way we want
    {
      ($status, $output) = 
            &ttt_rexec($unixhostname, "rsh $windowshostname '<[DOS]>' C:\\\\TTT\\\\SPAWNER.EXE $cmd", @_[3..$#_]);
    }

  if($output eq "") # we should always have output
    {
      &ttt_msg("error","no output from ttt_rexec_windows\n");
      return(-1);
    }

  # split the output into separate lines, then find the SPAWNER return code
  @lines = split(/\n+/,$output);

  for($index = 0; $index <= $#lines; $index++)
    {
      if($lines[$index] =~ /\*SPAWNER\*:(.+)$/)
        {
          $status = $1;
#         $index = $#lines + 1;   # this assumes that *SPAWNER*:x is always the last line we care about
        }
      else    # build a list of lines that come before the return code
        {   
          @outputlines = (@outputlines,$lines[$index]);
        }
    }

  $output = join("\n",@outputlines);    # join the lines back into a string

  return($status,$output);
}


#ttt#  $status = &ttt_rprog($hostname, $path, $args, [$tell, [$timeo, [$online,
#ttt#                         [$oneof, [$ontimeo, [$as, [$ltimeo, [$checkRbits,
#ttt#                         [$mode, [$name]]]]]]]]]]);
#ttt#
#ttt#  $status = &ttt_rprog(\%params);
#ttt#
#ttt#    > \%params             reference to a hash which specifies the parameters by name
#ttt#
#ttt#    > $hostname            the name of the host on which run the process
#ttt#    > $path                pathname (on the controller) to the script
#ttt#    > $args                arguments to be passed to the script
#ttt#    > $tell                tell the world what we're starting (boolean)
#ttt#    > $timeo               max time (secs) to wait for command output
#ttt#    > $online              arguments to be passed to &ttt_read_agents  
#ttt#    > $oneof                 (see above)
#ttt#    > $ontimeo
#ttt#    > $as
#ttt#    > $ltimeo              argument to ttt_read_agents
#ttt#    > $checkRbits            ""        ""
#ttt#    > $mode                  ""        ""
#ttt#    > $name                argument to ttt_start_agent
#ttt#    < $status              the exit status of the command
#ttt#
#ttt#  Copies a program from the ttt controller to a ttt target, executes it,
#ttt#  then removes it. This was initially created in order to assist with
#ttt#  administrative tasks to be done on the target systems, since it is
#ttt#  easier to develop and debug such scripts on a target system, and they
#ttt#  run faster than if individual commands were to be coded as &ttt_rexec()
#ttt#  calls.
#ttt#
#ttt#  Note that the script is copied using the uid of the user running the
#ttt#  perl program, but the "$as" parameter is honored when the script is
#ttt#  run on the remote host.
#ttt#

sub ttt_rprog
{
  local ($hostname, $path, $args, $tell, $timeo, $online, $oneof, $ontimeo, $as,
             $ltimeo, $checkRbits, $mode, $name) = @_;
  local ($progname, $rpath, $status);

  if (ref($_[0]) eq "HASH")  # all parameters passed in a hash instead of a list
    {
       $hostname = ${$_[0]}{hostname};
       $path = ${$_[0]}{path};
       $args = ${$_[0]}{args};
       $tell = ${$_[0]}{"tell"};
       $timeo = ${$_[0]}{timeo};
       $online = ${$_[0]}{online};
       $oneof = ${$_[0]}{oneof};
       $ontimeo = ${$_[0]}{ontimeo};
       $as = ${$_[0]}{as};
       $ltimeo = ${$_[0]}{ltimeo};
       $checkRbits = ${$_[0]}{checkRbits};
       $mode = ${$_[0]}{mode};
       $name = ${$_[0]}{name};
    }  

  ($progname = $path) =~ s%^.*/%%;
  $rpath = "/tmp/$progname.$myhostname.$$";

  ($status) = &ttt_rexec ($myhostname, "rcp $path $hostname:$rpath",
                            undef, undef, undef, "");
  if ($status != 0)
    {
      &ttt_msg(STDERR, "error",
         "ttt_rprog(): can't copy program to remote host\n");
      return ($status);
    }

  ($status) = &ttt_rexec($hostname, "$rpath $args", $tell, $timeo, $online,
                $oneof, $ontimeo, $as, $ltimeo, $checkRbits, $mode, $name);

  &ttt_rexec($hostname, "rm -f $rpath",
    $tell, $timeo, $online, $oneof, $ontimeo);

  return ($status);
}


sub ttt_send_agent
{
  local ($agentid, $msg, $localftp) = @_;
  local ($stdin_h) = $agents{$agentid, "STDIN"};
  
  &ttt_msg($agents{$agentid,"name"}, "STDIN>  $msg");
  &ttt_msg($stdin_h, "-q", $msg);
  if ($localftp) { &ttt_msg($stdin_h, "", "quote XXXX\n"); }
}


#ttt#
#ttt#  ($rbits, [$matched, $expline]) =
#ttt#     &ttt_int_agent($agentid, $rbits, $send, $expect[, $nixpect, [$timeo[, $partial[, $localftp]]]]);
#ttt#
#ttt#    > $agentid             the agent id of the agent to talk to
#ttt#    > $rbits               the rbits for this agent
#ttt#    > $send                string to write to the agent's stdin
#ttt#    > $expect              regexp to wait for from the agent
#ttt#    > $nixpect             regexp, which if seen, is a fail (not applicable w/$localftp)
#ttt#    > $timeo               the out interval
#ttt#    > $partial             whether the agent can send partial line output
#ttt#    > $localftp            is this a "client local" command to an ftp?
#ttt#    < $rbits               possibly (if an eof seen) revised $rbits value
#ttt#    < $matched             boolean; true if the $expect regexp was seen
#ttt#    < $expline             line that matched $expect
#ttt#
#ttt#  This routine is used by a test that needs to interact with an agent on
#ttt#  a line-line basis. Since ttt_read_agents() can return before the agent
#ttt#  has terminated or returned eof on both descriptors, the possibly
#ttt#  modified (if an eof -was- seen) $rbits is passed back to the caller.
#ttt#
#ttt#  The $send string is sent to the agent's stdin. If it is
#ttt#  undefined or null, no string is sent. The string must contain a
#ttt#  leading "<", or ">".  If it has the leading "<", then the $send
#ttt#  string is sent immediately, and then ttt_int_agent begins
#ttt#  scanning for the $expect pattern. If $send has the leading ">",
#ttt#  then the $send string is sent only after (and only if) the
#ttt#  $expect pattern (typically, a prompt) has been seen.
#ttt#
#ttt#  The $expect string is a regular expression; the agents output is
#ttt#  monitored, and if it is seen before the timeout expires, the $matched
#ttt#  returns true and $expline passes the string that matched back to the
#ttt#  caller. If $expect is undefined, then the $send string (which must be
#ttt#  of the "<..." form) is sent, and then &ttt_int_agent returns ($rbits)
#ttt#  immediately.
#ttt#
#ttt#  The special boolean $localftp is provided to allow a workaround for
#ttt#  the unfortunate fact that ftp (when run as an agent, no tty), buffers
#ttt#  all of its output between the outputs of "-v" messages from the
#ttt#  remote server. When $localftp is set, the $send string is followed by
#ttt#  a "quote xxxx\n", used to force a response from the server, and thus
#ttt#  to flush the client's stdout. The "500 'X": command not understood."
#ttt#  response to the "cd .\n" is -not- output (unlike all other messages
#ttt#  read from the agent).
#ttt#

sub ttt_int_agent
{
  local ($agentid, $rbits, $send, $expect, $nixpect, $timeo, $partial, $localftp) = @_;
  local ($stdin_h) = $agents{$agentid, "STDIN"};
  local ($expline, $ontimeo, $matched);
  
  #&ttt_msg("DEBUG","&ttt_int_agent\n");

  if ($partial && $localftp)
    {
      &ttt_msg(STDERR, "error",
        "ttt_int_agent(): both \$localftp and \$partial?\n");
      return($rbits, 0);
    }

  #  Set the overall timeout time
  #
  if (defined($timeo))
    { $expectimeo = $timeo; } else { $timeo = $expectimeo = 200; }

  #  Set the ttt_readline_agents timeout time. We use "1" if partial is
  #  set, otherwise, its the same as $expectimeo
  #
  if ($partial) { $timeo = 1; }

  if ($send =~ /^</)
    { $send =~ s/^<//; &ttt_send_agent($agentid, $send, $localftp); }

  if (! defined $expect) { return($rbits); }

  if ($localftp)
    {
      #  For the localftp case, we know that $partial is false, so we can
      #  use this older approach, where the matching is done in our passed
      #  $online...
      #
      $online = <<EOS;
         if (\$localftp && (\$line =~ /^500 .*XXXX/))
           { last reader; }
         if (! (\$line =~ /^500 .*XXXX/))
           { &ttt_msg(\$agents{\$agentid,\"name\"}, "\$stream: \$line"); }
         if (\$expect ne "" && \$line =~ /\$expect/)
           { 
             \$matched = 1; \$expline = \$line;
             if (! \$localftp) { last reader; }
           }
EOS
      $ontimeo="&ttt_msg(\" \", \"timeout\n\"); \$matched=0; last reader";
      $matched = 0;
      $rbits = &ttt_read_agents($rbits, $timeo, $online, undef, $ontimeo);

    }
  else
    {
      #  For non localftp cases, $partial may be true, so we use the newer
      #  expectre feature of ttt_read_agents, and let it do the dirtywork
      #  in its usual inimicable fashion...
      #
#&ttt_msg("DEBUG", "&ttt_read_agents expect <$expect> nixpect <$nixpect>\n");
#if (defined($nixpect))
#  { &ttt_msg("DEBUG", "nixpect defined\n"); } 
#else
#  { &ttt_msg("DEBUG", "nixpect undefined\n"); } 

      ($rbits, $matched, $expline)
         = &ttt_read_agents
             ($rbits, $timeo, undef, undef, undef, 0, $partial, $expect, $nixpect, $expectimeo);
    }

  if ($send =~ /^>/ && $matched)
    { $send =~ s/^>//; &ttt_send_agent($agentid, $send, $localftp); }

  return($rbits, $matched, $expline);
}


#ttt#  $status =
#ttt#     &ttt_system($host, $cmd[, $timeo[, $online[, $oneof[, $ontimeo]]]]);
#ttt#
#ttt#    > $host        The host to execute $cmd on
#ttt#    > $cmd         The command to execute
#ttt#    > $timeo ... $ontimo   Args for &ttt_read_agents()
#ttt#    < $status      The exit status of $cmd
#ttt#
#ttt#  Use this to execute a command on some host. Pass in args for $timeo,
#ttt#  $online, $oneof, and $ontimeo to override the defaults provided by
#ttt#  &ttt_read_agents. Thus, by default, the command output will be logged;
#ttt#  but if you want to examine it, you should override the default by
#ttt#  defining $online to do what you want. Uses private $rbits, so it
#ttt#  doesn't interact with any other agents.
#ttt#

sub ttt_system
{
  local ($host, $cmd, $timeo, $online, $oneof, $ontimeo) = @_;
  local ($status, $rbits);

  $id = &ttt_start_agent($host, $cmd, 1);
  $rbits = $agents{$id,"STDOUTt"} | $agents{$id,"STDERRt"};
  &ttt_read_agents($rbits, $timeo, $online, $oneof, $ontimeo);
  $status = &ttt_close_agent($id);
  return $status;
}


sub ttt_kill_agents
{
  my ($sig, @pids) = @_;
  my $pid;
  my $pids;

  foreach $pid (@pids)
    { 
      if (defined($agents{$pid,"onKill"}))  # take special action
        {
          my $onKill = $agents{$pid,"onKill"};
          my $tmpMsg = "to kill $pid";

          if (defined($agents{$pid,"name"}) and $agents{$pid,"name"} ne $pid)
            {
              $tmpMsg .= "(". $agents{$pid,"name"} . ")";
            }

          $tmpMsg .= ":\n$onKill\n";

          &ttt_msg("kill",$tmpMsg);

          eval $onKill;

          if ($@ ne "") { &ttt_msg("evalerr", "$@\n"); }

          next;
        }
      elsif ($agents{$pid,"stattag"} =~ /remote/)
        {
          # this was remotely executed, kill the child pid as well
          my $stattag = $agents{$pid,"stattag"};
          my ($host) = ($stattag =~ /[0-9]+:.+:(.+)/);
          my ($new_sig) = ($sig =~ /-(.+)/);
          my $remote_PID = $agents{$pid,"cmdPID"};
          my ($as) = $agents{$pid,"as"};

          if (defined($remote_PID))
            {
              &ttt_rexec(
                         $host, "kill -$sig $remote_PID", undef,
                         undef, undef, undef, $as
                        );
            }
        }

      if (defined($pids)) { $pids .= ", "; } 
      $pids .= $pid;

      if (defined($agents{$pid,"name"}) and $agents{$pid,"name"} ne $pid) 
        { 
          $pids .= "(" . $agents{$pid,"name"} . ")";
        }
    }

  if (defined($pids)) { &ttt_msg("kill", "kill $sig $pids\n"); }
  
  kill $sig, @pids;
}


#ttt#  ($status, $output) = 
#ttt#     &ttt_xorbust($host, $cmd[, $buststatus]);
#ttt#
#ttt#    > $host        The host to execute $cmd on
#ttt#    > $cmd         The command to execute
#ttt#    > $buststatus      The exist status (if command fails)
#ttt#    < $output      The output from $cmd
#ttt#
#ttt#  Use this to execute a command on some host, and exit the test
#ttt#  driver if the command fails (nonzero exist status). This is
#ttt#  typically used for setting up preconditions to actually running
#ttt#  test cases, i.e., the failure typically results in a notest
#ttt#  exit from the driver. 
#ttt#

sub ttt_xorbust
{
  local($onhost, $cmd, $buststatus) = @_;
  local($output);

  if (! defined($buststatus)) { $buststatus = "notest"; }
  ($status, $output) = &ttt_rexec($onhost, $cmd);
  if ($status) { &ttt_exit($buststatus); }
  return ($output);
}


###########################################################################
#
#  case_* functions
#
#  These are utilities for doing send/expect-style test cases...
#
#  They all support the notion of a "$status" argument, that can
#  maintain state helping to decide whther to really try and run given
#  sequence of cases, where later ones are dependent on the success of
#  earlier ones.
#
#  In general, $status == 0 means all OK;
#              $status  > 0 means an error;
#         and  $status == -1 indicates we are in "case skipping" mode.

sub case_expect
{
  my ($case, $status, $agentid, $rbits, $send, $want, $wantnot, $timeo, $partial) = @_;

  if (defined($case) and ($case eq "")) { undef $case; }

  if (!defined($partial)) { $partial = 1; }

  if (defined($case)) { &ttt_begin_case($case, 1); }

  if ($status != 0)
    {
      if (defined($case)) { &ttt_end_case("notest"); }
      return($rbits, -1);
    }

  ($rbits, $matched, $matchedline) 
     = &ttt_int_agent($agentid, $rbits, $send, $want, $wantnot, $timeo, $partial);

  if ($matched <= 0)
    {
      if (defined($case)) { &ttt_end_case("fail"); }
      return($rbits, 1, $matchedline);
    }
  
  if (defined($case)) { &ttt_end_case("pass"); }
  return($rbits, 0, $matchedline);
}


sub case_exec
{
  my ($case, $status, $host, $cmd, $timeo, $cmpto) = @_;
  my $exstat;
  my $online;

  &ttt_begin_case($case, 1);

  #&ttt_msg("DEBUG", "case_exec(): status <$status>\n");

  if ($status != 0)
    {
      &ttt_end_case("notest");
      return($rbits, -1);
    }

  if (defined($cmpto))
    {
      $online = "\$Output .= \$line; &ttt_msg(\$agents{\$agentid,\"name\"}, \"\$stream: \$line\")";
      $Output = "";
    }

  $exstat = &ttt_system($host, $cmd, $timeo, $online);

  #$lll = length($cmpto);  &ttt_msg("DEBUG", "case_exec(): cmpto  [$lll] <$cmpto>\n");
  #$lll = length($Output); &ttt_msg("DEBUG", "case_exec(): Output [$lll] <$Output>\n");
  #&ttt_msg("DEBUG", "case_exec(): exstat <$exstat>\n");

  if (defined($cmpto))
    {
      if ($Output ne $cmpto)
        {
          #&ttt_msg("DEBUG", "case_exec(): mismatch\n");
          &ttt_end_case("fail"); return(1);
        }
    }
  elsif ($exstat != 0)
    {
      #&ttt_msg("DEBUG", "case_exec(): nonzero exit\n");
      &ttt_end_case("fail"); return($exstat);
    }
  
  &ttt_end_case("pass");
  return(0);
}


sub case_eval
{
  my ($case, $status, $code) = @_;
  my $evalstat;

  &ttt_begin_case($case, 1);

  if ($status != 0)
    {
      &ttt_end_case("notest");
      return($rbits, -1);
    }

#&ttt_msg("DEBUG", "code <$code>\n");
  $evalstat = eval $code;
#&ttt_msg("DEBUG", "\$@ <$@>\n");

  if (! $evalstat)
    {
      &ttt_end_case("fail");
      return($evalstat);
    }
  
  &ttt_end_case("pass");
  return(0);
}

$_s_ = "\000";

sub cases_script
{
  my ($rbits, $agentid, $status, $def_timeout, @cases) = @_;
  my $name;
  my $prompt;
  my $response;
  my ($matched) = 0;
  my $matchedline;
  my $send;
  my $case_timeout;
  
  if (! defined($def_timeout)) { $def_timeout = 60; }

  if ($status != 0) { goto notest_remaining; }

  while ($#cases >= 0)
    {
 
      $case = shift @cases;

      ($name, $prompt, $response, $case_timeout) = split(/$_s_/, $case);

      if (! defined($case_timeout)) { $case_timeout = $def_timeout; }
      
      &ttt_begin_case($name, 1);

      if ($response ne "") { $send = ">$response"; } else { $send = ""; }
      ($rbits, $matched, $matchedline)
         = &ttt_int_agent($agentid, $rbits, $send, $prompt, undef, $case_timeout, 1);
      if ($matched)
        { &ttt_end_case("pass"); } else { &ttt_end_case("fail"); last; }
    }

  notest_remaining: 1;

  #  Notest any remaining cases...
  #
  while ($#cases >= 0)
    {
      $case = shift(@cases);
      ($name, $prompt, $response) = split(/$_s_/, $case);
      &ttt_begin_case($name);
      &ttt_end_case("notest");
    }

  # (We return "$status", which is "$matched" inverted)
  #
  if ($matched) { $status = 0; } else { $status = 1; }
  return ($rbits, $status, $matchedline);
}


1;