/* Agent Tcl
   Bob Gray
   27 February 1995

   tclBasic.cc

   This file implements the library routines that handle migration, 
   message passing and meetings.

   Copyright (c) 1995, Robert S. Gray Dartmouth College

   See the file "agent.terms" for information on usage and redistribution
   of this file and for a DISCLAIMER OF ALL WARRANTIES.
*/

#ifndef NO_PRAGMAS
#pragma implementation "agentTcl.h"
#endif

#include "platPorting.h"
#include "agentTcl.h"
#include "mesgMachId.h"	// MachineId class
#include "suppDBuffer.h"
#include "suppDString.h"
#include "genLocation.h"	// LOCATION
#include "genMeeting.h"
#include "mesgConnection.h"

/* ------------------------------------------------------------ */

#include "platTimeval.h"
#include "agentTcl.h"
#include "agentTclInt.h"
#include "tcl.h"
#include "tclUtility.h"
#include "truefalse.h"

    /* file-access callbacks */

class TclFileCallbacks: public FileCallbacks
{
	Tcl_Channel channel;

    public:

	TclFileCallbacks (Tcl_Channel p_channel):
	    channel (p_channel)
	{
	    // empty
	}
	
	Connection::ConnectionErrors read (int n, char *buffer, int &nread) {
	    assert (buffer != NULL);
	    nread = Tcl_Read (channel, buffer, n);
	    return ((nread < n) ? Connection::e_CantRead : Connection::e_Ok);
	}

	Connection::ConnectionErrors write (int n, const char *buffer, int &nwritten) {
	    assert (buffer != NULL);
	    nwritten = Tcl_Write (channel, (char *) buffer, n);
	    return ((nwritten < n) ? Connection::e_CantWrite : Connection::e_Ok);
	}
};

/* Agent_Select

   Purpose: Wait for a message, event, meeting request or an incoming
	    message or file on a connected meeting.  This is the agent
	    equivalent of the Unix "select" command.
	     
     Input: interp      = the current interpreter
		          (struct Tcl_Interp *)

	    seconds     = the timeout interval
		          (double)

	    selectParms = items, handles and fds that select should watch
			  (AgentSelectParameters *)
			
    Output: The procedure returns TCL_ERROR and sets the interpreter
	    result to an appropriate error message on error.  Otherwise
	    the procedure returns TCL_OK and updates selectParams to reflect
	    which items, handles or fds are actually ready.
*/

int Agent_Select (Tcl_Interp *interp, double seconds, 
	AgentSelectParameters *selectParams)
{
    int code;
    UINT_32 i;
    char buffer[16];
    AGENT_TCL *agent;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (selectParams != (AgentSelectParameters *) NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentSelect (delay, *selectParams)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    if (code == AGENT_BAD_MEETING) {

	UINT_8 status;
	UINT_32 handle;

	for (i = 0; i < selectParams->getNumHandles(); i++) {

	    status = selectParams->isHandleReady (i, handle);

	    if (status == MEET_DOES_NOT_EXIST) {
		fastIntegerToAscii (handle, buffer);
		Tcl_AppendResult (interp, 
		    "no meeting with handle \"", buffer, "\"", (char *) NULL);
		return TCL_ERROR;
	    }
 	}

        code = AGENT_UNKNOWN;

    } else if (code == AGENT_TIMEOUT) {

	return TCL_OK;
    }
		 
    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, (char *) NULL).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_Transfer

   Purpose: Transfer a server message from a disk file to a server

     Input: interp   = the current interpreter
		       (struct Tcl_Interp *)

            seconds  = the timeout interval
		       (double)

            machine  = destination server
		       (struct MachineId *)

	    channel  = channel from which the REQ_SUBMIT message will be read
		       (Tcl_Channel)

    Output: The procedure NULL and sets the interpreter result to an 
	    appropriate error message on error.  Otherwise the procedure
	    returns a dynamically allocated AgentId structure that
	    contains the id of the newly transferred agent.
*/

AgentId *Agent_Transfer (Tcl_Interp *interp, double seconds, MachineId *machine, Tcl_Channel channel)
{
    int rc;
    AGENT_TCL *agent = NULL;
    AgentId *id = NULL;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (machine != NULL);
    assert (channel != NULL);
    assert (seconds >= 0.0);

	/* get the agent structure */ 

    agent = (AGENT_TCL *) AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* timeout */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* put the channel into binary mode and construct the file callbacks */

    Tcl_DString optionValue;
    Tcl_DStringInit (&optionValue);
#ifdef TCL8
    Tcl_GetChannelOption (interp, channel, "-translation", &optionValue);
#else
    Tcl_GetChannelOption (channel, "-translation", &optionValue);
#endif
    Tcl_SetChannelOption (NULL, channel, "-translation", "binary");
    TclFileCallbacks callbacks (channel);

	/* transfer the next message in the disk file to the server */

    if ((rc = agent -> agentTransfer (delay, *machine, callbacks, id)) != AGENT_OK) {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, agent -> agentCodeToLongString (rc, machine -> getName()).value(), TCL_VOLATILE);
	id = NULL; 	
    }

	/* put the channel back into its original mode */

    Tcl_SetChannelOption (NULL, channel, "-translation", Tcl_DStringValue(&optionValue));
    Tcl_DStringFree (&optionValue);
    return (id);
}

/* Agent_Root

   Purpose: Turn the current agent into the root

     Input: interp = the current interpreter
 
    Output: The procedure returns TCL_ERROR and sets the interpreter result
            to an appropriate error message one error.  Otherwise the procedure
            returns TCL_OK.
*/

int Agent_Root (Tcl_Interp *interp)
{
    int code;
    AGENT_TCL *agent;

	/* AGENT structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* turn the agent into a root agent */

    if ((code = agent -> agentRoot()) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, (char *) NULL).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Meeting_Sendfile

   Purpose: Send a file across a meeting connection

     Input: interp  = the Tcl interpreter
		      (struct Tcl_Interp *)

	    handle  = handle of the meeting
		      (UINT_32)

	    channel = the Tcl channel
		      (Tcl_Channel)

	    bytes   = the byte count
		      (UINT_32)

    Output: The procedure returns TCL_ERROR and sets the intepreter result
	    to an appropriate error message on error.  Otherwise the procedure
            returns TCL_OK and sends the file along the connection.
*/

int Meeting_Sendfile (Tcl_Interp *interp, UINT_32 handle, Tcl_Channel channel, UINT_32 bytes)
{
    int rc;
    int code;
    AGENT_TCL *agent;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (channel != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* put the channel into binary mode and construct the file callbacks */

    Tcl_DString optionValue;
    Tcl_DStringInit (&optionValue);
#ifdef TCL8
    Tcl_GetChannelOption (interp, channel, "-translation", &optionValue);
#else
    Tcl_GetChannelOption (channel, "-translation", &optionValue);
#endif
    Tcl_SetChannelOption (NULL, channel, "-translation", "binary");
    TclFileCallbacks callbacks (channel);

	/* send the file along the meeting */ 

    if ((rc = agent -> agentMeetingSendfile (handle, callbacks, bytes)) == AGENT_OK) {

	code = TCL_OK;

    } else {

	code = TCL_ERROR;
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString (rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, "can't send file: ", TCL_STATIC);
	Tcl_AppendResult (interp, agent -> agentCodeToLongString (rc, (char *) NULL).value(), (char *) NULL);
    }

	/* put the channel back into its original mode */

    Tcl_SetChannelOption (NULL, channel, "-translation", Tcl_DStringValue(&optionValue));
    Tcl_DStringFree (&optionValue);
    return (code);
}

/* Meeting_Send

   Purpose: Send a message across a meeting

     Input: interp = the Tcl interpreter
		     (struct Tcl_Interp *)

	    handle = handle of the meeting
		     (UINT_32)

	    code   = the message code
		     (UINT_32)

	    string = the message string
		     (char *)

    Output: The procedure returns TCL_ERROR and sets the interpreter
	    result to an appropriate error message on error.  Otherwise
	    the procedure returns TCL_OK and sends the message along the
	    meeting.
*/

int Meeting_Send (Tcl_Interp *interp, UINT_32 handle, UINT_32 code, char *string)
{ 
    int rc;
    AGENT_TCL *agent;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (string != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* send the message along the meeting */ 

    if ((rc = agent -> agentMeetingSend (handle, code, string)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
    Tcl_SetResult (interp, "can't send message: ", TCL_STATIC);
    Tcl_AppendResult (interp, agent -> agentCodeToLongString (rc, (char *) NULL).value(), (char *) NULL);
    return TCL_ERROR;
}

/* Meeting_Close

   Purpose: Close a meeting

     Input: interp = Tcl interpreter
		     (struct Tcl_Interp *)

	    handle = handle of the meeting
		     (UINT_32)

    Output: The procedure returns TCL_ERROR and sets the interpreter result
	    to an appropriate error message on error.  Otherwise the procedure
	    returns TCL_OK and closes the meeting.
*/

int Meeting_Close (Tcl_Interp *interp, UINT_32 handle)
{
    int code;
    AGENT_TCL *agent;

	/* assertions on the parameters */

    assert (interp != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    if ((code = agent -> agentCloseMeeting (handle)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, "can't close meeting: ", TCL_STATIC);
    Tcl_AppendResult (interp, agent -> agentCodeToLongString (code, (char *) NULL).value(), (char *) NULL);
    return TCL_ERROR;

} 

/* Agent_Accept

   Purpose: Accept a meeting request

     Input: interp = Tcl interpreter
		     (struct Tcl_Interp *interp)

	    seconds = timeout interval
		      (double)

	    handle  = handle of the meeting to accept
		      (UINT_32)

    Output: The procedure retruns TCL_ERROR and sets the interpreter result
	    to an appropriate error message on error.  Otherwise the procedure
	    returns TCL_OK.
*/

/* Agent_AcceptAndWait

   Purpose: Accept a meeting request (and then wait until the meeting
	    connection is complete)

     Input: interp = Tcl interpreter
		     (struct Tcl_Interp *interp)

	    seconds = timeout interval
		      (double)

	    handle  = handle of the meeting to accept
		      (UINT_32)

    Output: The procedure retruns TCL_ERROR and sets the interpreter result
	    to an appropriate error message on error.  Otherwise the procedure
	    returns TCL_OK.
*/

int Agent_AcceptAndWait (Tcl_Interp *interp, double seconds, UINT_32 handle)
{
    int code;
    AgentId id;
    AGENT_TCL *agent;
    struct timeval delay;
    
	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentAccept (delay, handle, id)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, "can't accept meeting: ", TCL_STATIC);
    Tcl_AppendResult (interp, agent -> agentCodeToLongString (code, id.getServerName()).value(), (char *) NULL);
    return TCL_ERROR;
}

int Agent_Accept (Tcl_Interp *interp, double seconds, UINT_32 handle)
{
    int code;
    AgentId id;
    AGENT_TCL *agent;
    struct timeval delay;
    
	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentAcceptMeeting (delay, handle, id)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, "can't accept meeting: ", TCL_STATIC);
    Tcl_AppendResult (interp, agent -> agentCodeToLongString (code, id.getServerName()).value(), (char *) NULL);
    return TCL_ERROR;
}

/* Agent_Reject

   Purpose: Reject a meeting request

     Input: interp = Tcl interpretr
		     (struct Tcl_Interp *interp)

	    seconds = timeout interval
		      (double)

	    handle  = handle of the meeting to accept
		      (UINT_32)

    Output: The procedure retruns TCL_ERROR and sets the interpreter result
	    to an appropriate error message on error.  Otherwise the procedure
	    returns TCL_OK.
*/

int Agent_Reject (Tcl_Interp *interp, double seconds, UINT_32 handle)
{
    int code;
    AgentId id;
    AGENT_TCL *agent;
    struct timeval delay;
    
	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentRejectMeeting (delay, handle, id)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, "can't rject meeting: ", TCL_STATIC);
    Tcl_AppendResult (interp, agent -> agentCodeToLongString (code, id.getServerName()).value(), (char *) NULL);
    return TCL_ERROR;
}

/* Agent_Meet

   Purpose: Meet with another agent

     Input: interp  = Tcl interpreter
		      (struct Tcl_Interp *interp);

            seconds = timeout interval
		      (double)

            id      = identification of the destination agent
		      (AgentId *)

    Output: The procedure returns TCL_ERROR and sets the interpreter
            result to an error message on error.  The procedure returns
            TCL_OK on success.  On success

	    *handle = handle for the new meeting
		      (UINT_32)
*/

int Agent_Meet (Tcl_Interp *interp, double seconds, AgentId *id, UINT_32 *handle)
{ 
    int code;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (id != NULL);
    assert (handle != NULL);

	/* AGENT */

    AGENT_TCL *agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    struct timeval delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentMeet (delay, *id, *handle)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, id -> getServerName()).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_Request

   Purpose: Send a meeting request to an agent

     Input: interp  = Tcl interpreter
		      (struct Tcl_Interp *interp);

            seconds = timeout interval
		      (double)

            id      = identification of the destination agent
		      (AgentId *)

    Output: The procedure returns TCL_ERROR and sets the interpreter
            result to an error message on error.  The procedure returns
            TCL_OK on success.  On success

	    *handle = handle for the new meeting
		      (UINT_32)
*/

int Agent_Request (Tcl_Interp *interp, double seconds, AgentId *id, UINT_32 *handle)
{ 
    int code;
    AGENT_TCL *agent;
    struct timeval delay;
    
	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (id != NULL);
    assert (handle != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* make the meeting request */ 

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentRequestMeeting (delay, *id, *handle)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error occurred so describe the error */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, id -> getServerName()).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_GetReq

      Purpose: Get a meeting request

        Input: interp  = Tcl interpeter
			 (struct Tcl_Interp *)

               seconds = timeout interval 
			 (double)

       Output: The procedure returns TCL_ERROR and sets the intrepreter result
               to an error message if an error occurs.  The procedure returns
               TCL_OK and sets "*meeting" to NULL if no meeting request arrives
               during the timeout interval.  Otherwise the procedure sets
               "*meeting" to a dynamically allocated INCOMING_MEETING structure
               that contains the meeting request.
*/

int Agent_GetReq (Tcl_Interp *interp, double seconds, INCOMING_MEETING **meeting)
{
    AGENT_TCL *agent;
    int errorCode;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (meeting != NULL);

	/* agent structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* time delay */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* receive a message */

    if ((errorCode = agent -> agentReceiveMeeting (delay, *meeting)) == AGENT_OK) {
	return TCL_OK;
    } else if (errorCode == AGENT_TIMEOUT) {
	return TCL_OK;
    }

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (errorCode, (char *) NULL).value(), TCL_VOLATILE);
    return TCL_ERROR;
} 

/* Agent_Begin

      Purpose: Notify a server that we are now an agent

        Input: interp  = Tcl interpreter
               seconds = seconds before timeout (0 or greater)
               dest    = machine identification
 
       Output: The procedure returns NULL and sets the interpreter result to
               an error message on error.  Otherwise the procedure returns
               a pointer to an AgentId structure that contains the new agent
               identification.  The AgentId structure and its string elements
               are DYNAMICALLY allocated.
*/

AgentId *Agent_Begin (Tcl_Interp *interp, double seconds, MachineId *server)
{
    struct timeval delay;
    LOCATION *location;
    AGENT_TCL *agent;
    int code;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (server != NULL);

	/* AGENT_TCL structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

 	/* LOCATION structure */

    location = agent -> get_location (); 
    assert (location != NULL);

	/* register the agent */

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((code = agent -> agentBegin (delay, *server)) == AGENT_OK) {
        AgentId *id = new AgentId (location -> getLocal());
	return (id);
    }

	/* error so get an errorCode and an error message */

    MachineId machine;

    if (server -> isEmpty()) {
	machine = location -> getMachine();
    } else {
	machine = *server;
    }

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, machine.getName()).value(), TCL_VOLATILE);
    return ((AgentId *) NULL);
} 

/* Agent_Name

      Purpose: Assign a name to an agent

        Input: interp  = the Tcl interpreter
               seconds = timeout interval
               name    = name for the agent

       Output: The procedure returns NULL and sets the interpreter result
               to an error message on error.  Otherwise the procedure returns
               a pointer to an AgentId structure that contains the new
               agent identification.  The AgentId structure and its string
               elements are DYNAMICALLY allocated.
*/

AgentId *Agent_Name (Tcl_Interp *interp, double seconds, char *name)
{
    int code;
    int number;
    AGENT_TCL *agent;
    LOCATION *location;
    struct timeval stop;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (name != NULL);

	/* AGENT_TCL */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* LOCATION */

    location = agent -> get_location ();
    assert (location != NULL);

	/* make sure that the name is not an integer */

    if (Tcl_GetInt (interp, name, &number) == TCL_OK) {
      Tcl_AppendResult (interp, "name can not be a number", (char *) NULL);
      return ((AgentId *) NULL);
    } else {
      Tcl_ResetResult (interp);
    }

	/* timeout mark */

    stop = TimevalUtil::secondsToTimeval (seconds);
 
	/* name the agent */

    if ((code = agent->agentName (stop, name)) == AGENT_OK) {
	AgentId *id = new AgentId (location -> getLocal ());
	return (id);
    }

	/* error so get an errorCode and an error message */

    const AgentId &id = location -> getLocal();
    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString (code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, id.getServerName()).value(), TCL_VOLATILE);
    return ((AgentId *) NULL);
}

/* Agent_End

      Purpose: Notify the server that we are no longer an agent

        Input: interp  = the Tcl interpreter
               seconds = number of seconds until timeout (0 or greater)
 
       Output: The procedure returns TCL_ERROR and sets the intrepreter
               result to an error message if an error occurs.  Otherwise
               the procedure returns TCL_OK.
*/

int Agent_End (Tcl_Interp *interp, double seconds)
{
    int code;
    AGENT_TCL *agent;
    LOCATION *location;
    struct timeval stop;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);

	/* AGENT structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* LOCATION structure */

    location = agent -> get_location ();

	/* timeout mark */

    stop = TimevalUtil::secondsToTimeval (seconds);
 
	/* end the agent */

    if ((code = agent -> agentEnd (stop, AGENT::e_END_NORMAL)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error so get an errorCode and an error message */

    const AgentId &local = location -> getLocal ();
    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(code)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (code, local.getServerName()).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_Jump

      Purpose: Jump to a remote machine

        Input: interp     = Tcl interpreter
               seconds    = timeout interval
               machine_id = id of the remote machine  
 
       Output: The procedure returns TCL_ERROR and sets the interpreter result
               to an error message if it is unable to transport the agent
               to the remote machine.  The procedure returns TCL_OK and
               sets the interpreter result to "SAME" if the remote machine
               is the same as the current machine.  Otherwise the procedure
               calls exit and the agent resumes execution on the remote machine
               with the interpreter result set to "JUMPED".
*/

int Agent_Jump (Tcl_Interp *interp, double seconds, MachineId *machine)
{
    int rc; 
    int code;
    AGENT_TCL *agent;
    AgentId *id = NULL;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (machine != NULL);

	/* not in interactive mode */

#ifdef TCL8

    abort_with_message ("Tcl 8.0 does not yet support jump");
    return TCL_ERROR;

#else

    if (interp -> interactive) {
	Tcl_AppendResult (interp, "can not jump in interactive mode", (char *) NULL);
	return TCL_ERROR;
    }

#endif

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* timeout */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* jump */

    if ((rc = agent -> agentJump (delay, *machine, id, AGENT::e_JUMPING)) == AGENT_BAD_STATE) {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_AppendResult (interp, ": unable to capture state", (char *) NULL);
	code = TCL_ERROR;
    } else if (rc == AGENT_SAME) {
	code = TCL_CONTINUE;
    } else if (rc != AGENT_OK) {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, agent -> agentCodeToLongString (rc, machine -> getName()).value(), TCL_VOLATILE);
	code = TCL_ERROR;
     } else {
	delete (id);	
	code = TCL_OK;
     }

	/* cleanup */

    return (code);
} 

/* Agent_Disk 

   Purpose: Jump to a remote machine *but* save the REQ_SUBMIT message on disk
            for later transmission rather than sending the REQ_SUBMIT message
            directly to the remote server

     Input: interp  = the current interpreter
		      (struct Tcl_Interp *)

	    channel = file channel in which to save the REQ_SUBMIT message
		      (Tcl_Channel)

    Output: The procedure returns TCL_ERROR and sets the interpreter result
	    to an appropriate error message on error.  Otherwise the 
	    procedure returns TCL_OK and saves the REQ_SUBMIT message to
	    the specified file.
*/

int Agent_Disk (Tcl_Interp *interp, Tcl_Channel channel)
{
    int rc;
    int code;
    AGENT_TCL *agent;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (channel != NULL);

	/* not in interactive mode */

#ifdef TCL8

    abort_with_message ("Tcl 8.0 does not yet support agent_disk");
    return TCL_ERROR;

#else

    if (interp -> interactive) {
	Tcl_AppendResult (interp, "can not jump in interactive mode", (char *) NULL);
	return TCL_ERROR;
    }

#endif

	/* AGENT */

    agent = (AGENT_TCL *) AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* put the channel into binary mode and construct the file callbacks */

    Tcl_DString optionValue;
    Tcl_DStringInit (&optionValue);
#ifdef TCL8
    Tcl_GetChannelOption (interp, channel, "-translation", &optionValue);
#else
    Tcl_GetChannelOption (channel, "-translation", &optionValue);
#endif
    Tcl_SetChannelOption (NULL, channel, "-translation", "binary");
    TclFileCallbacks callbacks (channel);

	/* transfer the agent to a disk file */ 

    if ((rc = agent -> agentDisk (callbacks)) == AGENT_OK) {
	code = TCL_OK;
    } else {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, agent -> agentCodeToLongString (rc, NULL).value(), TCL_VOLATILE);
	code = TCL_ERROR;
    }

	/* flush the channel buffers */

    if (code == TCL_OK) {
	Tcl_Flush (channel);
    }

	/* put the channel back into its original mode */

    Tcl_SetChannelOption (NULL, channel, "-translation", Tcl_DStringValue(&optionValue));
    Tcl_DStringFree (&optionValue);
    return (code);
}

/* Agent_Fork

   Purpose: Create a copy of an agent on a remote machine

     Input: interp     = the current interpreter
            seconds    = timeout interval 
            machine_id = id of the remote machine

    Output: The procedure returns TCL_ERROR and sets the interpreter result to
            an appropriate error message if it is unable to fork the child 
            agent.  Otherwise the procedure returns TCL_OK and sets the 
            interpreter result to the identification of the new child agent.
            The interpreter result in the child agent is set to "CHILD".
*/

AgentId *Agent_Fork (Tcl_Interp *interp, double seconds, MachineId *machine)
{
    int rc;
    AGENT_TCL *agent;
    AgentId *id = NULL;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (machine != NULL);

	/* not in interactive mode */

#ifdef TCL8

    abort_with_message ("Tcl 8.0 does not yet support fork");
    return ((AgentId *) NULL);

#else

    if (interp -> interactive) {
	Tcl_AppendResult (interp, "can not fork in interactive mode", (char *) NULL);
	return ((AgentId *) NULL);
    }

#endif

	/* AGENT structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* timeout */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* fork the agent */

    if ((rc = agent -> agentJump (delay, *machine, id, AGENT::e_FORKING)) == AGENT_BAD_STATE) {
	Tcl_AppendResult (interp, ": unable to capture state", (char *) NULL);
    } else if (rc != AGENT_OK) {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, agent -> agentCodeToLongString (rc, machine -> getName()).value(), TCL_VOLATILE); 
    } 

	/* cleanup */

    return (id);
}

/* Agent_GetEvent

      Purpose: Check to see if any events are available for the agent

        Input: interp    = Tcl interpreter
               seconds   = number of seconds
                     
               "seconds" is the time out interval.  The procedure waits 
               until a message arrive if seconds is less than 0.  The
               procedure waits until a message has arrived or until 
               "seconds" seconds have elapsed if seconds is 0 or greater.
                 
       Output: The procedure returns TCL_ERROR and sets the interpreter result
               to an error message if an error occurs.  Otherwise the 
               procedure returns TCL_OK and either (1) sets *event to NULL
               if no event arrived before the timeout expired or (2) sets 
               *event to a dynamically allocated EVENT_EXT structure that 
               contains the message.
*/

int Agent_GetEvent (Tcl_Interp *interp, double seconds, INCOMING_EVENT **event)
{
    AGENT_TCL *agent;
    int errorCode;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (event != NULL);

	/* agent structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* time delay */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* receive a message */

    if ((errorCode = agent -> agentReceiveEvent (delay, *event)) == AGENT_OK) {
	return TCL_OK;
    } else if (errorCode == AGENT_TIMEOUT) {
	return TCL_OK;
    }

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (errorCode, (char *) NULL).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Meeting_Getfile

   Purpose: Receive a file from a meeting

     Input: interp = the current interpreter
		     (struct Tcl_Interp *) 

	    seconds = maximum number of seconds to wait for the meeting
		      (double)

	    handle  = the meeting handle
		      (UINT_32)

	    channel = the Tcl channel
		      (Tcl_Channel)

    Output: The procedure returns TCL_ERROR and sets the intepreter result
	    to an appropriate error message on error.  The procedure returns
	    TCL_BREAK if no file became available before the timout
	    expired.  Otherwise the procedure returns TCL_OK, reads the file 
	    from the meeting, and sets "bytes" to the number of bytes read.
*/   

int Meeting_Getfile (Tcl_Interp *interp, double seconds, UINT_32 handle, Tcl_Channel channel, UINT_32 &bytes)
{
    int code;
    int errorCode;
    AGENT_TCL *agent;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (channel != NULL);

	/* agent structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* time delay */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* put the channel into binary mode and construct the file callbacks */

    Tcl_DString optionValue;
    Tcl_DStringInit (&optionValue);
#ifdef TCL8
    Tcl_GetChannelOption (interp, channel, "-translation", &optionValue);
#else
    Tcl_GetChannelOption (channel, "-translation", &optionValue);
#endif
    Tcl_SetChannelOption (NULL, channel, "-translation", "binary");
    TclFileCallbacks callbacks (channel);

	/* receive the file */

    if ((errorCode = agent -> agentMeetingGetfile (delay, handle, callbacks, bytes)) == AGENT_OK) {

	code = TCL_OK;

    } else if (errorCode == AGENT_TIMEOUT) {

	code = TCL_BREAK;

    } else {

	code = TCL_ERROR;
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
	Tcl_ResetResult (interp);
	Tcl_AppendResult (interp, "can't receive file: ", agent -> agentCodeToLongString (errorCode, (char *) NULL).value(), (char *) NULL);
    }

	/* put the channel back into its original mode */

    Tcl_SetChannelOption (NULL, channel, "-translation", Tcl_DStringValue(&optionValue));
    Tcl_DStringFree (&optionValue);
    return (code);
} 

/* Meeting_Receive

   Purpose: Receive a message from a meeting connection 

     Input: interp  = the current interpreter
		      (Tcl_Interp *)

            seconds = maximum number of seconds to wait for a message
		      (double)

	    handle  = the meeting handle
		      (UINT_32)

    Output: The procedure returns TCL_ERROR and sets the intepreter result
	    to an appropriate error message if an error occurs.  The procedure
	    returns TCL_BREAK if no message arrived before the timeout
	    expired.  Otherwise the procedure returns TCL_OK, sets *code to
	    the message code, and sets *string to a dynamically allocated
	    character array that contains the message string.
	    if no message arrived before the timeout    
*/

int Meeting_Receive (Tcl_Interp *interp, double seconds, UINT_32 handle, UINT_32 *code, char **string)
{
    int errorCode;
    AGENT_TCL *agent;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (string != NULL);

	/* agent structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* time delay */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* receive a message */

    if ((errorCode = agent -> agentMeetingReceive (delay, handle, *code, *string)) == AGENT_OK) {
	return TCL_OK;
    } else if (errorCode == AGENT_TIMEOUT) {
	return TCL_BREAK;
    }

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_ResetResult (interp);
    Tcl_AppendResult (interp, "can't receive message: ", agent -> agentCodeToLongString (errorCode, (char *) NULL).value(), (char *) NULL);
    return TCL_ERROR;
} 

/* Agent_Receive

      Purpose: Check to see if any messages are available for the agent

        Input: interp    = Tcl interpreter	
			   (Tcl_Interp *)

               seconds   = maximum number of seconds to wait
			   (double)
                     
       Output: The procedure returns TCL_ERROR and sets the interpreter result
               to an error message if an error occurs.  Otherwise the 
               procedure returns TCL_OK and either (1) sets *message to NULL
               if no message arrived before the timeout expired or (2) sets 
               *message to a dynamically allocated MESSAGE_EXT structure that 
               contains the message.
*/

int Agent_Receive (Tcl_Interp *interp, double seconds, INCOMING_MESSAGE **message)
{
    AGENT_TCL *agent;
    int errorCode;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (message != NULL);

	/* agent structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* time delay */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* receive a message */

    if ((errorCode = agent -> agentReceiveMessage (delay, *message)) == AGENT_OK) {
	return TCL_OK;
    } else if (errorCode == AGENT_TIMEOUT) {
	return TCL_OK;
    }

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (errorCode, (char *) NULL).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_Event

      Purpose: Send an event to an agent

        Input: interp  = the Tcl interpreter
               seconds = timeout interval
               id      = the destination agent
               tag     = the event tag
               string  = the vent string

       Output: The procedure returns TCL_ERROR and sets the interpreter result
               to an appropriate error message on error.  Otherwise the
               procedure returns TCL_OK and sends the event to the 
               destination agent.
*/

int Agent_Event (Tcl_Interp *interp, double seconds, AgentId *id, char *tag, char *string)
{
    AGENT_TCL *agent;
    int errorCode;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (id != NULL);
    assert (tag != NULL);
    assert (string != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* send the event */

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((errorCode = agent -> agentSendEvent (delay, *id, tag, string)) == AGENT_OK) {
	return TCL_OK;
    }

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (errorCode, id -> getServerName()).value(), TCL_VOLATILE);
    return TCL_ERROR;
}

/* Agent_SendResult

   Purpose: Send the result of script execution to the root agent

     Input: interp   = the current interpreter
		       (struct Tcl_Interp *)

            maxTries = maximum number of transmission attempts
		       (int)

            maxSleep = maximum number of seconds to wait between attempts
		       (int)

            code     = Tcl result code
		       (int)

    Output: The procedure returns TCL_ERROR if it is unable to send the result
            to the root agent and TCL_OK otherwise.  The procedure uses an
            exponential backoff algorithm and keeps trying to send the result
            until it either succeeds or makes the specified number of attempts.
*/

int Agent_SendResult (Tcl_Interp *interp, int maxTries, int maxSleep, UINT_32 code)
{
    int i = 0;
    char *string;
    int agentCode; 
    char *argv[3];
    AGENT_TCL *agent;
    LOCATION *location;
    int rc = TCL_ERROR;
    struct timeval tryTime;
    struct timeval sleepTime;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (maxTries >= 0);
    assert (maxSleep >= 0);

	/* AGENT and LOCATION structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);
    location = agent -> get_location ();

	/* do not send to ourselves */

    if (location -> isRoot ()) {
	return TCL_OK;
    }

    const AgentId &root = location -> getRoot ();

	/* set up the message */

    if (code != TCL_OK) {

	if ((argv[0] = interp -> result) == NULL) {
	    argv[0] = "";
	}

	if ((argv[1] = Tcl_GetVar2 (interp, "errorCode", NULL, TCL_GLOBAL_ONLY)) == NULL) {
	    argv[1] = "";
	}
 
	if ((argv[2] = Tcl_GetVar2 (interp, "errorInfo", NULL, TCL_GLOBAL_ONLY)) == NULL) {
	    argv[2] = "";
	}

	string = Tcl_Merge (3, argv);

    } else {

	string = interp -> result;
    }

	/* set up the initial timings */

    sleepTime.tv_sec  = 1;
    sleepTime.tv_usec = 0;
    tryTime.tv_sec    = 30;
    tryTime.tv_usec   = 0;

	/* send the result */

    while (1) {

	if ((agentCode = agent -> agentSendMessage (tryTime, root, code, string)) == AGENT_OK) {
	    rc = TCL_OK;
	    break;
	}

	if (agentCode == AGENT_NONEXISTENT) {
	    break;
	}

	tryTime.tv_sec += 30;

	if (++i >= maxTries) {
	    break;
	}

	agent -> agentSleep (sleepTime);

	if (sleepTime.tv_sec * 2 < maxSleep) {
	    sleepTime.tv_sec *= 2;
	} else {
	    sleepTime.tv_sec = maxSleep;
	}
    }

	/* cleanup */

    if (string != interp -> result) {
	delete (string);
    }

    return (rc);
} 

/* Agent_Send

      Purpose: Send a message to an agent

        Input: interp  = the Tcl interpreter
               seconds - timeout interval
               id      = id of the destination agent
               code    = message code
               string  = message string
 
       Output: The procedure returns TCL_ERROR and sets the interpreter
               result to an error message if an error occurs.  Otherwise
               the procedure returns TCL_OK.
*/

int Agent_Send (Tcl_Interp *interp, double seconds, AgentId *id, UINT_32 code, char *string)
{
    AGENT_TCL *agent;
    int errorCode;
    struct timeval delay;
    
	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (id != NULL);
    assert (string != NULL);

	/* AGENT */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* send the message */

    delay = TimevalUtil::secondsToTimeval (seconds);

    if ((errorCode = agent -> agentSendMessage (delay, *id, code, string)) == AGENT_OK) {
	return TCL_OK;
    } 

	/* error so construct an appropriate error message */

    Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(errorCode)).value(), (char *) NULL);
    Tcl_SetResult (interp, agent -> agentCodeToLongString (errorCode, id -> getServerName()).value(), TCL_VOLATILE); 
    return TCL_ERROR;
}

/* Agent_Script

      Purpose: Construct a Tcl script that corresponds to the given variables,
	       procedures and subscripts.

        Input: interp        = the current Tcl interpreter
			       (char **)

	       numProcedures = the number of procedures
			       (int)

	       procedures    = the names of the procedures
			       (char **)

	       numVariables  = the number of variables
                               (int)

	       variables     = the variables
			       (char **)

	       script        = the subscript
			       (char *)

       Output: The procedure returns NULL and sets the interpreter result to
               an appropriate error message on error.  Otherwise the procedure
	       returns a pointer to a dynamically allocated string that
	       contains the constructed Tcl script. 
*/

char *Agent_Script (Tcl_Interp *interp, int numProcedures, char **procedures, int numVariables, char **variables, char *script)
{
    Tcl_DString state;
    char *stateString;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert ((numProcedures == 0) || (procedures != NULL));
    assert ((numVariables == 0) || (variables != NULL));
    assert (script != NULL);

#ifdef TCL8

	/* Tcl 8.0 can not yet handle submit */

    abort_with_message ("Tcl 8.0 can not yet handle submit");
    return ((char *) NULL);

#else

	/* get the variables */

    Tcl_DStringInit (&state);

    if (numVariables != 0) {
	if (Tcl_SaveVariableList (interp, numVariables, variables, &state) != TCL_OK) {
	    Tcl_AppendResult (interp, ": unable to save variables", (char *) NULL);
	    Tcl_DStringFree (&state);
	    return ((char *) NULL); 
	}
    }

	/* get the procedures */

    if (numProcedures != 0) {
	if (Tcl_SaveProcedureList (interp, numProcedures, procedures, &state) != TCL_OK) { 
	    Tcl_AppendResult (interp, ": unable to save procedures", (char *) NULL);
	    Tcl_DStringFree (&state);
	    return ((char *) NULL);
	}
    }

	/* add the script */

    Tcl_DStringAppend (&state, script, strlen(script));

	/* return the state string */

    stateString = Tcl_DStringExtract (&state);
    Tcl_DStringFree (&state);
    return (stateString);

#endif
}

/* Agent_Submit

      Purpose: Submit an agent to the server

        Input: interp        = the Tcl interpreter
               seconds       = timeout interval
               machine_id    = the destination machine
               version       = language name and version
               numProcedures = number of procedures      
               procedures    = procedure names
               numVariables  = number of variables
               variables     = variable names
               script        = script 

       Output: The procedure returns NULL and sets the interpreter
               result to an error message if an error occurs.  Otherwise
               the procedure returns an AgentId structure that contains
               the id of the submitted agent.
*/

AgentId *Agent_Submit (Tcl_Interp *interp, double seconds,
	MachineId *machine, Version *version, int numProcedures, 
        char **procedures, int numVariables, char **variables,
	char *script)
{
    int rc;
    char *stateString;
    AGENT_TCL *agent;
    AgentId *id = NULL;
    struct timeval delay;

	/* assertions on the parameters */

    assert (interp != NULL);
    assert (seconds >= 0.0);
    assert (machine != NULL);
    assert ((numProcedures == 0) || (procedures != NULL));
    assert ((numVariables == 0) || (variables != NULL));
    assert (script != NULL);

	/* construct the Tcl script */

    if ((stateString = Agent_Script (interp, numProcedures, procedures, numVariables, variables, script)) == NULL) {
	return ((AgentId *) NULL);
    }

    DynamicBuffer stateBuffer (strlen(stateString) + 1, stateString, BufferOwnership::e_TAKE);
 
	/* AGENT structure */

    agent = AGENT_TCL::get_agent (interp);
    assert (agent != NULL);

	/* timeout */

    delay = TimevalUtil::secondsToTimeval (seconds);

	/* submit the child agent */

    if ((rc = agent -> agentSubmit (delay, *machine, version, stateBuffer, id)) != AGENT_OK) {
	Tcl_SetErrorCode (interp, (agent -> agentCodeToShortString(rc)).value(), (char *) NULL);
	Tcl_SetResult (interp, agent -> agentCodeToLongString (rc, machine -> getName()).value(), TCL_VOLATILE);
    }

    return (id);
}
