/* 

 * tclInterp.c --

 *

 *	This file implements the "interp" command which allows creation

 *	and manipulation of Tcl interpreters from within Tcl scripts.

 *

 * Copyright (c) 1995-1997 Sun Microsystems, Inc.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclInterp.c,v 1.20.2.3 2006/11/28 22:20:02 andreas_kupries Exp $

 */

#include "tclInt.h"

#include "tclPort.h"

#include <stdio.h>

/*

 * Counter for how many aliases were created (global)

 */

static int aliasCounter = 0;

TCL_DECLARE_MUTEX(cntMutex)

/*

 * struct Alias:

 *

 * Stores information about an alias. Is stored in the slave interpreter

 * and used by the source command to find the target command in the master

 * when the source command is invoked.

 */

typedef struct Alias {

    Tcl_Obj *namePtr;		/* Name of alias command in slave interp. */

    Tcl_Interp *targetInterp;	/* Interp in which target command will be

				 * invoked. */

    Tcl_Command slaveCmd;	/* Source command in slave interpreter,

				 * bound to command that invokes the target

				 * command in the target interpreter. */

    Tcl_HashEntry *aliasEntryPtr;

				/* Entry for the alias hash table in slave.

                                 * This is used by alias deletion to remove

                                 * the alias from the slave interpreter

                                 * alias table. */

    Tcl_HashEntry *targetEntryPtr;

				/* Entry for target command in master.

                                 * This is used in the master interpreter to

                                 * map back from the target command to aliases

                                 * redirecting to it. Random access to this

                                 * hash table is never required - we are using

                                 * a hash table only for convenience. */

    int objc;                   /* Count of Tcl_Obj in the prefix of the

				 * target command to be invoked in the

				 * target interpreter. Additional arguments

				 * specified when calling the alias in the

				 * slave interp will be appended to the prefix

				 * before the command is invoked. */

    Tcl_Obj *objPtr;            /* The first actual prefix object - the target

				 * command name; this has to be at the end of the 

				 * structure, which will be extended to accomodate 

				 * the remaining objects in the prefix. */

} Alias;

/*

 *

 * struct Slave:

 *

 * Used by the "interp" command to record and find information about slave

 * interpreters. Maps from a command name in the master to information about

 * a slave interpreter, e.g. what aliases are defined in it.

 */

typedef struct Slave {

    Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */

    Tcl_HashEntry *slaveEntryPtr;

				/* Hash entry in masters slave table for

                                 * this slave interpreter.  Used to find

                                 * this record, and used when deleting the

                                 * slave interpreter to delete it from the

                                 * master's table. */

    Tcl_Interp	*slaveInterp;	/* The slave interpreter. */

    Tcl_Command interpCmd;	/* Interpreter object command. */

    Tcl_HashTable aliasTable;	/* Table which maps from names of commands

                                 * in slave interpreter to struct Alias

                                 * defined below. */

} Slave;

/*

 * struct Target:

 *

 * Maps from master interpreter commands back to the source commands in slave

 * interpreters. This is needed because aliases can be created between sibling

 * interpreters and must be deleted when the target interpreter is deleted. In

 * case they would not be deleted the source interpreter would be left with a

 * "dangling pointer". One such record is stored in the Master record of the

 * master interpreter (in the targetTable hashtable, see below) with the

 * master for each alias which directs to a command in the master. These

 * records are used to remove the source command for an from a slave if/when

 * the master is deleted.

 */

typedef struct Target {

    Tcl_Command	slaveCmd;	/* Command for alias in slave interp. */

    Tcl_Interp *slaveInterp;	/* Slave Interpreter. */

} Target;

/*

 * struct Master:

 *

 * This record is used for two purposes: First, slaveTable (a hashtable)

 * maps from names of commands to slave interpreters. This hashtable is

 * used to store information about slave interpreters of this interpreter,

 * to map over all slaves, etc. The second purpose is to store information

 * about all aliases in slaves (or siblings) which direct to target commands

 * in this interpreter (using the targetTable hashtable).

 * 

 * NB: the flags field in the interp structure, used with SAFE_INTERP

 * mask denotes whether the interpreter is safe or not. Safe

 * interpreters have restricted functionality, can only create safe slave

 * interpreters and can only load safe extensions.

 */

typedef struct Master {

    Tcl_HashTable slaveTable;	/* Hash table for slave interpreters.

                                 * Maps from command names to Slave records. */

    Tcl_HashTable targetTable;	/* Hash table for Target Records. Contains

                                 * all Target records which denote aliases

                                 * from slaves or sibling interpreters that

                                 * direct to commands in this interpreter. This

                                 * table is used to remove dangling pointers

                                 * from the slave (or sibling) interpreters

                                 * when this interpreter is deleted. */

} Master;

/*

 * The following structure keeps track of all the Master and Slave information

 * on a per-interp basis.

 */

typedef struct InterpInfo {

    Master master;		/* Keeps track of all interps for which this

				 * interp is the Master. */

    Slave slave;		/* Information necessary for this interp to

				 * function as a slave. */

} InterpInfo;

/*

 * Prototypes for local static procedures:

 */

static int		AliasCreate _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,

			    Tcl_Obj *namePtr, Tcl_Obj *targetPtr, int objc,

			    Tcl_Obj *CONST objv[]));

static int		AliasDelete _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, Tcl_Obj *namePtr));

static int		AliasDescribe _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr));

static int		AliasList _ANSI_ARGS_((Tcl_Interp *interp,

		            Tcl_Interp *slaveInterp));

static int		AliasObjCmd _ANSI_ARGS_((ClientData dummy,

			    Tcl_Interp *currentInterp, int objc,

		            Tcl_Obj *CONST objv[]));

static void		AliasObjCmdDeleteProc _ANSI_ARGS_((

			    ClientData clientData));

static Tcl_Interp *	GetInterp _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Obj *pathPtr));

static Tcl_Interp *	GetInterp2 _ANSI_ARGS_((Tcl_Interp *interp, int objc,

			    Tcl_Obj *CONST objv[]));

static void		InterpInfoDeleteProc _ANSI_ARGS_((

			    ClientData clientData, Tcl_Interp *interp));

static Tcl_Interp *	SlaveCreate _ANSI_ARGS_((Tcl_Interp *interp,

		            Tcl_Obj *pathPtr, int safe));

static int		SlaveEval _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, int objc,

			    Tcl_Obj *CONST objv[]));

static int		SlaveExpose _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, int objc,

			    Tcl_Obj *CONST objv[]));

static int		SlaveHide _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, int objc,

			    Tcl_Obj *CONST objv[]));

static int		SlaveHidden _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp));

static int		SlaveInvokeHidden _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, int global, int objc,

			    Tcl_Obj *CONST objv[]));

static int		SlaveMarkTrusted _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp));

static int		SlaveObjCmd _ANSI_ARGS_((ClientData dummy,

			    Tcl_Interp *interp, int objc,

			    Tcl_Obj *CONST objv[]));

static void		SlaveObjCmdDeleteProc _ANSI_ARGS_((

			    ClientData clientData));

static int		SlaveRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,

			    Tcl_Interp *slaveInterp, int objc,

			    Tcl_Obj *CONST objv[]));

/*

 *---------------------------------------------------------------------------

 *

 * TclInterpInit --

 *

 *	Initializes the invoking interpreter for using the master, slave

 *	and safe interp facilities.  This is called from inside

 *	Tcl_CreateInterp().

 *

 * Results:

 *	Always returns TCL_OK for backwards compatibility.

 *

 * Side effects:

 *	Adds the "interp" command to an interpreter and initializes the

 *	interpInfoPtr field of the invoking interpreter.

 *

 *---------------------------------------------------------------------------

 */

int

TclInterpInit(interp)

    Tcl_Interp *interp;			/* Interpreter to initialize. */

{

    InterpInfo *interpInfoPtr;

    Master *masterPtr;

    Slave *slavePtr;	

    interpInfoPtr = (InterpInfo *) ckalloc(sizeof(InterpInfo));

    ((Interp *) interp)->interpInfo = (ClientData) interpInfoPtr;

    masterPtr = &interpInfoPtr->master;

    Tcl_InitHashTable(&masterPtr->slaveTable, TCL_STRING_KEYS);

    Tcl_InitHashTable(&masterPtr->targetTable, TCL_ONE_WORD_KEYS);

    slavePtr = &interpInfoPtr->slave;

    slavePtr->masterInterp	= NULL;

    slavePtr->slaveEntryPtr	= NULL;

    slavePtr->slaveInterp	= interp;

    slavePtr->interpCmd		= NULL;

    Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);

    Tcl_CreateObjCommand(interp, "interp", Tcl_InterpObjCmd, NULL, NULL);

    Tcl_CallWhenDeleted(interp, InterpInfoDeleteProc, NULL);

    return TCL_OK;

}

/*

 *---------------------------------------------------------------------------

 *

 * InterpInfoDeleteProc --

 *

 *	Invoked when an interpreter is being deleted.  It releases all

 *	storage used by the master/slave/safe interpreter facilities.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	Cleans up storage.  Sets the interpInfoPtr field of the interp

 *	to NULL.

 *

 *---------------------------------------------------------------------------

 */

static void

InterpInfoDeleteProc(clientData, interp)

    ClientData clientData;	/* Ignored. */

    Tcl_Interp *interp;		/* Interp being deleted.  All commands for

				 * slave interps should already be deleted. */

{

    InterpInfo *interpInfoPtr;

    Slave *slavePtr;

    Master *masterPtr;

    Tcl_HashSearch hSearch;

    Tcl_HashEntry *hPtr;

    Target *targetPtr;

    interpInfoPtr = (InterpInfo *) ((Interp *) interp)->interpInfo;

    /*

     * There shouldn't be any commands left.

     */

    masterPtr = &interpInfoPtr->master;

    if (masterPtr->slaveTable.numEntries != 0) {

	panic("InterpInfoDeleteProc: still exist commands");

    }

    Tcl_DeleteHashTable(&masterPtr->slaveTable);

    /*

     * Tell any interps that have aliases to this interp that they should

     * delete those aliases.  If the other interp was already dead, it

     * would have removed the target record already. 

     */

    hPtr = Tcl_FirstHashEntry(&masterPtr->targetTable, &hSearch);

    while (hPtr != NULL) {

	targetPtr = (Target *) Tcl_GetHashValue(hPtr);

	Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,

		targetPtr->slaveCmd);

	hPtr = Tcl_NextHashEntry(&hSearch);

    }

    Tcl_DeleteHashTable(&masterPtr->targetTable);

    slavePtr = &interpInfoPtr->slave;

    if (slavePtr->interpCmd != NULL) {

	/*

	 * Tcl_DeleteInterp() was called on this interpreter, rather

	 * "interp delete" or the equivalent deletion of the command in the

	 * master.  First ensure that the cleanup callback doesn't try to

	 * delete the interp again.

	 */

	slavePtr->slaveInterp = NULL;

        Tcl_DeleteCommandFromToken(slavePtr->masterInterp,

		slavePtr->interpCmd);

    }

    /*

     * There shouldn't be any aliases left.

     */

    if (slavePtr->aliasTable.numEntries != 0) {

	panic("InterpInfoDeleteProc: still exist aliases");

    }

    Tcl_DeleteHashTable(&slavePtr->aliasTable);

    ckfree((char *) interpInfoPtr);    

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_InterpObjCmd --

 *

 *	This procedure is invoked to process the "interp" Tcl command.

 *	See the user documentation for details on what it does.

 *

 * Results:

 *	A standard Tcl result.

 *

 * Side effects:

 *	See the user documentation.

 *

 *----------------------------------------------------------------------

 */

	/* ARGSUSED */

int

Tcl_InterpObjCmd(clientData, interp, objc, objv)

    ClientData clientData;		/* Unused. */

    Tcl_Interp *interp;			/* Current interpreter. */

    int objc;				/* Number of arguments. */

    Tcl_Obj *CONST objv[];		/* Argument objects. */

{

    int index;

    static CONST char *options[] = {

        "alias",	"aliases",	"create",	"delete", 

	"eval",		"exists",	"expose",	"hide", 

	"hidden",	"issafe",	"invokehidden",	"marktrusted", 

	"recursionlimit",		"slaves",	"share",

	"target",	"transfer",

        NULL

    };

    enum option {

	OPT_ALIAS,	OPT_ALIASES,	OPT_CREATE,	OPT_DELETE,

	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,

	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,	OPT_MARKTRUSTED,

	OPT_RECLIMIT,			OPT_SLAVES,	OPT_SHARE,

	OPT_TARGET,	OPT_TRANSFER

    };

    if (objc < 2) {

        Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");

        return TCL_ERROR;

    }

    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, 

	    &index) != TCL_OK) {

	return TCL_ERROR;

    }

    switch ((enum option) index) {

	case OPT_ALIAS: {

	    Tcl_Interp *slaveInterp, *masterInterp;

	    if (objc < 4) {

		aliasArgs:

		Tcl_WrongNumArgs(interp, 2, objv,

			"slavePath slaveCmd ?masterPath masterCmd? ?args ..?");

		return TCL_ERROR;

	    }

	    slaveInterp = GetInterp(interp, objv[2]);

	    if (slaveInterp == (Tcl_Interp *) NULL) {

		return TCL_ERROR;

	    }

	    if (objc == 4) {

		return AliasDescribe(interp, slaveInterp, objv[3]);

	    }

	    if ((objc == 5) && (Tcl_GetString(objv[4])[0] == '\0')) {

		return AliasDelete(interp, slaveInterp, objv[3]);

	    }

	    if (objc > 5) {

		masterInterp = GetInterp(interp, objv[4]);

		if (masterInterp == (Tcl_Interp *) NULL) {

		    return TCL_ERROR;

		}

		if (Tcl_GetString(objv[5])[0] == '\0') {

		    if (objc == 6) {

			return AliasDelete(interp, slaveInterp, objv[3]);

		    }

		} else {

		    return AliasCreate(interp, slaveInterp, masterInterp,

			    objv[3], objv[5], objc - 6, objv + 6);

		}

	    }

	    goto aliasArgs;

	}

	case OPT_ALIASES: {

	    Tcl_Interp *slaveInterp;

	    slaveInterp = GetInterp2(interp, objc, objv);

	    if (slaveInterp == NULL) {

		return TCL_ERROR;

	    }

	    return AliasList(interp, slaveInterp);

	}

	case OPT_CREATE: {

	    int i, last, safe;

	    Tcl_Obj *slavePtr;

	    char buf[16 + TCL_INTEGER_SPACE];

	    static CONST char *options[] = {

		"-safe",	"--",		NULL

	    };

	    enum option {

		OPT_SAFE,	OPT_LAST

	    };

	    safe = Tcl_IsSafe(interp);

	    /*

	     * Weird historical rules: "-safe" is accepted at the end, too.

	     */

	    slavePtr = NULL;

	    last = 0;

	    for (i = 2; i < objc; i++) {

		if ((last == 0) && (Tcl_GetString(objv[i])[0] == '-')) {

		    if (Tcl_GetIndexFromObj(interp, objv[i], options, "option",

			    0, &index) != TCL_OK) {

			return TCL_ERROR;

		    }

		    if (index == OPT_SAFE) {

			safe = 1;

			continue;

		    }

		    i++;

		    last = 1;

		}

		if (slavePtr != NULL) {

		    Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");

		    return TCL_ERROR;

		}

		if (i < objc) {

		    slavePtr = objv[i];

		}

	    }

	    buf[0] = '\0';

	    if (slavePtr == NULL) {

		/*

		 * Create an anonymous interpreter -- we choose its name and

		 * the name of the command. We check that the command name

		 * that we use for the interpreter does not collide with an

		 * existing command in the master interpreter.

		 */

		for (i = 0; ; i++) {

		    Tcl_CmdInfo cmdInfo;

		    sprintf(buf, "interp%d", i);

		    if (Tcl_GetCommandInfo(interp, buf, &cmdInfo) == 0) {

			break;

		    }

		}

		slavePtr = Tcl_NewStringObj(buf, -1);

	    }

	    if (SlaveCreate(interp, slavePtr, safe) == NULL) {

		if (buf[0] != '\0') {

		    Tcl_DecrRefCount(slavePtr);

		}

		return TCL_ERROR;

	    }

	    Tcl_SetObjResult(interp, slavePtr);

	    return TCL_OK;

	}

	case OPT_DELETE: {

	    int i;

	    InterpInfo *iiPtr;

	    Tcl_Interp *slaveInterp;

	    for (i = 2; i < objc; i++) {

		slaveInterp = GetInterp(interp, objv[i]);

		if (slaveInterp == NULL) {

		    return TCL_ERROR;

		} else if (slaveInterp == interp) {

		    Tcl_ResetResult(interp);

		    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),

			    "cannot delete the current interpreter",

			    (char *) NULL);

		    return TCL_ERROR;

		}

		iiPtr = (InterpInfo *) ((Interp *) slaveInterp)->interpInfo;

		Tcl_DeleteCommandFromToken(iiPtr->slave.masterInterp,

			iiPtr->slave.interpCmd);

	    }

	    return TCL_OK;

	}

	case OPT_EVAL: {

	    Tcl_Interp *slaveInterp;

	    if (objc < 4) {

		Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");

		return TCL_ERROR;

	    }

	    slaveInterp = GetInterp(interp, objv[2]);

	    if (slaveInterp == NULL) {

		return TCL_ERROR;