tclinterp.c

linux系统下的音频通信

/* 
 * 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.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclInterp.c 1.128 97/11/05 09:35:12
 */

#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"

/*
 * Counter for how many aliases were created (global)
 */

static int aliasCounter = 0;

/*
 *
 * 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 {
    Tcl_Interp *masterInterp;	/* Master interpreter for this slave. */
    Tcl_HashEntry *slaveEntry;	/* 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
                                 * masters 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 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 {
    char	*aliasName;	/* Name of alias command. */
    char	*targetName;	/* Name of target command in master interp. */
    Tcl_Interp	*targetInterp;	/* Master interpreter. */
    int		objc;		/* Count of additional args to pass. */
    Tcl_Obj	**objv;		/* Actual additional args to pass. */
    Tcl_HashEntry *aliasEntry;	/* 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 *targetEntry;	/* 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. */
    Tcl_Command slaveCmd;	/* Source command in slave interpreter. */
} Alias;

/*
 * 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 {
    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 {
    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;

/*
 * Prototypes for local static procedures:
 */

static int		AliasCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *currentInterp, int objc,
		            Tcl_Obj *CONST objv[]));
static void		AliasCmdDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
static int		AliasCreationHelper _ANSI_ARGS_((Tcl_Interp *curInterp,
			    Tcl_Interp *slaveInterp, Tcl_Interp *masterInterp,
			    Master *masterPtr, char *aliasName,
			    char *targetName, int objc,
			    Tcl_Obj *CONST objv[]));
static int		CreateInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static Tcl_Interp	*CreateSlave _ANSI_ARGS_((Tcl_Interp *interp,
		            Master *masterPtr, char *slavePath, int safe));
static int		DeleteAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, char *aliasName));
static int		DescribeAlias _ANSI_ARGS_((Tcl_Interp *interp,
			    Tcl_Interp *slaveInterp, char *aliasName));
static int		DeleteInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		DeleteOneInterpObject _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, char *path));
static Tcl_Interp	*GetInterp _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, char *path,
			    Master **masterPtrPtr));
static int		GetTarget _ANSI_ARGS_((Tcl_Interp *interp, char *path,
			    char *aliasName));
static int		InterpAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpExistsHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpIsSafeHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpInvokeHiddenHelper _ANSI_ARGS_((
    			    Tcl_Interp *interp, Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpMarkTrustedHelper _ANSI_ARGS_((
    			    Tcl_Interp *interp, Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpSlavesHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpShareHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpTargetHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		InterpTransferHelper _ANSI_ARGS_((Tcl_Interp *interp,
			    Master *masterPtr, int objc,
        		    Tcl_Obj *CONST objv[]));
static int		MarkTrusted _ANSI_ARGS_((Tcl_Interp *interp));
static void		MasterRecordDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));
static int		SlaveAliasHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveAliasesHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveEvalHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveExposeHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveHideHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveHiddenHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveIsSafeHelper _ANSI_ARGS_((
    			    Tcl_Interp *interp, Tcl_Interp *slaveInterp,
                            Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
static int		SlaveInvokeHiddenHelper _ANSI_ARGS_((
    			    Tcl_Interp *interp, Tcl_Interp *slaveInterp,
                            Slave *slavePtr, int objc, Tcl_Obj *CONST objv[]));
static int		SlaveMarkTrustedHelper _ANSI_ARGS_((Tcl_Interp *interp,
		            Tcl_Interp *slaveInterp, Slave *slavePtr,
		            int objc, Tcl_Obj *CONST objv[]));
static int		SlaveObjectCmd _ANSI_ARGS_((ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *CONST objv[]));
static void		SlaveObjectDeleteProc _ANSI_ARGS_((
			    ClientData clientData));
static void		SlaveRecordDeleteProc _ANSI_ARGS_((
			    ClientData clientData, Tcl_Interp *interp));

/*
 *----------------------------------------------------------------------
 *
 * TclPreventAliasLoop --
 *
 *	When defining an alias or renaming a command, prevent an alias
 *	loop from being formed.
 *
 * Results:
 *	A standard Tcl object result.
 *
 * Side effects:
 *	If TCL_ERROR is returned, the function also stores an error message
 *	in the interpreter's result object.
 *
 * NOTE:
 *	This function is public internal (instead of being static to
 *	this file) because it is also used from TclRenameCommand.
 *
 *----------------------------------------------------------------------
 */

int
TclPreventAliasLoop(interp, cmdInterp, cmd)
    Tcl_Interp *interp;			/* Interp in which to report errors. */
    Tcl_Interp *cmdInterp;		/* Interp in which the command is
                                         * being defined. */
    Tcl_Command cmd;                    /* Tcl command we are attempting
                                         * to define. */
{
    Command *cmdPtr = (Command *) cmd;
    Alias *aliasPtr, *nextAliasPtr;
    Tcl_Command aliasCmd;
    Command *aliasCmdPtr;
    
    /*
     * If we are not creating or renaming an alias, then it is
     * always OK to create or rename the command.
     */
    
    if (cmdPtr->objProc != AliasCmd) {
        return TCL_OK;
    }

    /*
     * OK, we are dealing with an alias, so traverse the chain of aliases.
     * If we encounter the alias we are defining (or renaming to) any in
     * the chain then we have a loop.
     */

    aliasPtr = (Alias *) cmdPtr->objClientData;
    nextAliasPtr = aliasPtr;
    while (1) {

        /*
         * If the target of the next alias in the chain is the same as
         * the source alias, we have a loop.
	 */

	aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
                nextAliasPtr->targetName,
		Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
		/*flags*/ 0);
        if (aliasCmd == (Tcl_Command) NULL) {
            return TCL_OK;
        }
	aliasCmdPtr = (Command *) aliasCmd;
        if (aliasCmdPtr == cmdPtr) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
		"cannot define or rename alias \"", aliasPtr->aliasName,
		"\": would create a loop", (char *) NULL);
            return TCL_ERROR;
        }

        /*
	 * Otherwise, follow the chain one step further. See if the target
         * command is an alias - if so, follow the loop to its target
         * command. Otherwise we do not have a loop.
	 */

        if (aliasCmdPtr->objProc != AliasCmd) {
            return TCL_OK;
        }
        nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
    }

    /* NOTREACHED */
}

/*
 *----------------------------------------------------------------------
 *
 * MarkTrusted --
 *
 *	Mark an interpreter as unsafe (i.e. remove the "safe" mark).
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Removes the "safe" mark from an interpreter.
 *
 *----------------------------------------------------------------------
 */

static int
MarkTrusted(interp)
    Tcl_Interp *interp;		/* Interpreter to be marked unsafe. */
{
    Interp *iPtr = (Interp *) interp;

    iPtr->flags &= ~SAFE_INTERP;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MakeSafe --
 *
 *	Makes its argument interpreter contain only functionality that is
 *	defined to be part of Safe Tcl. Unsafe commands are hidden, the
 *	env array is unset, and the standard channels are removed.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Hides commands in its argument interpreter, and removes settings
 *	and channels.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_MakeSafe(interp)
    Tcl_Interp *interp;		/* Interpreter to be made safe. */
{
    Tcl_Channel chan;				/* Channel to remove from
                                                 * safe interpreter. */
    Interp *iPtr = (Interp *) interp;

    TclHideUnsafeCommands(interp);
    
    iPtr->flags |= SAFE_INTERP;

    /*
     *  Unsetting variables : (which should not have been set 
     *  in the first place, but...)
     */

    /*
     * No env array in a safe slave.
     */

    Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);