eval 'exec perl -x $0 ${1+"$@"}' # -*-perl-*-
  if 0;
#!perl -w
#
# ======================================================================
# This file is Copyright 1998,1999 by the Purdue Research Foundation and
# may only be used under license.  For terms of the license, see the
# file named COPYRIGHT included with this software release.
# AAFID is a trademark of the Purdue Research Foundation.
# All rights reserved.
# ======================================================================
#
# AAFID::Monitor package
#
# AAFID project, COAST Laboratory, CERIAS, 1998-1999.
# 
# Diego Zamboni, Mar 5, 1998.
#
# $Id: Monitor.pm,v 1.26 1999/09/03 17:08:53 zamboni Exp $
#
# NOTE: This file is in Perl's POD format. For more information, see the 
#       manual page for perlpod(1).
#

package AAFID::Monitor;

# The following keeps up with the RCS version number. The self-assignment
# keeps the -w switch from complaining (because $VERSION may not be used
# here, but it is used in our base class).
$VERSION = do { my @r = (q$Revision: 1.26 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; $VERSION = $VERSION;

# Default parameters
%PARAMETERS=(
	     Description	=> "Base Monitor Class",
	     RemoteExecCmd	=> '/bin/sh -c \'nohup ssh $host $remotecmd >/dev/null 2>/dev/null &\'',
	     StarterExecCmd	=> 'perl -w -mAAFID::Starter -e0 -- --host $myhost --port $myport',
	    );

use vars qw(
	    @ISA
	    $VERSION
	    %PARAMETERS
	   );
use strict;
use Carp;
use AAFID::Config;
use AAFID::Entity;
use AAFID::ControllerEntity;
use AAFID::Constants;
use AAFID::Comm;
use AAFID::Common;
use AAFID::Log;
use Data::Dumper;
use Comm::Reactor;
use Sys::Hostname;
use Socket;
use IO::Socket;
use IO::File;
use MD5;

@ISA=qw(AAFID::ControllerEntity
	AAFID::Log
       );

=pod

This class provides the basic functionality for a Monitor-like entity. 
Essentially, it is a C<ControllerEntity>, but with some added functionality.
Mainly:

=over 4

=item *

The ability to listen for connections from remote entities (for example,
Transceivers or monitors running in other hosts), and the ability to
establish, cache and use those connections.

=item *

The ability to receive NEEDMODULE requests from other entities, and provide
the appropriate code to be executed.

=item *

The ability, when necessary to connect to a specific host and execute a
Starter program there, then wait for it to come back either with a
CONNECT or a NEEDMODULE message.

=back 4

=head1 Setting up a network socket

We provide a custom C<Init> subroutine that sets up a TCP server socket,
where we will listen for incoming connection requests from other
entities. We also have to provide a C<run> method that, among other
things, sets up the event handler for the server socket.

=cut

sub Init {
  my $self=checkref(shift);
  # Monitors are able to run headless by default.
  $self->setParameter(runHeadless => 1);
  return $self;
}

sub run {
  my $self=shift;
  my $class=ref($self);
  croak "AAFID::Monitor: run() can only be called as an instance method"
    unless $class;
  # Signal handling
  $self->setupDefaultSignalHandlers;
  # set up the listening socket.
  my $s=&AAFID::Comm::newServerSocket;
  if (!$s) {
    # TODO: Define a good error message structure.
    my $errormsg=$self->newMsg(
	TYPE	     => "ERROR",
	SUBTYPE      => "INIT",
	DATA	     => "ErrorMessage => 'Error creating server socket: $!'");
    $self->sendReport($errormsg);
    die $errormsg->{DATA};
  }
  $self->setParameters(ListenSocket	=> $s,
		       ListenPort	=> $s->sockport,
		       HostHandles	=> {}
		      );
  # Add server socket to the select object.
  $self->getParameter('OpenHandles')->add($s);
  # Set up the standard STDIN callback.
  $self->setupSTDINcallback;
  # Connect to the filters I requested, if any
  $self->connectFilters;
  # Create an acceptor for the server socket.
  $self->Log("debug", "Adding acceptor for handle ".$self->getParameter('ListenSocket')." (server socket)\n");
  Comm::Reactor::add_acceptor($self->getParameter('ListenSocket'),
      sub {
	my $fh=shift;
	my $new=$fh->accept;
	if (!$new) {
	  my $errormsg=newErrorMsg({Error => 
		       "Error accepting connection on server socket: $!"});
	  $self->sendReport($errormsg);
	  return;
	}
	# The server socket can be either an internet socket or a
	# Unix domain socket, so we check to print the appropriate
	# log message.
	if ($fh->sockdomain == AF_INET) {
	  $self->Log("debug", "Got new connection on server socket, from ".
	      scalar(gethostbyaddr($new->peeraddr, AF_INET)) . "\n");
	}
	elsif ($fh->sockdomain == AF_UNIX) {
	  $self->Log("debug", "Got new connection on server socket, at ".
	      $new->hostpath . "\n");
	}
	else {
	  $self->Log("errors", "Got a connection on an unknown socket domain: ". 
	      $fh->sockdomain . "\n");
	}
	$new->autoflush(1);
	# Add an event handler for the new socket.
	$self->Log("debug", "Adding callback for handle $new (new connection on server socket)\n");
	Comm::Reactor::add_handle($new,
		  sub {
		    my ($fh, $msg)=@_;
		    $self->processInput($fh, AAFID::Comm::nextMsg($fh,$msg));
		  });
      });
  # Dump myself to the log every 30 seconds
#  Comm::Reactor::add_repeating_event(30, sub { $self->Log("debug", "Here's my guts: ".Dumper($self)."\n"); });
  # Send a CONNECT message
  $self->sendConnectMessage;
  # Call the event loop
  Comm::Reactor::loop();
}

=head1 Keeping track of hosts we have connections to

C<Monitor> entities keep a parameter called B<HostHandles>, which contains
information about all the hosts with which network connections are 
currently established. Thus, we need to extend the standard C<processInput>
subroutine to keep track of this information.

=cut

sub processInput {
  my $self=checkref(shift);
  my $msg=$self->SUPER::processInput(@_);
  # Do not add the host to the HostHandles table if the message was
  # a DISCONNECT (because we want to get rid of it, not add it again)
  # or if the message came from a GUI, because GUIs do not have
  # to be added to the table, only transceivers.
  # In fact, do not add it if the message comes from "up" at all,
  # because all transceivers are "down".
  return $msg if ( !$msg || $msg->isMessage('DISCONNECT') );
  return undef if $msg==-1;
  return $msg if ( $msg->isMessage('CONNECT') && $msg->isSubtype('GUI') );
  my $msgfrom=$msg->{FROM};
  my $oh=$self->getParameter('OpenHandleIDs');
  return $msg if ( exists($oh->{$msgfrom}) && $oh->{$msgfrom}->{_isUp});
  return $msg if $self->getParameter('_isUp', {})->{$msg->{_FROMHANDLE}};

  # If the message came from a socket, check if we already have its
  # information.
  my $fromhandle=$msg->{_FROMHANDLE};
  if (!$msg->{_FROMSTDIN} && 
      ref($fromhandle) && $fromhandle->isa("IO::Socket")) {
    $self->Log("debug", "Message came from a socket, checking\n");
    my $brokenID=$self->breakID($msg->{FROM});
    my $fromhost=$brokenID?$brokenID->{Host}:
      scalar gethostbyaddr($fromhandle->peeraddr, AF_INET);
    my $hosthandles=$self->getParameter('HostHandles');
    if (exists $hosthandles->{$fromhost}->{Handle}) {
      $self->Log("debug", "It comes from $fromhost, and had it already\n");
      # We should only have one handle per host
      if ($msg->{_FROMHANDLE} != $hosthandles->{$fromhost}->{Handle}) {
	my $errormsg=$self->newMsg(
	     TYPE    => "ERROR",
	     SUBTYPE => "HANDLE",
	     DATA    => "ErrorMessage => 'Got two handles for the same host'");
	$self->Log("errors", "And the handle is different. Error.\n");
	$self->sendReport($errormsg);
	return undef;
      }
      else {
	$self->Log("debug", "But the handle is the same, so it's ok\n");
      }
    }
    else {
      $self->Log("debug", "I didn't have it, adding to my tables\n");
      # If it's the first time we hear from that host, add the handle.
      $hosthandles->{$fromhost}->{Handle}=$msg->{_FROMHANDLE};
    }
  }
  return $msg;
}

=head1 Controlling redistribution of messages

In B<AAFID::ControllerEntity>, when a message destined (TO field) to an
entity that we do not know because it is not in our C<OpenHandleIDs> 
parameter, we simply assume that we do not know the entity and process
the message ourselves. In B<AAFID::Monitor>, however, it may be that
the entity to which the message is addressed belongs to one of our
subentities (a transceiver, for example). In this case, it is incorrect
to take the message, and it should be forwarded to the appropriate
transceiver.

Thus, we override here the C<isForMe> and C<relayMessage> methods from
C<AAFID::Entity>, to do the appropriate thing.

=cut

sub sendMsgTo {
  my $self=shift;
  ref($self) or croak "sendMsgTo can only be called as an instance method";
  my $msg=shift;
  my $whoID=shift;
  my $oh=$self->getParameter('OpenHandleIDs');
  my $h;
  if ($oh->{$whoID} && ($h=$oh->{$whoID}->{Handle})) {
    $self->Log("debug", "Sending message to $whoID (handle ".Dumper($h)."): ".$msg->toString."\n");
    if (AAFID::Comm::isSTDOUT($h) && $self->getParameter('_headLess')) {
      $self->Log("I/O", "Trying to send a message while headless.\n");
      my $what;
      if ($self->getParameter('onSTDINclose') &&
	  ($what=$self->getParameter('onSTDINclose')->{onOutput})) {
	$self->Log("I/O", "Calling provided routine\n");
	&{$what}($h, $msg->toString);
      }
      else {
	# No behavior provided.
	$self->Log("I/O", "This message (".$msg->toString.") is being lost\n");
      }
      return;
    }
    else {
      if ($self->getParameter('_standalone')) {
	AAFID::Comm::sendMsgTo($msg, $h, 1);
      }
      else {
	AAFID::Comm::sendMsgTo($msg, $h);
      }
    }
  }
  else {
    $msg->{TO}=$whoID;
    $self->relayMessage($msg);
  }
}

sub isForMe {
  my $self=checkref(shift);
  my $msg=checkref(shift, "AAFID::Message");
  my $msgto=$msg->{TO};
  my $oh=$self->getParameter('OpenHandleIDs');
  if (($msgto eq "-") || (lc($msgto) eq lc($self->ID))) {
    # It is for me.
    return 1;
  }
  if (exists($oh->{$msgto})) {
    # I know the recipient, it is not for me.
    return 0;
  }
  # Here we know that we do not directly know the entity. But we will
  # check if we know the host.
  if ($self->knowTheHost($msgto)) {
    # It is not for me, but I know the host, so I'll relay it.
    $self->Log("debug", 
	       "The message is for $msgto, I'll send it to the host.\n");
    return 0;
  }
  else {
    # It is not for me, and I do not know the host, so I'll take it.
    $self->Log("debug",
	       "The message is for $msgto, but I don't even know its host,".
	       "so I'll take it.\n");
    return 1;
  }
}

sub knowTheHost {
  my $self=checkref(shift);
  my $msgto=shift;   # This should be the entity ID.
  # Here we know that we do not directly know the entity. But we will
  # check if we know the host.
  my $brokenID=$self->breakID($msgto);
  my $hh=$self->getParameter('HostHandles');
  my $host;
  if (!$brokenID) {
    # If $msgto is not a valid ID, use it as host name.
    $host=$msgto;
    $self->Log("debug", "Invalid ID given, using it as host name.\n");
  }
  else {
    $host=$brokenID->{Host};
  }
  return exists($hh->{$host}->{Handle});
}

sub relayMessage {
  my $self=checkref(shift);
  my $msg=checkref(shift, "AAFID::Message");
  my $msgto=$msg->{TO};
  my $oh=$self->getParameter('OpenHandleIDs');
  if (exists($oh->{$msgto}) && $oh->{$msgto}->{Handle}) {
    # If I know the destination, send it there.
    $self->Log("debug", "Relaying message to $msgto.\n");
    $self->sendMsgTo($msg, $msgto);
  }
  else {
    # If I don't know the destination, I should know the host, send
    # it down the appropriate handle.
    $self->relayMessageToHost($msg, $msgto);
  }
}

=pod

The C<relayMessageToHost> subroutine takes a message and an entity ID
as arguments, and sends the message unmodified to the transceiver at
the host specified in the identifier. If the second argument is not
a valid entity ID, it is used as a host name.

=cut

sub relayMessageToHost {
  my $self=checkref(shift);
  my ($msg, $msgto)=@_;
  if (!$msg || !$msgto) {
    $self->Log("errors", "relayMessageToHost: no message or no ".
	       "entity ID given.\n");
    return;
  }
  my $hh=$self->getParameter('HostHandles');
  my $brokenID=$self->breakID($msgto);
  my $host;
  if (!$brokenID) {
    # If the argument is not a valid entity ID, use it as a host name.
    $host=$msgto;
    if (!$host) {
      $self->Log("errors", "Invalid host name: '$host'\n");
      return;
    }
  }
  else {
    $host=$brokenID->{Host};
    if (!$host) {
      $self->Log("errors", "Invalid host name in ID '$msgto': '$host'\n");
      return;
    }
  }
  if (exists($hh->{$host}->{Handle})) {
    $self->Log("debug", "Sending message to the transceiver at $host.\n");
    AAFID::Comm::sendMsgTo($msg, $hh->{$host}->{Handle});
    return;
  }
  else {
    $self->Log("errors",
	       "I though I knew $host, but now I don't. Weird. ".
	       "Discarding message.\n");
    return;
  }
}

=head1 Sending code to an entity in need

When a new remote entity starts and contacts a Monitor, it may also request
from it the code of any entities that it needs to start up. This is done
through a NEEDMODULE message, so we have to know how to react to it.

=cut

sub message_NEEDMODULE {
  my $self=checkref(shift);
  my $msg=checkref(shift, "AAFID::Message");
  my $handle=$msg->{_FROMHANDLE};
  my $errmsg;
  my $sending;
  my $standalone=$self->getParameter('_standalone');
  $handle->autoflush(1);
  # The class being requested comes in the subtype field.
  my $class=$msg->{SUBTYPE};
  my $classfile;
  # Convert the class specification into a path name.
  $class =~ s/\.pm$//;
  $class =~ s@::@/@g;
  $class .= ".pm";
  $self->Log("processes", "Got request for class $class\n");
  # First see if we have it loaded already, in which case Perl knows its
  # location
  if ($classfile=$INC{$class}) {
    # Do nothing, we already stored the value
    $self->Log("debug", "Found it in %INC, at $classfile.\n");
  }
  else {
    # Got through @INC, looking for the file.
    my $p;
    foreach $p (@INC) {
      if (-f "$p/$class") {
	$classfile="$p/$class";
	$self->Log("debug", "Found it at $classfile.\n");
	last;
      }
    }
  }
  # This block is to enclose all the sending. If something weird happens,
  # we simply jump out of it and do errors at the end.
 SENDFILE: {
    if ($classfile) {
      # We found it, send it.
      my $f=IO::File->new("<$classfile");
      if ($f) {
	# TODO: make ID be something else, such as the MD5 of the code to
	# be sent.
	$errmsg="Error sending code: %%";
	my $id=MD5->hexhash(rand);
	$self->Log("debug", "Sending with id $id.\n");
	my $nmsg=$self->newMsg(TYPE	=> "NEWMODULE",
			       SUBTYPE	=> $msg->{SUBTYPE},
			       DATA	=> $id,
			      );
	AAFID::Comm::sendMsgTo($nmsg, $handle);
	$sending=1;
	while (<$f>) {
	  AAFID::Comm::sendStringTo($_, $handle, $standalone);
	}
	$f->close;
	AAFID::Comm::sendStringTo("$id\n", $handle, $standalone);
	$self->Log("debug", "Finished sending file.\n");
	# Believe it or not, we are done.
	return undef;
      }
      else {
	$errmsg="Error opening code file: $!";
      }
    }
    else {
#      $errmsg="Code file not found";
      $class=$msg->{SUBTYPE};
      $self->Log("processes", "Did not find file locally, sending request up.\n");
      $self->requestModule($class);
      if (!$self->getParameter('_PendingSends')) {
	$self->setParameter(_PendingSends => {});
      }
      # Notice here, we store the entire message. When the class in question
      # arrives, we will make as if this message had arrived again.
      # TODO: Find a cleaner way of doing this.
      $self->getParameter('_PendingSends')->{$class}=$msg;
      # We are done for now
      return undef;
    }
  }
  # If we get here, something happened, and $errmsg contains an explanation.
  $errmsg =~ s/%%/$!/;
  $self->Log("errors", "$errmsg.\n");
  # Only send Command-Quit if we had sent the NEWMODULE when the error occurred.
  AAFID::Comm::sendStringTo("Command-Quit:\n", $handle, $standalone) if $sending;
  # TODO: This is ugly. Instead of using the regular reporting message for
  # message_XXX subroutines, we have to send the report up ourselves,
  # because the standard mechanism would send it to the handle where the
  # message came from, which is the remote entity, and which doesn't do
  # us any good. Oh well.
  my $errormsg=$self->newMsg(TYPE    => "ERROR",
			     SUBTYPE => "NEEDMODULE",
			     DATA    => "ErrorMessage => '$errmsg'"
			    );
  $self->sendReport($errormsg);
#  $self->getParameter('OpenHandles')->remove($handle);
#  $handle->close;
  return undef;
}

=pod

If the module requested is not found locally, we also send a request up
for it, and store the message the was requesting it in the C<_PendingSends>
parameter. Later hopefully, the code will arrive in a C<NEWMODULE>
message. When this happens, we need to know how to react to it. Thus,
we override the C<message_NEWMODULE> subroutine to process the message
normally, but then do some on our own.

=cut

sub message_NEWMODULE {
  my $self=checkref(shift);
  my $msg=checkref(shift, "AAFID::Message");
  $self->Log("debug", "Got NEWMODULE message in Monitor. Invoking superclass.\n");
  my $result=$self->SUPER::message_NEWMODULE($msg);
  if ($result) {
    $self->Log("debug", "Back in Monitor, superclass returned value, returning.\n");
    return $result;
  }
  else {
    my $class=$msg->{SUBTYPE};
    $self->Log("debug", 
	       "Back in Monitor, superclass returned ok. " .
	       "Doing our processing.\n");
    if (!$self->getParameter('_PendingSends')) {
      $self->setParameter(_PendingSends => {});
    }
    my $requestMessage;
    if ($requestMessage=$self->getParameter('_PendingSends')->{$class}) {
      # We had been requested this class, and were waiting for it. So
      # send it down.
      $self->Log("processes", "Got previously requested class, sending down.\n");
      $result=$self->message_NEEDMODULE($requestMessage);
      if (!defined($result)) {
	# If NEEDMODULE returns undef, everything was ok.
	delete $self->getParameter('_PendingSends')->{$class};
      }
      return $result;
    }
  }
  return undef;
}

=pod

If for some reason a remote entity that had requested the code decides
it no longer wants it, it can send a NONEEDMODULE message, which in
the DATA field will contain some kind of explanation. We react to it
by generating a report up.

=cut

sub message_NONEEDMODULE {
  my $self=checkref(shift);
  my $msg=checkref(shift, "AAFID::Message");
  my $handle=$msg->{_FROMHANDLE};
  my $desc=$msg->{DATA};
  my $errormsg=$self->newMsg(TYPE	=> "ERROR",
			     SUBTYPE	=> "NONEEDMODULE",
			     DATA	=> "ErrorMessage => '$desc'"
			    );
  $self->sendReport($errormsg);
#  $self->getParameter('OpenHandles')->remove($handle);
#  $handle->close;
  return undef;
}

=head1 Processing CONNECT messages from remote entities

When network connections are involved, the connection establishment process
works a little differently. Because when we receive a request for a new
connection (to the server socket) and get the handle through which data
will flow, we still do not know anything about the entity on the other 
side. However, we still have to add the handle, at least to the C<OpenHandles>
parameter. Thus, when we receive the first request, we have to add all the
pertinent information to our C<OpenHandleIDs> parameter. This is already
done by C<AAFID::Entity::message_CONNECT>. However, we also have to
update our table containing host information, in the C<HostHandles>
parameter. Thus, we override the C<message_CONNECT> method, and call
the original one, but do some extra things afterwards.

=cut

sub message_CONNECT {
  my $self=checkref(shift);
  # First call the method in the superclass.
  my $result=$self->SUPER::message_CONNECT(@_);
  my $msg=shift;
  my $hh=$self->getParameter('HostHandles');
  my $fh=$msg->{_FROMHANDLE};
  # If the message came from a socket, we have things to do.
  if ($fh->isa("IO::Socket")) {

    # Check if it is a GUI trying to establish contact.
    if (uc($msg->{SUBTYPE}) eq "GUI") {
      if ($self->getParameter('_headLess')) {
	# Only honor such a connection is I'm currently headless.
	$self->Log("I/O", 
	    "Got connection from a GUI and I'm headless, so I'll take her.\n");
	# Remove the callback for the handle and replace it with a
	# STDIN callback.
#	$self->Log("I/O", "Replacing callback for $fh with STDIN callback\n");
#	Comm::Reactor::remove_handle($fh);
#	Comm::Reactor::add_handle($fh,
#	    sub {
#	      my ($mfh, $mmsg)=@_;
#	      $self->processInput($mfh,AAFID::Comm::nextSTDINmsg($mfh, $mmsg));
#	    });
	# Associate STDOUT and STDIN with the handle.
#	undef $Comm::Reactor::stdin_handle;
#	undef $Comm::Reactor::stdout_handle;
	open(STDOUT, ">&".$fh->fileno)
	  or do { 
	    $self->Log("errors","Error associating STDOUT to handle $fh: $!\n");
	    return undef;
	  };
	open(STDIN, "<&".$fh->fileno)
	  or do { 
	    $self->Log("errors","Error associating STDIN to handle $fh: $!\n");
	    return undef;
	  };
	# I'm no longer headless.
	$self->setParameter('_headLess' => undef);
	# Whatever happens, we can no longer consider ourselves running
	# standalone.
	$self->setParameter(_standalone => undef);
	$self->Log("debug", "Removing callback for $fh\n");
	Comm::Reactor::remove_handle($fh);
	$self->Log("debug", "Replacing with standard STDIN callback\n");
	$self->setupSTDINcallback;
	my $oh=$self->getParameter('OpenHandleIDs');
	$oh->{$msg->{FROM}} = {};
	$oh->{$msg->{FROM}}->{_isUp} = 1;
	$oh->{$msg->{FROM}}->{Handle}=$fh;
	# For easy localization of the handle as "up"
	$self->getParameter('_isUp', {})->{$fh}=1;
	# Send a connect message.
	$self->sendConnectMessage;
      }
      else {
	$self->Log("errors", 
	    "Got connection from a GUI but I am not headless; ignoring her\n");
	return $self->newMsg(TYPE => "ERROR",
			     SUBTYPE => "CONNECT",
			     DATA => "Error => 'Entity ".$msg->{FROM}." tried to connect me as a GUI: ".$msg->toString);
      }
      return undef;
    }
    
    $self->Log("debug", 
	       "She comes through a socket, checking pending invokes\n");
    my $brokenID=$self->breakID($msg->{FROM});
    if (!$brokenID) {
      $self->Log("errors", "Her ID is broken: $msg->{FROM}\n");
      return $result;
    }
    my $host=$brokenID->{Host};
    if (!exists $hh->{$host}->{Handle}) {
      $self->Log("processes", "I didn't have her handle, storing it\n");
      $hh->{$host}->{Handle}=$fh;
      # If there are pending invokes for this host, do them all now.
      my $pending=$hh->{$host}->{_PendingInvokes};
      if ($pending && @$pending) {
	$self->Log("processes", 
		   "Furthermore, she had pending invokes, doing them\n");
	my $locator;
	foreach $locator (@$pending) {
	  $self->Log("debug", "Invoking $locator\n");
	  if (!$self->invoke($locator)) {
	    $@ =~ s/\s+/ /;
	    $self->Log("errors", "Error invoking $locator: $@\n");
	    return $self->newMsg(TYPE 	  => "ERROR",
				 SUBTYPE  => "CONNECT",
				 DATA	  => "Error => $@");
	  }
	}
      }
      else {
	$self->Log("debug", "She is ok, no pending invokes\n");
      }
    }
    else {
      $self->Log("debug", "I had her already, checking consistency\n");
      # If we had it already, check that the handle is the same.
      if ($hh->{$host}->{Handle} != $fh) {
	$self->Log("errors", 
		   "Got two different handles for the same host $host\n");
      }
    }
  }
  return undef;
}

=head1 Invoking entities

When a request to invoke a remote entity comes, things become more 
complicated. If no connection exists already to the remote host, we
want to connect there and run a Starter program. However, in that case
we cannot immediately start the entities, because we have to wait for
the Starter to come back at us, possibly requesting code, and only after
we get the CONNECT message from the remote controller entity we will be
able to send it the entities it needs.

So, what we do is that if no connection exists to the host, we connect
there, run the Starter, and store the locators of the entities that have
to be instantiated in the C<HostHandles> parameter. Later, when we get
the CONNECT message, this parameter will be inspected and any pending
invocations will be executed.

We override the C<ControllerEntity::invoke> method, but use it as well.

=cut

sub invoke {
  my $self=checkref(shift);
  my $host_regex='[\w-]+(?:\.[\w-]+)*';
  my $filename_regex='[\w.-]+';
  my $classpath_regex="$filename_regex(?:::$filename_regex)*";
  my $path_regex="/$filename_regex(?:/$filename_regex)*/";
  my $result;
  my $host;
  my $path;
  my $class;
  
  my $locator=$_=$_[0];
  my $cmds=$_[1];
  
  # Check if we were given remote locators.
 CHECK_REMOTE_LOCATOR: {
    m/^($host_regex):($classpath_regex)$/ && do {
      $host=$1;
      $class=$2;
      $self->Log("processes", "Got request to invoke $2 on $1\n");
      last CHECK_REMOTE_LOCATOR;
    };
    m/^($host_regex):($path_regex$filename_regex)$/ && do {
      $host=$1;
      $path=$2;
      $self->Log("processes", "Got request to invoke $2 on $1\n");
      last CHECK_REMOTE_LOCATOR;
    };
    # If we get here, it means that it is not a remote locator, so
    # we use the regular ControllerEntity::invoke.
    return $self->SUPER::invoke(@_);
  }
  # If we get here, we have a remote locator.
  my $hh=$self->getParameter('HostHandles');
  if (exists $hh->{$host}->{Handle}) {
    my $handle=$hh->{$host}->{Handle};
    my $data="Class => '$class'";
    if ($cmds) {
      $data.=", Commands => ".Dumper($cmds);
#     print "DATA=$data\n";
    }
    my $msg=$self->newMsg(TYPE		=> "COMMAND",
			  SUBTYPE	=> "START",
			  DATA		=> $data);
      # Send the whole thing to the appropriate host.
      # Here we have to use the AAFID::Comm::sendMsgTo subroutine directly,
      # because we don't have an entity ID to direct the message to.
      $self->Log("debug", "Sending class load request to $host: ".$msg->toString."\n");
      # TODO: Here we are trespassing the boundaries of our "communication
      # mechanism transparency" by directly using the handles, instead of 
      # letting the Comm library do it. Think about it, try to solve it.
      AAFID::Comm::sendMsgTo($msg, $handle);
      return $self;
  }
  else {
    # If we don't have a connection to the host, we check to see whether
    # we need to run a starter the (or one has been run already), and if
    # so connect there and run it.
    if (!$hh->{$host}->{_AlreadyStarted}) {
      if ($self->runStarter($host)) {
	$self->Log("processes", "Ran remote Starter successfully\n");
      }
      else {
	$self->Log("errors", "Error executing remote Starter\n");
      }
    }
    else {
      $self->Log("processes", 
	 "A remote Starter should be running already, not running again.\n");
    }
    # Then we add our current invoke to the pending list there.
    $self->Log("processes", 
	       "Adding $locator to the list of pending invokes for $host\n");
    push @{$hh->{$host}->{_PendingInvokes}}, $locator;
    # TODO: This is wrong, but I don't see how to solve it for now. We
    # are returning a successful code when we didn't actually start any
    # entities, just put them in the list.
    return $self;
  }
}

=pod

As a companion to this, the C<runStarter> method contacts the host whose
name or address is provided as argument, and starts it with indications
of how to get to us. Right now this is done through C<ssh>.

=cut

sub runStarter {
  my $self=checkref(shift);
  my $host=shift;
  if (!$host) {
    $self->Log("errors", "No host provided for running a Starter\n");
    return undef;
  }
  my $myhost=hostname;
  my $myport=$self->getParameter('ListenPort');
  my $remotecmd=$self->getParameter('StarterExecCmd');
  my $cmd=$self->getParameter('RemoteExecCmd');
  eval "\$remotecmd=\"$remotecmd\"";
  eval "\$cmd=\"$cmd\"";
  $self->Log("debug", "Running '$cmd'\n");
  my $result=system($cmd);
  if (!$self->getParameter('HostHandles')) {
    $self->setParameter(HostHandles => {});
  }
  if (!exists($self->getParameter('HostHandles')->{$host})) {
    $self->getParameter('HostHandles')->{$host}={};
  }
  $result==0 and $self->getParameter('HostHandles')->{$host}->{_AlreadyStarted}=1;
  return ($result==0);
}

=pod

We add a command to explicitly run the Starter on a remote host.

=cut

sub command_RUNSTARTER {
  my $self=checkref(shift);
  my ($msg, %params)=@_;
  my $host=$params{Host};
  if ($host) {
    my $hh=$self->getParameter('HostHandles');
    # Only run starter if we don't have a channel to the host
    if (!$hh->{$host}->{_AlreadyStarted}) {
      if ($self->runStarter($host)) {
	$self->Log("processes", "Starter ran successfully\n");
	return undef;
      }
      else {
	$self->Log("errors", "Could not run starteron $host: $!\n");
	return {Error => "Could not run Starter on $host: $!"};
      }
    }
    else {
      $self->Log("errors", "I already have a channel to $host, not running a starter again.\n");
      return { Error => "I already have a channel to $host, not running a starter again." };
    }
  }
}

=pod

The STARTMONITOR command is also a wrapper around C<command_RUNSTARTER>.

=cut

sub command_STARTTRANSCEIVER {
  my $self=checkref(shift);
  my ($msg, %params)=@_;
  my $host=$params{Host};
  if ($host) {
    my $hh=$self->getParameter('HostHandles');
    if (!$hh->{$host}->{_AlreadyStarted}) {
      return $self->command_RUNSTARTER($msg, %params);
    }
    else {
      $self->Log("errors", "Transceiver already running on $host.\n");
      return {Error => "Transceiver already running on $host."};
    }
  }
  return undef;
}

=pod

We also override the C<message_DISCONNECT> method because we need to
update our own data structures. We also call the parent method to
do the rest of the updating.

=cut

sub message_DISCONNECT {
  my $self=checkref(shift);
  # First call the method in the superclass
  $self->Log("debug", 
	     "Got a DISCONNECT message. First calling the superclass.\n");
  my $result=$self->SUPER::message_DISCONNECT(@_);
  my $msg=shift;

  # If the message comes from a GUI we do nothing apart from the normal
  # disconnect activity, because the GUI does not have an entry in
  # HostHandles.
  return undef if $msg->isSubtype('GUI');

  my $hh=$self->getParameter('HostHandles');
  my $brokenID=$self->breakID($msg->{FROM});
  if (!$brokenID) {
    $self->Log("errors", "Her ID is broken: $msg->{FROM}\n");
    return $result;
  }
  my $host=$brokenID->{Host};
  # Close the handle
  if ($hh->{$host}->{Handle}) {
    $self->Log("debug", "Closing the handle to host $host.\n");
    close($hh->{$host}->{Handle});
    delete $hh->{$host}->{Handle};
  }
  # Remove the entry
  $self->Log("debug", "Removing the entry in HostHandles for $host.\n");
  delete $hh->{$host}->{_PendingInvokes};
  delete $hh->{$host}->{_PendingSends};
  delete $hh->{$host};
  return undef;
}

=head1 Stopping an entity

The KILL command takes an argument called C<Entities>, which contains a 
comma-or-space-separated list of entitiy IDs. All those entities will be
stopped by sending them a STOP message. The entity is not removed from
the tables at this point, this is done when the DISCONNECT message is
received from the entity.

Here we override the default version of C<command_KILL> (defined in
B<AAFID::ControllerEntity>) to identify if the entity to be killed
is in a host we know, and in those cases to relay the message to
the appropriate transceiver. Also, we add an optional parameter C<Host>
which, if given, must contain a host name, and the effect will be that
the transceiver on that host will be terminated.

=cut

sub command_KILL {
  my $self=checkref(shift);
  my ($msg, %params)=@_;
  # The feared message.
  my $stopmsg=$self->newMsg(TYPE => "STOP");
  # Kill individual entities.
  my @entities=();
  my $ent;
  if ($params{Entities}) {
    @entities=splitList($params{Entities});
  }
  if ($params{Entity}) {
    push @entities, $params{Entity};
  }
  $self->Log("processes", "Got a request to kill entities @entities.\n")
    if @entities;
  my $openhandles=$self->getParameter('OpenHandleIDs');
  foreach $ent (@entities) {
    if (exists($openhandles->{$ent})) {
      $self->Log("debug", "Sending STOP message to entity $ent\n");
      $self->sendMsgTo($stopmsg, $ent);
    }
    else {
      if ($self->knowTheHost($ent)) {
	# We know the host, send the message to the transceiver after
	# reassigning some field to make the message come from me.
	# Notice that here we do not send the STOP message that we have
	# stored in $stopmsg, but the original KILL message that we got,
	# because we want to instruct the corresponding transceiver to
	# kill the entity.
	$self->Log("debug", "Don't know the entity, but I know its host, ".
		   "sending message to its transceiver.\n");
	$msg->{FROM}=$self->ID;
	$msg->{TO}="-";
	$self->relayMessageToHost($msg, $ent);
      }
      else {
	$self->Log("errors", "I don't know entity $ent nor her host, ".
		   "so I cannot stop her\n");
      }
    }
  }
  # Kill whole hosts.
  my @hosts=();
  my $host;
  if ($params{Hosts}) {
    @hosts=splitList($params{Hosts});
  }
  if ($params{Host}) {
    push @hosts, $params{Host};
  }
  $self->Log("processes", "Got a request to kill hosts @hosts\n") if @hosts;
  foreach $host (@hosts) {
    if ($self->knowTheHost($host)) {
      $self->Log("debug", "Sending STOP message to $host.\n");
      $self->relayMessageToHost($stopmsg, $host);
    }
  }
  return undef;
}

=head1 Stopping a monitor

Before exiting a monitor, we have to close the server socket.

=cut

sub realstop {
  my $self=checkref(shift);
  $self->Log("debug", "Closing server socket\n");
  $self->getParameter('ListenSocket')->close;
  return $self;
}

=head1 Querying for existing entities

We also slightly redefine the LISTENTITIES command in order to allow
the existance of an optional parameter called C<Host>. If this parameter
is given and the host specified is known, then the command is relayed
to that host. If no parameter is given, then we behave exactly as the
standard version of LISTENTITIES.

=cut

sub command_LISTENTITIES {
  my $self=checkref(shift);
  my ($msg, %params)=@_;
  if ($params{Host}) {
    if ($self->knowTheHost($params{Host})) {
      $self->Log("debug", "Relaying LISTENTITIES command to $params{Host}\n");
      $msg->{TO}="-";
      $self->relayMessageToHost($msg, $params{Host});
      return undef;
    }
    else {
      $self->Log("errors", "I do not know host $params{Host}, so I cannot ".
		 "request a list of entities from it.\n");
    }
  }
  else {
    return $self->SUPER::command_LISTENTITIES($msg, %params);
  }
}

=head1 Processing status reports.

For now, if the C<StatusUpdateFile> parameter is defined, store any
status updates there.

=cut

sub message_STATUS_UPDATE {
  my $self=checkref(shift);
  my $msg=shift;
  $self->Log("debug", 
	     "Got STATUS_UPDATE from ".$msg->{FROM}.": ".$msg->toString."\n");
  my $fname=$self->getParameter('StatusUpdateFile');
  if ($fname) {
    $self->Log("debug", "Got to store it in file $fname.\n");
    my $file=$self->getParameter('StatusUpdateHandle');
    if ($file) {
      $self->Log("debug", "Already open, storing message.\n");
    }
    else {
      $self->Log("debug", "Opening file.\n");
      $file=IO::File->new(">>$fname");
      if (!$file) {
	$self->Log("errors", "Error opening status update file $fname, sending message up. Error: $!\n");
	$self->setParameter(StatusUpdateFile => undef);
	$self->sendReport($msg);
	return undef;
      }
      else {
	$file->autoflush(1);
	$self->setParameter(StatusUpdateHandle => $file);
      }
    }
    # Print message to file.
    print $file $msg->toString."\n";
    if ($self->getParameter('StatusUpdateSendUp')) {
      $self->Log("debug", "Also sending it up.\n");
      $self->sendReport($msg);
    }
  }
  else {
    # Just in case it was previously open
    if ($self->getParameter('StatusUpdateHandle')) {
      if ($self->getParameter('StatusUpdateHandle')->opened) {
	$self->Log("I/O", "Closing previously open StatusUpdate file.\n");
	$self->getParameter('StatusUpdateHandle')->close;
	$self->setParameter(StatusUpdateHandle => undef);
      }
    }
    $self->Log("debug", "Sending it up.\n");
    $self->sendReport($msg);
  }
  return undef;
}

=head1 Standard monitor parameters

Monitor entities add a new set of parameters to keep track of information
they need.

=over 4

=item ListenSocket

A TCP socket in LISTEN mode on a well-known port (defined by
C<$CONTROLLERENTITY_PORT>), to which entities in other hosts can
  establish connections. This is all handled in B<AAFID::Comm>.

=item ListenPort

The port number on which C<ListenSocket> is listening.

=item HostHandles

A reference to a hash that contains information to each host to which
a network connection has been established. Each element is indexed by
the host name, and contains the following subelements: 

=over 4

=item C<Handle>

Contains a reference to the C<IO::Socket> object that is used to
communicate with the host.

=item C<_PendingInvokes> 

Contains a reference to a list with the locators of all the entities
that should be invoked in that host once we get set up with it. This
has to be kept because even when we already have a connection to the
host, we cannot try to invoke entities on it until we get a CONNECT
message from it, signaling that it is ready for action.

=item C<_PendingSends>

Contains information about classes that have to be sent somewhere
else.  This is, if a subentity requests a class using a NEEDMODULE
message, but we do not have it, we have to request it ourselves using
a NEEDMODULE message. Thus, the original request cannot be served
immediately, but has to wait until we get the module. When this
happens, the original request (the message itself that contained the
request) is stored in C<_PendingSends> indexed by the class name. When
the class arrives from above and is successfully loaded, we do as if
the original message had arrived again (which should cause the module
to be sent to the subentity that requested it), and then delete it.

=item C<_AlreadyStarted>

If true, it means that a Starter program has already been run in that
host, and thus does not need to be run again.

=back 4

=back 4

=cut

_EndOfEntity;

#
# $Log: Monitor.pm,v $
# Revision 1.26  1999/09/03 17:08:53  zamboni
# Changed the start line to something that is path-independent, and
# updated the copyright notice.
#
# Revision 1.25  1999/08/08 00:24:57  zamboni
# - Modified one message.
#
# Revision 1.24  1999/06/08 05:01:56  zamboni
# Merged branch a06-raw-data-collection into main trunk
#
# Revision 1.23.2.1  1999/06/07 19:27:12  zamboni
# - Moved the creation of the server socket from Init to run, together with
#   its related tasks: checking the socket, storing it in the appropriate
#   parameters, and adding it to the OpenHandles paramter.
#   Only setting the runHeadless paramter remained in Init()
# - Added setting the signal handlers to run()
# - Made processInput not process certain types of messages so that certain
#   types of entities (for example, GUIs and entities from which a
#   DISCONNECT message is received) are not added to the tables.
# - Overrode sendMsgTo() so that when an unknown destination is given, the
#   message is passed to relayMessage() instead of giving an error or
#   sending it up, as is the default behavior inherited from Entity.pm.
# - Some bug fixes and extra checks of existance in hashes before using
#   the values.
# - Fixed the problem of reconnecting the entity to stdin/stdout when a
#   CONNECT message is received while running headless.
# - Added support for sending initial commands to a new entity.
# - Added message_STATUS_UPDATE to be able to process STATUS_UPDATE messages
#   from agents. This includes support for the StatusUpdateFile and
#   StatusUpdateHandle parameters (for storing messages in a file) and the
#   StatusUpdateSendUp parameter (for also sending the messages up).
#
# Revision 1.23  1999/04/01 02:42:21  zamboni
# - Added code to make the monitors be able to run headless by default.
#   The runHeadless parameter is set to true on initialization.
# - Also added code to recognize a new subtype of the CONNECT message.
#   A CONNECT GUI message is interpreted as a GUI program that wants
#   to take control over the monitor by becoming its "up" entity. The
#   monitor only allows this if it is currently running headless. In
#   this case, the socket through which the message came is associated
#   with STDIN and STDOUT, and the headless flag is cleared.
#
#   This kind of works, but the reconnection part still needs work.
#   Some tables are apparently not being updated correctly when STDIN
#   closes and reopens.
#
# Revision 1.22  1999/03/29 22:33:26  zamboni
# Merged branch a05-new-comm-module, which updates it to make use of the new event-based communication mechanism.
#
# Revision 1.21.4.1  1999/03/29 16:40:48  zamboni
# - Modified message_NEEDMODULE to use AAFID::Comm::sendMsgTo and
#   AAFID::Comm::sendStringTo to send the code, instead of printing
#   directly to the handle.
# - Added a run method (it was previously inheriting from Entity). This
#   was necessary to set the acceptor for the Server socket.
#
# Revision 1.21  1998/09/09 03:00:36  zamboni
# * Monitor.pm:
#   - Fixed a problem of the monitor not correctly deleting hosts
#     from the data structures when it received a DISCONNECT command
#     (it was deleting them, but then readding them automatically).
#   - Added subroutines knowTheHost, relayMessageToHost, which allow
#     the modularization of relayMessage, and serve also for other
#     purposes (they are also used by command_KILL and
#     command_LISTENTITIES)
#   - Implemented a special version of command_KILL to recognize
#     the Entity, Entities, Host and Hosts parameters, to allow
#     the killing of entities the monitor does not know directly
#     (by relaying the messages to their transceivers) or killing
#     of entire hosts (by stopping their transceivers).
#   - Implemented a special version of command_LISTENTITIES
#     that supports the Host parameter, to make it easier to
#     query the list of entities of other entities.
#
# Revision 1.20  1998/09/07 17:35:21  zamboni
# Added support for filters!
#
# * Monitor.pm: Replaced all uses of AAFID::Message->new by uses
#   of $self->newMsg.
#
# * Filter.pm: Cleaned up the code and the comments, and added some
#   extra features, such as default versions of makefield and
#   makeline that make it easier to define new filters if they read
#   data where the fields are space-separated. Also, added some
#   error checks here and there.
#
# * Entity.pm: Added filter support
#   - Added descriptions for FiltersNeeded and FilterPaths parameters.
#   - Modified getParameter so that if a second argument is given, it is
#     used to initialize the parameter in case it is undefined.
#   - Added subroutines connectFilters, newFilterClientSocket,
#     setFilterPattern
#   - Added subroutine newMsg.
#
# * ControllerEntity.pm: Added filter support.
#   - Some general cleanup (removing stray commented code, etc.)
#   - Rewrote some sections for clarity (in invoke, _invoke,
#     _instantiate_and_run)
#   - Modularized loadmodule. Created new subroutines:
#       _loadmodule_error
#       _loadmodule_success
#   - Modularized _instantiate_and_run, creating new subroutine
#       _fork_and_run.
#   - Added the setupFilters subroutine, which takes care of loading
#     all the filters required by an entity. It is complemented by
#     an augmented message_CONNECT, which detects when a filter is
#     connecting and does the necessary updating.
#
# * Comm.pm: Removed an annoying debug message from bufferInput.
#
# * Agent.pm: Added code to contact the filters.
#
# Revision 1.19  1998/08/26 22:36:56  zamboni
# Reimplemented the reading mechanisms to use non-buffered I/O. This fixes
# problems that ocurred when mixing buffered I/O with the use of the Select
# object. Now the AAFID::Comm library keeps an internal buffer of lines
# read, and allows to retrieve them through nextMsg (interpreting them
# as AAFID messages, as usual) and through a new subroutine called nextLine,
# which returns the line read.
#
# Also, all the reading routines (nextMsg and now nextLine) return only
# the next available element. I had changed nextMsg so that it returned an
# array of messages, but that was a bad decision, I think, so we went back
# to the old behavior.
#
# Moved the RCS log to the end of each file.
#
# Now nextMsg and nextLine take named parameters for Timeout, Handle and
# Select object.
#
# Entity.pm and Monitor.pm were modified to go back to the behavior of Comm::nextMsg
# returning a single message. They had been modified to process a list of messages,
# but this was seen to be a bad decision.
#
# Also, calls to nextMsg were modified to make use of the new syntax, which requires
# named parameters.
#
# Revision 1.18  1998/08/11 16:23:37  zamboni
# - Made processInput process a list of messages (as changed in
#   Entity::processInput) and also return a list of messages.
#
# Revision 1.17  1998/06/29 20:11:23  zamboni
# Added copyright message
#
# Revision 1.16  1998/06/26 21:30:36  zamboni
# - Added "use AAFID::Config"
# - Made the command used to execute remote commands, and the command executed
#   remotely to start a new transceiver, into two configurable parameters
#   called RemoteExecCmd and StarterExecCmd, respectively.
#
# Revision 1.15  1998/06/25 21:39:08  zamboni
# - Changed the command used to execute the Starter in a remote host to one
#   that does not require the full path of the starter, as long as the
#   appropriate environment variables (PERLLIB) are set in the account in
#   which the command is executed. Also, made the separation between $cmd
#   and $remotecmd clearer ($cmd is the command executed locally, and
#   $remotecmd is the command executed in the remote host).
#
# Revision 1.14  1998/05/15 00:13:35  zamboni
# Corrected a few errors.
#
# Revision 1.13  1998/05/07 06:04:30  zamboni
# - Added isForMe and relayMessage, which override the corresponding
#   methods in AAFID::Entity. The purpose of them is to allow a Monitor
#   to forward a message down to the appropriate host if it does not
#   know the entity, but it has a connection to the host.
#
# Revision 1.12  1998/05/07 05:23:33  zamboni
# - Added message_DISCONNECT, which complements the method of the same
#   name in AAFID::ControllerEntity, to update the data structures that
#   exist only in AAFID::Monitor (in particular, the HostHandles
#   parameter) when a subentity disconnects.
#
# Revision 1.11  1998/05/05 20:17:53  zamboni
# The correct name for command_STARTMONITOR is command_STARTTRANSCEIVER.
# Changed it.
#
# Revision 1.10  1998/05/03 04:02:21  zamboni
# - Added to command_RUNSTARTER a check to see if we already have a
#   communication channel to the requested host. If so, don't run
#   the starter again.
#
# - Added a commmand_STARTMONITOR, which is simply a wrapper for
#   command_RUNSTARTER.
#
# Revision 1.9  1998/04/27 15:12:50  zamboni
# Cosmetic changes.
#
# Revision 1.8  1998/03/17 06:40:17  zamboni
# - Added documentation for _PendingSends.
#
# Revision 1.7  1998/03/16 02:50:42  zamboni
# - Added code to NEEDMODULE to send a request up when the requested
#   class is not found locally, and set the _PendingSends parameter
#   to send the class down when it is received.
# - Added a message_NEWMODULE to override the one inherited from
#   ControllerEntity. This subroutine calls the superclass method,
#   but afterwards, if the class had been previously requested by
#   a subentity, we send it down appropriately.
#
# Revision 1.6  1998/03/14 05:51:48  zamboni
# - Changed NEEDCODE and NONEEDCODE to NEEDMODULE and NONEEDMODULE. Also, made NEEDCODE
#   adhere to the standard message format (because it is no longer used only by Starters),
#   and made its response (the first line, at least) also be in message format (a
#   NEWMODULE message instead of the Code-Begin thing).
#
# Revision 1.5  1998/03/13 17:00:08  zamboni
# - Changed parameters PendingInvokes and AlreadyStarted to
#   _PendingInvoke and _AlreadyStarted.
# - Made $VERSION keep up with RCS revision number.
# - Added %PARAMETERS.
#
# Revision 1.4  1998/03/06 22:18:46  zamboni
# Testing mods to transfer the code.
#
# Revision 1.3  1998/03/06 16:38:55  zamboni
# - Modified invoke to send to the remote host the code it has to evaluate.
#   However, this is not working properly yet, so I removed the sending of the
#   code. Right now, we are still sending just the class name, and the remote
#   host has to find it locally.
#
# Revision 1.2  1998/03/06 07:09:44  zamboni
# - Added log messages to command_CONNECT.
# - Corrected use of gethostbyaddr in processInput, and added some logging.
#
# Revision 1.1  1998/03/06 05:19:02  zamboni
# Initial revision
#
