#include <stdio.h>
#include "tclInt.h"
#include "tclPort.h"
static int aliasCounter = 0;
typedef struct {
Tcl_Interp *masterInterp;
Tcl_HashEntry *slaveEntry;
Tcl_Interp *slaveInterp;
Tcl_Command interpCmd;
Tcl_HashTable aliasTable;
} Slave;
typedef struct {
char *aliasName;
char *targetName;
Tcl_Interp *targetInterp;
int objc;
Tcl_Obj **objv;
Tcl_HashEntry *aliasEntry;
Tcl_HashEntry *targetEntry;
Tcl_Command slaveCmd;
} Alias;
typedef struct {
Tcl_Command slaveCmd;
Tcl_Interp *slaveInterp;
} Target;
typedef struct {
Tcl_HashTable slaveTable;
Tcl_HashTable targetTable;
} Master;
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));
int
TclPreventAliasLoop(interp, cmdInterp, cmd)
Tcl_Interp *interp;
Tcl_Interp *cmdInterp;
Tcl_Command cmd;
{
Command *cmdPtr = (Command *) cmd;
Alias *aliasPtr, *nextAliasPtr;
Tcl_Command aliasCmd;
Command *aliasCmdPtr;
if (cmdPtr->objProc != AliasCmd) {
return TCL_OK;
}
aliasPtr = (Alias *) cmdPtr->objClientData;
nextAliasPtr = aliasPtr;
while (1) {
aliasCmd = Tcl_FindCommand(nextAliasPtr->targetInterp,
nextAliasPtr->targetName,
Tcl_GetGlobalNamespace(nextAliasPtr->targetInterp),
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;
}
if (aliasCmdPtr->objProc != AliasCmd) {
return TCL_OK;
}
nextAliasPtr = (Alias *) aliasCmdPtr->objClientData;
}
}
static int
MarkTrusted(interp)
Tcl_Interp *interp;
{
Interp *iPtr = (Interp *) interp;
iPtr->flags &= ~SAFE_INTERP;
return TCL_OK;
}
int
Tcl_MakeSafe(interp)
Tcl_Interp *interp;
{
Tcl_Channel chan;
Interp *iPtr = (Interp *) interp;
TclHideUnsafeCommands(interp);
iPtr->flags |= SAFE_INTERP;
Tcl_UnsetVar(interp, "env", TCL_GLOBAL_ONLY);
Tcl_UnsetVar2(interp, "tcl_platform", "os", TCL_GLOBAL_ONLY);
Tcl_UnsetVar2(interp, "tcl_platform", "osVersion", TCL_GLOBAL_ONLY);
Tcl_UnsetVar2(interp, "tcl_platform", "machine", TCL_GLOBAL_ONLY);
Tcl_UnsetVar(interp, "tclDefaultLibrary", TCL_GLOBAL_ONLY);
Tcl_UnsetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
Tcl_UnsetVar(interp, "tcl_pkgPath", TCL_GLOBAL_ONLY);
chan = Tcl_GetStdChannel(TCL_STDIN);
if (chan != (Tcl_Channel) NULL) {
Tcl_UnregisterChannel(interp, chan);
}
chan = Tcl_GetStdChannel(TCL_STDOUT);
if (chan != (Tcl_Channel) NULL) {
Tcl_UnregisterChannel(interp, chan);
}
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan != (Tcl_Channel) NULL) {
Tcl_UnregisterChannel(interp, chan);
}
return TCL_OK;
}
static Tcl_Interp *
GetInterp(interp, masterPtr, path, masterPtrPtr)
Tcl_Interp *interp;
Master *masterPtr;
char *path;
Master **masterPtrPtr;
{
Tcl_HashEntry *hPtr;
Slave *slavePtr;
char **argv;
int argc, i;
Tcl_Interp *searchInterp;
if (masterPtrPtr != (Master **) NULL) {
*masterPtrPtr = masterPtr;
}
if (Tcl_SplitList(interp, path, &argc, &argv) != TCL_OK) {
return (Tcl_Interp *) NULL;
}
for (searchInterp = interp, i = 0; i < argc; i++) {
hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), argv[i]);
if (hPtr == (Tcl_HashEntry *) NULL) {
ckfree((char *) argv);
return (Tcl_Interp *) NULL;
}
slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
searchInterp = slavePtr->slaveInterp;
if (searchInterp == (Tcl_Interp *) NULL) {
ckfree((char *) argv);
return (Tcl_Interp *) NULL;
}
masterPtr = (Master *) Tcl_GetAssocData(searchInterp,
"tclMasterRecord", NULL);
if (masterPtrPtr != (Master **) NULL) *masterPtrPtr = masterPtr;
if (masterPtr == (Master *) NULL) {
ckfree((char *) argv);
return (Tcl_Interp *) NULL;
}
}
ckfree((char *) argv);
return searchInterp;
}
static Tcl_Interp *
CreateSlave(interp, masterPtr, slavePath, safe)
Tcl_Interp *interp;
Master *masterPtr;
char *slavePath;
int safe;
{
Tcl_Interp *slaveInterp;
Tcl_Interp *masterInterp;
Slave *slavePtr;
Tcl_HashEntry *hPtr;
int new;
int argc;
char **argv;
char *masterPath;
if (Tcl_SplitList(interp, slavePath, &argc, &argv) != TCL_OK) {
return (Tcl_Interp *) NULL;
}
if (argc < 2) {
masterInterp = interp;
if (argc == 1) {
slavePath = argv[0];
}
} else {
masterPath = Tcl_Merge(argc-1, argv);
masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
if (masterInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", masterPath,
"\" not found", (char *) NULL);
ckfree((char *) argv);
ckfree((char *) masterPath);
return (Tcl_Interp *) NULL;
}
ckfree((char *) masterPath);
slavePath = argv[argc-1];
if (!safe) {
safe = Tcl_IsSafe(masterInterp);
}
}
hPtr = Tcl_CreateHashEntry(&(masterPtr->slaveTable), slavePath, &new);
if (new == 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", slavePath,
"\" already exists, cannot create", (char *) NULL);
ckfree((char *) argv);
return (Tcl_Interp *) NULL;
}
slaveInterp = Tcl_CreateInterp();
if (slaveInterp == (Tcl_Interp *) NULL) {
panic("CreateSlave: out of memory while creating a new interpreter");
}
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
slavePtr->masterInterp = masterInterp;
slavePtr->slaveEntry = hPtr;
slavePtr->slaveInterp = slaveInterp;
slavePtr->interpCmd = Tcl_CreateObjCommand(masterInterp, slavePath,
SlaveObjectCmd, (ClientData) slaveInterp, SlaveObjectDeleteProc);
Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
(void) Tcl_SetAssocData(slaveInterp, "tclSlaveRecord",
SlaveRecordDeleteProc, (ClientData) slavePtr);
Tcl_SetHashValue(hPtr, (ClientData) slavePtr);
Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
((Interp *)slaveInterp)->maxNestingDepth =
((Interp *)masterInterp)->maxNestingDepth ;
if (safe) {
if (Tcl_MakeSafe(slaveInterp) == TCL_ERROR) {
goto error;
}
} else {
if (Tcl_Init(slaveInterp) == TCL_ERROR) {
goto error;
}
}
ckfree((char *) argv);
return slaveInterp;
error:
Tcl_AddErrorInfo(interp, Tcl_GetVar2(slaveInterp, "errorInfo", (char *)
NULL, TCL_GLOBAL_ONLY));
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(slaveInterp, "errorCode", (char *) NULL,
TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
(void) Tcl_DeleteCommand(masterInterp, slavePath);
ckfree((char *) argv);
return (Tcl_Interp *) NULL;
}
static int
CreateInterpObject(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
int safe;
int moreFlags;
char *string;
char *slavePath;
char localSlaveName[200];
int i;
int len;
static int interpCounter = 0;
moreFlags = 1;
slavePath = NULL;
safe = Tcl_IsSafe(interp);
if ((objc < 2) || (objc > 5)) {
Tcl_WrongNumArgs(interp, 2, objv, "?-safe? ?--? ?path?");
return TCL_ERROR;
}
for (i = 2; i < objc; i++) {
string = Tcl_GetStringFromObj(objv[i], &len);
if ((string[0] == '-') && (moreFlags != 0)) {
if ((string[1] == 's') &&
(strncmp(string, "-safe", (size_t) len) == 0) &&
(len > 1)){
safe = 1;
} else if ((strncmp(string, "--", (size_t) len) == 0) &&
(len > 1)) {
moreFlags = 0;
} else {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad option \"", string, "\": should be -safe",
(char *) NULL);
return TCL_ERROR;
}
} else {
slavePath = string;
}
}
if (slavePath == (char *) NULL) {
while (1) {
Tcl_CmdInfo cmdInfo;
sprintf(localSlaveName, "interp%d", interpCounter);
interpCounter++;
if (!(Tcl_GetCommandInfo(interp, localSlaveName, &cmdInfo))) {
break;
}
}
slavePath = localSlaveName;
}
if (CreateSlave(interp, masterPtr, slavePath, safe) != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(slavePath, -1));
return TCL_OK;
} else {
return TCL_ERROR;
}
}
static int
DeleteOneInterpObject(interp, masterPtr, path)
Tcl_Interp *interp;
Master *masterPtr;
char *path;
{
Slave *slavePtr;
Tcl_Interp *masterInterp;
Tcl_HashEntry *hPtr;
int localArgc;
char **localArgv;
char *slaveName;
char *masterPath;
if (Tcl_SplitList(interp, path, &localArgc, &localArgv) != TCL_OK) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"bad interpreter path \"", path, "\"", (char *) NULL);
return TCL_ERROR;
}
if (localArgc < 2) {
masterInterp = interp;
if (localArgc == 0) {
slaveName = "";
} else {
slaveName = localArgv[0];
}
} else {
masterPath = Tcl_Merge(localArgc-1, localArgv);
masterInterp = GetInterp(interp, masterPtr, masterPath, &masterPtr);
if (masterInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", masterPath, "\" not found",
(char *) NULL);
ckfree((char *) localArgv);
ckfree((char *) masterPath);
return TCL_ERROR;
}
ckfree((char *) masterPath);
slaveName = localArgv[localArgc-1];
}
hPtr = Tcl_FindHashEntry(&(masterPtr->slaveTable), slaveName);
if (hPtr == (Tcl_HashEntry *) NULL) {
ckfree((char *) localArgv);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", path, "\" not found", (char *) NULL);
return TCL_ERROR;
}
slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
if (Tcl_DeleteCommandFromToken(masterInterp, slavePtr->interpCmd) != 0) {
ckfree((char *) localArgv);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", path, "\" not found", (char *) NULL);
return TCL_ERROR;
}
ckfree((char *) localArgv);
return TCL_OK;
}
static int
DeleteInterpObject(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
int i;
int len;
for (i = 2; i < objc; i++) {
if (DeleteOneInterpObject(interp, masterPtr,
Tcl_GetStringFromObj(objv[i], &len))
!= TCL_OK) {
return TCL_ERROR;
}
}
return TCL_OK;
}
static int
AliasCreationHelper(curInterp, slaveInterp, masterInterp, masterPtr,
aliasName, targetName, objc, objv)
Tcl_Interp *curInterp;
Tcl_Interp *slaveInterp;
Tcl_Interp *masterInterp;
Master *masterPtr;
char *aliasName;
char *targetName;
int objc;
Tcl_Obj *CONST objv[];
{
Alias *aliasPtr;
Alias *tmpAliasPtr;
Tcl_HashEntry *hPtr;
int i;
int new;
Target *targetPtr;
Slave *slavePtr;
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
panic("AliasCreationHelper: could not find slave record");
}
if ((targetName == (char *) NULL) || (targetName[0] == '\0')) {
if (objc != 0) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(curInterp),
"malformed command: should be",
" \"alias ", aliasName, " {}\"", (char *) NULL);
return TCL_ERROR;
}
return DeleteAlias(curInterp, slaveInterp, aliasName);
}
aliasPtr = (Alias *) ckalloc((unsigned) sizeof(Alias));
aliasPtr->aliasName = (char *) ckalloc((unsigned) strlen(aliasName)+1);
aliasPtr->targetName = (char *) ckalloc((unsigned) strlen(targetName)+1);
strcpy(aliasPtr->aliasName, aliasName);
strcpy(aliasPtr->targetName, targetName);
aliasPtr->targetInterp = masterInterp;
aliasPtr->objv = NULL;
aliasPtr->objc = objc;
if (aliasPtr->objc > 0) {
aliasPtr->objv =
(Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) *
aliasPtr->objc);
for (i = 0; i < objc; i++) {
aliasPtr->objv[i] = objv[i];
Tcl_IncrRefCount(objv[i]);
}
}
aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, aliasName,
AliasCmd, (ClientData) aliasPtr, AliasCmdDeleteProc);
if (TclPreventAliasLoop(curInterp, slaveInterp,
aliasPtr->slaveCmd) != TCL_OK) {
Command *cmdPtr = (Command*) aliasPtr->slaveCmd;
cmdPtr->clientData = NULL;
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slaveInterp, aliasPtr->slaveCmd);
for (i = 0; i < objc; i++) {
Tcl_DecrRefCount(aliasPtr->objv[i]);
}
if (aliasPtr->objv != (Tcl_Obj *CONST *) NULL) {
ckfree((char *) aliasPtr->objv);
}
ckfree(aliasPtr->aliasName);
ckfree(aliasPtr->targetName);
ckfree((char *) aliasPtr);
return TCL_ERROR;
}
do {
hPtr = Tcl_CreateHashEntry(&(slavePtr->aliasTable), aliasName, &new);
if (!new) {
tmpAliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
(void) Tcl_DeleteCommandFromToken(slaveInterp,
tmpAliasPtr->slaveCmd);
}
} while (new == 0);
aliasPtr->aliasEntry = hPtr;
Tcl_SetHashValue(hPtr, (ClientData) aliasPtr);
targetPtr = (Target *) ckalloc((unsigned) sizeof(Target));
targetPtr->slaveCmd = aliasPtr->slaveCmd;
targetPtr->slaveInterp = slaveInterp;
do {
hPtr = Tcl_CreateHashEntry(&(masterPtr->targetTable),
(char *) aliasCounter, &new);
aliasCounter++;
} while (new == 0);
Tcl_SetHashValue(hPtr, (ClientData) targetPtr);
aliasPtr->targetEntry = hPtr;
Tcl_SetObjResult(curInterp, Tcl_NewStringObj(aliasPtr->aliasName, -1));
return TCL_OK;
}
static int
InterpAliasesHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
Slave *slavePtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
int len;
Tcl_Obj *listObjPtr, *elemObjPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 2, objv, "?path?");
return TCL_ERROR;
}
if (objc == 3) {
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
} else {
slaveInterp = interp;
}
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
"tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
return TCL_OK;
}
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable), &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
elemObjPtr = Tcl_NewStringObj(
Tcl_GetHashKey(&(slavePtr->aliasTable), hPtr), -1);
Tcl_ListObjAppendElement(interp, listObjPtr, elemObjPtr);
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
InterpAliasHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp,
*masterInterp;
Master *masterMasterPtr;
int len;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"slavePath slaveCmd masterPath masterCmd ?args ..?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not find interpreter \"",
Tcl_GetStringFromObj(objv[2], &len), "\"",
(char *) NULL);
return TCL_ERROR;
}
if (objc == 4) {
return DescribeAlias(interp, slaveInterp,
Tcl_GetStringFromObj(objv[3], &len));
}
if (objc == 5 && strcmp(Tcl_GetStringFromObj(objv[4], &len), "") == 0) {
return DeleteAlias(interp, slaveInterp,
Tcl_GetStringFromObj(objv[3], &len));
}
if (objc < 6) {
Tcl_WrongNumArgs(interp, 2, objv,
"slavePath slaveCmd masterPath masterCmd ?args ..?");
return TCL_ERROR;
}
masterInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[4], &len), &masterMasterPtr);
if (masterInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"could not find interpreter \"",
Tcl_GetStringFromObj(objv[4], &len), "\"", (char *) NULL);
return TCL_ERROR;
}
return AliasCreationHelper(interp, slaveInterp, masterInterp,
masterMasterPtr, Tcl_GetStringFromObj(objv[3], &len),
Tcl_GetStringFromObj(objv[5], &len),
objc-6, objv+6);
}
static int
InterpExistsHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *objPtr;
int len;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?path?");
return TCL_ERROR;
}
if (objc == 3) {
if (GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL) ==
(Tcl_Interp *) NULL) {
objPtr = Tcl_NewIntObj(0);
} else {
objPtr = Tcl_NewIntObj(1);
}
} else {
objPtr = Tcl_NewIntObj(1);
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
static int
InterpEvalHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
Interp *iPtr;
int len;
int result;
Tcl_Obj *namePtr, *objPtr;
char *string;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path arg ?arg ...?");
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter named \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
objPtr = Tcl_ConcatObj(objc-3, objv+3);
Tcl_IncrRefCount(objPtr);
Tcl_Preserve((ClientData) slaveInterp);
result = Tcl_EvalObj(slaveInterp, objPtr);
Tcl_DecrRefCount(objPtr);
if (interp != slaveInterp) {
if (result == TCL_ERROR) {
iPtr = (Interp *) slaveInterp;
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo(slaveInterp, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(slaveInterp, "errorCode", (char *)
NULL, TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
Tcl_Release((ClientData) slaveInterp);
return result;
}
static int
InterpExposeHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
int len;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv,
"path hiddenCmdName ?cmdName?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"permission denied: safe interpreter cannot expose commands",
(char *) NULL);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
if (Tcl_ExposeCommand(slaveInterp,
Tcl_GetStringFromObj(objv[3], &len),
(objc == 5 ?
Tcl_GetStringFromObj(objv[4], &len) :
Tcl_GetStringFromObj(objv[3], &len)))
== TCL_ERROR) {
if (interp != slaveInterp) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
return TCL_ERROR;
}
return TCL_OK;
}
static int
InterpHideHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
int len;
if ((objc != 4) && (objc != 5)) {
Tcl_WrongNumArgs(interp, 2, objv,
"path cmdName ?hiddenCmdName?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"permission denied: safe interpreter cannot hide commands",
(char *) NULL);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[3], &len),
(objc == 5 ?
Tcl_GetStringFromObj(objv[4], &len) :
Tcl_GetStringFromObj(objv[3], &len)))
== TCL_ERROR) {
if (interp != slaveInterp) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
return TCL_ERROR;
}
return TCL_OK;
}
static int
InterpHiddenHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
int len;
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
Tcl_Obj *listObjPtr;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?path?");
return TCL_ERROR;
}
if (objc == 3) {
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len),
&masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
} else {
slaveInterp = interp;
}
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
"tclHiddenCmds", NULL);
if (hTblPtr != (Tcl_HashTable *) NULL) {
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
Tcl_ListObjAppendElement(interp, listObjPtr,
Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
}
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
InterpInvokeHiddenHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
int doGlobal = 0;
int len;
int result;
Tcl_Obj *namePtr, *objPtr;
Tcl_Interp *slaveInterp;
Interp *iPtr;
char *string;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"path ?-global? cmd ?arg ..?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"not allowed to invoke hidden commands from safe interpreter",
(char *) NULL);
return TCL_ERROR;
}
if (strcmp(Tcl_GetStringFromObj(objv[3], &len), "-global") == 0) {
doGlobal = 1;
if (objc < 5) {
Tcl_WrongNumArgs(interp, 2, objv,
"path ?-global? cmd ?arg ..?");
return TCL_ERROR;
}
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
Tcl_Preserve((ClientData) slaveInterp);
if (doGlobal) {
result = TclObjInvokeGlobal(slaveInterp, objc-4, objv+4,
TCL_INVOKE_HIDDEN);
} else {
result = TclObjInvoke(slaveInterp, objc-3, objv+3, TCL_INVOKE_HIDDEN);
}
if (interp != slaveInterp) {
if (result == TCL_ERROR) {
iPtr = (Interp *) slaveInterp;
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo(slaveInterp, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(slaveInterp, "errorCode", (char *)
NULL, TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
Tcl_Release((ClientData) slaveInterp);
return result;
}
static int
InterpMarkTrustedHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
int len;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "path");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"\"", Tcl_GetStringFromObj(objv[0], &len),
" marktrusted\" can only",
" be invoked from a trusted interpreter",
(char *) NULL);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
return MarkTrusted(slaveInterp);
}
static int
InterpIsSafeHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
int len;
Tcl_Obj *objPtr;
if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?path?");
return TCL_ERROR;
}
if (objc == 3) {
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"",
Tcl_GetStringFromObj(objv[2], &len), "\" not found",
(char *) NULL);
return TCL_ERROR;
}
objPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
} else {
objPtr = Tcl_NewIntObj(Tcl_IsSafe(interp));
}
Tcl_SetObjResult(interp, objPtr);
return TCL_OK;
}
static int
InterpSlavesHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
int len;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
Tcl_Obj *listObjPtr;
if ((objc != 2) && (objc != 3)) {
Tcl_WrongNumArgs(interp, 2, objv, "?path?");
return TCL_ERROR;
}
if (objc == 3) {
if (GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), &masterPtr) ==
(Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
}
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
Tcl_ListObjAppendElement(interp, listObjPtr,
Tcl_NewStringObj(
Tcl_GetHashKey(&(masterPtr->slaveTable), hPtr), -1));
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
InterpShareHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
Tcl_Interp *masterInterp;
int len;
Tcl_Channel chan;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv, "srcPath channelId destPath");
return TCL_ERROR;
}
masterInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL);
if (masterInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[4], &len), NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
chan = Tcl_GetChannel(masterInterp, Tcl_GetStringFromObj(objv[3], &len),
NULL);
if (chan == (Tcl_Channel) NULL) {
if (interp != masterInterp) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
Tcl_ResetResult(masterInterp);
}
return TCL_ERROR;
}
Tcl_RegisterChannel(slaveInterp, chan);
return TCL_OK;
}
static int
InterpTargetHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
int len;
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "path alias");
return TCL_ERROR;
}
return GetTarget(interp,
Tcl_GetStringFromObj(objv[2], &len),
Tcl_GetStringFromObj(objv[3], &len));
}
static int
InterpTransferHelper(interp, masterPtr, objc, objv)
Tcl_Interp *interp;
Master *masterPtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *slaveInterp;
Tcl_Interp *masterInterp;
int len;
Tcl_Channel chan;
if (objc != 5) {
Tcl_WrongNumArgs(interp, 2, objv,
"srcPath channelId destPath");
return TCL_ERROR;
}
masterInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[2], &len), NULL);
if (masterInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[2], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
slaveInterp = GetInterp(interp, masterPtr,
Tcl_GetStringFromObj(objv[4], &len), NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter \"", Tcl_GetStringFromObj(objv[4], &len),
"\" not found", (char *) NULL);
return TCL_ERROR;
}
chan = Tcl_GetChannel(masterInterp,
Tcl_GetStringFromObj(objv[3], &len), NULL);
if (chan == (Tcl_Channel) NULL) {
if (interp != masterInterp) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
Tcl_ResetResult(masterInterp);
}
return TCL_ERROR;
}
Tcl_RegisterChannel(slaveInterp, chan);
if (Tcl_UnregisterChannel(masterInterp, chan) != TCL_OK) {
if (interp != masterInterp) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(masterInterp));
Tcl_ResetResult(masterInterp);
}
return TCL_ERROR;
}
return TCL_OK;
}
static int
DescribeAlias(interp, slaveInterp, aliasName)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
char *aliasName;
{
Slave *slavePtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
int i;
Tcl_Obj *listObjPtr;
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
NULL);
if (slavePtr == (Slave *) NULL) {
panic("DescribeAlias: could not find slave record");
}
hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
if (hPtr == (Tcl_HashEntry *) NULL) {
return TCL_OK;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
Tcl_ListObjAppendElement(interp, listObjPtr,
Tcl_NewStringObj(aliasPtr->targetName, -1));
for (i = 0; i < aliasPtr->objc; i++) {
Tcl_ListObjAppendElement(interp, listObjPtr, aliasPtr->objv[i]);
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
DeleteAlias(interp, slaveInterp, aliasName)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
char *aliasName;
{
Slave *slavePtr;
Alias *aliasPtr;
Tcl_HashEntry *hPtr;
char *tmpPtr, *namePtr;
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
NULL);
if (slavePtr == (Slave *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"alias \"", aliasName, "\" not found", (char *) NULL);
return TCL_ERROR;
}
hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"alias \"", aliasName, "\" not found", (char *) NULL);
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
tmpPtr = Tcl_GetCommandName(slaveInterp, aliasPtr->slaveCmd);
namePtr = (char *) ckalloc((unsigned) strlen(tmpPtr) + 1);
strcpy(namePtr, tmpPtr);
if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
if (Tcl_ExposeCommand(slaveInterp, namePtr, namePtr) != TCL_OK) {
panic("DeleteAlias: did not find alias to be deleted");
}
if (Tcl_DeleteCommand(slaveInterp, namePtr) != 0) {
panic("DeleteAlias: did not find alias to be deleted");
}
}
ckfree(namePtr);
return TCL_OK;
}
int
Tcl_GetInterpPath(askingInterp, targetInterp)
Tcl_Interp *askingInterp;
Tcl_Interp *targetInterp;
{
Master *masterPtr;
Slave *slavePtr;
if (targetInterp == askingInterp) {
return TCL_OK;
}
if (targetInterp == (Tcl_Interp *) NULL) {
return TCL_ERROR;
}
slavePtr = (Slave *) Tcl_GetAssocData(targetInterp, "tclSlaveRecord",
NULL);
if (slavePtr == (Slave *) NULL) {
return TCL_ERROR;
}
if (Tcl_GetInterpPath(askingInterp, slavePtr->masterInterp) == TCL_ERROR) {
return TCL_ERROR;
}
masterPtr = (Master *) Tcl_GetAssocData(slavePtr->masterInterp,
"tclMasterRecord", NULL);
if (masterPtr == (Master *) NULL) {
panic("Tcl_GetInterpPath: could not find master record");
}
Tcl_AppendElement(askingInterp, Tcl_GetHashKey(&(masterPtr->slaveTable),
slavePtr->slaveEntry));
return TCL_OK;
}
static int
GetTarget(askingInterp, path, aliasName)
Tcl_Interp *askingInterp;
char *path;
char *aliasName;
{
Tcl_Interp *slaveInterp;
Slave *slaveSlavePtr;
Master *masterPtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
Tcl_ResetResult(askingInterp);
masterPtr = (Master *) Tcl_GetAssocData(askingInterp, "tclMasterRecord",
NULL);
if (masterPtr == (Master *) NULL) {
panic("GetTarget: could not find master record");
}
slaveInterp = GetInterp(askingInterp, masterPtr, path, NULL);
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
"could not find interpreter \"", path, "\"", (char *) NULL);
return TCL_ERROR;
}
slaveSlavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",
NULL);
if (slaveSlavePtr == (Slave *) NULL) {
panic("GetTarget: could not find slave record");
}
hPtr = Tcl_FindHashEntry(&(slaveSlavePtr->aliasTable), aliasName);
if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
"alias \"", aliasName, "\" in path \"", path, "\" not found",
(char *) NULL);
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
if (aliasPtr == (Alias *) NULL) {
panic("GetTarget: could not find alias record");
}
if (Tcl_GetInterpPath(askingInterp, aliasPtr->targetInterp) == TCL_ERROR) {
Tcl_ResetResult(askingInterp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(askingInterp),
"target interpreter for alias \"",
aliasName, "\" in path \"", path, "\" is not my descendant",
(char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int
Tcl_InterpObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Master *masterPtr;
int result;
static char *subCmds[] = {
"alias", "aliases", "create", "delete", "eval", "exists",
"expose", "hide", "hidden", "issafe", "invokehidden",
"marktrusted", "slaves", "share", "target", "transfer",
(char *) NULL};
enum ISubCmdIdx {
IAliasIdx, IAliasesIdx, ICreateIdx, IDeleteIdx, IEvalIdx,
IExistsIdx, IExposeIdx, IHideIdx, IHiddenIdx, IIsSafeIdx,
IInvokeHiddenIdx, IMarkTrustedIdx, ISlavesIdx, IShareIdx,
ITargetIdx, ITransferIdx
} index;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
return TCL_ERROR;
}
masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
if (masterPtr == (Master *) NULL) {
panic("Tcl_InterpCmd: could not find master record");
}
result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
0, (int *) &index);
if (result != TCL_OK) {
return result;
}
switch (index) {
case IAliasIdx:
return InterpAliasHelper(interp, masterPtr, objc, objv);
case IAliasesIdx:
return InterpAliasesHelper(interp, masterPtr, objc, objv);
case ICreateIdx:
return CreateInterpObject(interp, masterPtr, objc, objv);
case IDeleteIdx:
return DeleteInterpObject(interp, masterPtr, objc, objv);
case IEvalIdx:
return InterpEvalHelper(interp, masterPtr, objc, objv);
case IExistsIdx:
return InterpExistsHelper(interp, masterPtr, objc, objv);
case IExposeIdx:
return InterpExposeHelper(interp, masterPtr, objc, objv);
case IHideIdx:
return InterpHideHelper(interp, masterPtr, objc, objv);
case IHiddenIdx:
return InterpHiddenHelper(interp, masterPtr, objc, objv);
case IIsSafeIdx:
return InterpIsSafeHelper(interp, masterPtr, objc, objv);
case IInvokeHiddenIdx:
return InterpInvokeHiddenHelper(interp, masterPtr, objc, objv);
case IMarkTrustedIdx:
return InterpMarkTrustedHelper(interp, masterPtr, objc, objv);
case ISlavesIdx:
return InterpSlavesHelper(interp, masterPtr, objc, objv);
case IShareIdx:
return InterpShareHelper(interp, masterPtr, objc, objv);
case ITargetIdx:
return InterpTargetHelper(interp, masterPtr, objc, objv);
case ITransferIdx:
return InterpTransferHelper(interp, masterPtr, objc, objv);
}
return TCL_ERROR;
}
static int
SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Master *masterPtr;
int len;
switch (objc-2) {
case 0:
Tcl_WrongNumArgs(interp, 2, objv,
"aliasName ?targetName? ?args..?");
return TCL_ERROR;
case 1:
return DescribeAlias(interp, slaveInterp,
Tcl_GetStringFromObj(objv[2], &len));
default:
masterPtr = (Master *) Tcl_GetAssocData(interp,
"tclMasterRecord", NULL);
if (masterPtr == (Master *) NULL) {
panic("SlaveObjectCmd: could not find master record");
}
return AliasCreationHelper(interp, slaveInterp, interp,
masterPtr,
Tcl_GetStringFromObj(objv[2], &len),
Tcl_GetStringFromObj(objv[3], &len),
objc-4, objv+4);
}
}
static int
SlaveAliasesHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
Tcl_Obj *listObjPtr;
Alias *aliasPtr;
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
for (hPtr = Tcl_FirstHashEntry(&(slavePtr->aliasTable),
&hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
Tcl_ListObjAppendElement(interp, listObjPtr,
Tcl_NewStringObj(aliasPtr->aliasName, -1));
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Interp *iPtr;
Tcl_Obj *objPtr;
Tcl_Obj *namePtr;
int len;
char *string;
int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "arg ?arg ...?");
return TCL_ERROR;
}
objPtr = Tcl_ConcatObj(objc-2, objv+2);
Tcl_IncrRefCount(objPtr);
Tcl_Preserve((ClientData) slaveInterp);
result = Tcl_EvalObj(slaveInterp, objPtr);
Tcl_DecrRefCount(objPtr);
if (interp != slaveInterp) {
if (result == TCL_ERROR) {
iPtr = (Interp *) slaveInterp;
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo(slaveInterp, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(slaveInterp, "errorCode", (char *)
NULL, TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
Tcl_Release((ClientData) slaveInterp);
return result;
}
static int
SlaveExposeHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
int len;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "hiddenCmdName ?cmdName?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"permission denied: safe interpreter cannot expose commands",
(char *) NULL);
return TCL_ERROR;
}
if (Tcl_ExposeCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
(objc == 4 ?
Tcl_GetStringFromObj(objv[3], &len) :
Tcl_GetStringFromObj(objv[2], &len)))
== TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
return TCL_ERROR;
}
return TCL_OK;
}
static int
SlaveHideHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
int len;
if ((objc != 3) && (objc != 4)) {
Tcl_WrongNumArgs(interp, 2, objv, "cmdName ?hiddenCmdName?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"permission denied: safe interpreter cannot hide commands",
(char *) NULL);
return TCL_ERROR;
}
if (Tcl_HideCommand(slaveInterp, Tcl_GetStringFromObj(objv[2], &len),
(objc == 4 ?
Tcl_GetStringFromObj(objv[3], &len) :
Tcl_GetStringFromObj(objv[2], &len)))
== TCL_ERROR) {
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
return TCL_ERROR;
}
return TCL_OK;
}
static int
SlaveHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *listObjPtr;
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(slaveInterp,
"tclHiddenCmds", NULL);
if (hTblPtr != (Tcl_HashTable *) NULL) {
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
Tcl_ListObjAppendElement(interp, listObjPtr,
Tcl_NewStringObj(Tcl_GetHashKey(hTblPtr, hPtr), -1));
}
}
Tcl_SetObjResult(interp, listObjPtr);
return TCL_OK;
}
static int
SlaveIsSafeHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Obj *resultPtr;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
resultPtr = Tcl_NewIntObj(Tcl_IsSafe(slaveInterp));
Tcl_SetObjResult(interp, resultPtr);
return TCL_OK;
}
static int
SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
Interp *iPtr;
Master *masterPtr;
int doGlobal = 0;
int result;
int len;
char *string;
Tcl_Obj *namePtr, *objPtr;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv,
"?-global? cmd ?arg ..?");
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"not allowed to invoke hidden commands from safe interpreter",
(char *) NULL);
return TCL_ERROR;
}
if (strcmp(Tcl_GetStringFromObj(objv[2], &len), "-global") == 0) {
doGlobal = 1;
if (objc < 4) {
Tcl_WrongNumArgs(interp, 2, objv,
"path ?-global? cmd ?arg ..?");
return TCL_ERROR;
}
}
masterPtr = (Master *) Tcl_GetAssocData(slaveInterp,
"tclMasterRecord", NULL);
if (masterPtr == (Master *) NULL) {
panic("SlaveObjectCmd: could not find master record");
}
Tcl_Preserve((ClientData) slaveInterp);
if (doGlobal) {
result = TclObjInvokeGlobal(slaveInterp, objc-3, objv+3,
TCL_INVOKE_HIDDEN);
} else {
result = TclObjInvoke(slaveInterp, objc-2, objv+2,
TCL_INVOKE_HIDDEN);
}
if (interp != slaveInterp) {
if (result == TCL_ERROR) {
iPtr = (Interp *) slaveInterp;
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo(slaveInterp, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(slaveInterp, namePtr,
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(slaveInterp, "errorCode", (char *)
NULL, TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(slaveInterp));
Tcl_ResetResult(slaveInterp);
}
Tcl_Release((ClientData) slaveInterp);
return result;
}
static int
SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr, objc, objv)
Tcl_Interp *interp;
Tcl_Interp *slaveInterp;
Slave *slavePtr;
int objc;
Tcl_Obj *CONST objv[];
{
int len;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
if (Tcl_IsSafe(interp)) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"\"", Tcl_GetStringFromObj(objv[0], &len), " marktrusted\"",
" can only be invoked from a trusted interpreter",
(char *) NULL);
return TCL_ERROR;
}
return MarkTrusted(slaveInterp);
}
static int
SlaveObjectCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Slave *slavePtr;
Tcl_Interp *slaveInterp;
int result;
int len;
static char *subCmds[] = {
"alias", "aliases",
"eval", "expose",
"hide", "hidden",
"issafe", "invokehidden",
"marktrusted",
(char *) NULL};
enum ISubCmdIdx {
IAliasIdx, IAliasesIdx,
IEvalIdx, IExposeIdx,
IHideIdx, IHiddenIdx,
IIsSafeIdx, IInvokeHiddenIdx,
IMarkTrustedIdx
} index;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "cmd ?arg ...?");
return TCL_ERROR;
}
slaveInterp = (Tcl_Interp *) clientData;
if (slaveInterp == (Tcl_Interp *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"interpreter ", Tcl_GetStringFromObj(objv[0], &len),
" has been deleted", (char *) NULL);
return TCL_ERROR;
}
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp,
"tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
panic("SlaveObjectCmd: could not find slave record");
}
result = Tcl_GetIndexFromObj(interp, objv[1], subCmds, "option",
0, (int *) &index);
if (result != TCL_OK) {
return result;
}
switch (index) {
case IAliasIdx:
return SlaveAliasHelper(interp, slaveInterp, slavePtr, objc, objv);
case IAliasesIdx:
return SlaveAliasesHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IEvalIdx:
return SlaveEvalHelper(interp, slaveInterp, slavePtr, objc, objv);
case IExposeIdx:
return SlaveExposeHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IHideIdx:
return SlaveHideHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IHiddenIdx:
return SlaveHiddenHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IIsSafeIdx:
return SlaveIsSafeHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IInvokeHiddenIdx:
return SlaveInvokeHiddenHelper(interp, slaveInterp, slavePtr,
objc, objv);
case IMarkTrustedIdx:
return SlaveMarkTrustedHelper(interp, slaveInterp, slavePtr,
objc, objv);
}
return TCL_ERROR;
}
static void
SlaveObjectDeleteProc(clientData)
ClientData clientData;
{
Slave *slavePtr;
Tcl_Interp *slaveInterp;
slaveInterp = (Tcl_Interp *) clientData;
slavePtr = (Slave *) Tcl_GetAssocData(slaveInterp, "tclSlaveRecord",NULL);
if (slavePtr == (Slave *) NULL) {
panic("SlaveObjectDeleteProc: could not find slave record");
}
Tcl_DeleteHashEntry(slavePtr->slaveEntry);
slavePtr->interpCmd = NULL;
Tcl_DeleteInterp(slavePtr->slaveInterp);
}
static int
AliasCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
Tcl_Interp *targetInterp;
Interp *iPtr;
Alias *aliasPtr;
Tcl_Command cmd;
Command *cmdPtr;
Tcl_Namespace *targetNsPtr;
int result;
int i, j, addObjc;
int localObjc;
Tcl_Obj **localObjv;
Tcl_Obj *namePtr, *objPtr;
char *string;
int len;
aliasPtr = (Alias *) clientData;
targetInterp = aliasPtr->targetInterp;
cmdPtr = NULL;
targetNsPtr = Tcl_GetGlobalNamespace(aliasPtr->targetInterp);
cmd = Tcl_FindCommand(targetInterp, aliasPtr->targetName,
targetNsPtr, 0);
if (cmd != (Tcl_Command) NULL) {
cmdPtr = (Command *) cmd;
}
iPtr = (Interp *) targetInterp;
if (cmdPtr == NULL) {
addObjc = aliasPtr->objc;
localObjc = addObjc + objc + 1;
localObjv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *)
* localObjc);
localObjv[0] = Tcl_NewStringObj("unknown", -1);
localObjv[1] = Tcl_NewStringObj(aliasPtr->targetName, -1);
Tcl_IncrRefCount(localObjv[0]);
Tcl_IncrRefCount(localObjv[1]);
for (i = 0, j = 2; i < addObjc; i++, j++) {
localObjv[j] = aliasPtr->objv[i];
}
for (i = 1; i < objc; i++, j++) {
localObjv[j] = objv[i];
}
Tcl_Preserve((ClientData) targetInterp);
result = TclObjInvoke(targetInterp, localObjc, localObjv, 0);
Tcl_DecrRefCount(localObjv[0]);
Tcl_DecrRefCount(localObjv[1]);
ckfree((char *) localObjv);
if (targetInterp != interp) {
if (result == TCL_ERROR) {
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo((Tcl_Interp *) iPtr, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(targetInterp, namePtr,
(Tcl_Obj *) NULL, TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(targetInterp, "errorCode", (char *)
NULL, TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
Tcl_ResetResult(targetInterp);
}
Tcl_Release((ClientData) targetInterp);
return result;
}
if (aliasPtr->objc <= 0) {
localObjv = (Tcl_Obj **) objv;
localObjc = objc;
} else {
addObjc = aliasPtr->objc;
localObjc = objc + addObjc;
localObjv =
(Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * localObjc);
localObjv[0] = objv[0];
for (i = 0, j = 1; i < addObjc; i++, j++) {
localObjv[j] = aliasPtr->objv[i];
}
for (i = 1; i < objc; i++, j++) {
localObjv[j] = objv[i];
}
}
iPtr->numLevels++;
Tcl_Preserve((ClientData) targetInterp);
Tcl_ResetResult(targetInterp);
result = (cmdPtr->objProc)(cmdPtr->objClientData, targetInterp,
localObjc, localObjv);
iPtr->numLevels--;
if (iPtr->numLevels == 0) {
if (result == TCL_RETURN) {
result = TclUpdateReturnInfo(iPtr);
}
if ((result != TCL_OK) && (result != TCL_ERROR)) {
Tcl_ResetResult(targetInterp);
if (result == TCL_BREAK) {
Tcl_SetObjResult(targetInterp,
Tcl_NewStringObj("invoked \"break\" outside of a loop",
-1));
} else if (result == TCL_CONTINUE) {
Tcl_SetObjResult(targetInterp,
Tcl_NewStringObj(
"invoked \"continue\" outside of a loop",
-1));
} else {
char buf[128];
sprintf(buf, "command returned bad code: %d", result);
Tcl_SetObjResult(targetInterp, Tcl_NewStringObj(buf, -1));
}
result = TCL_ERROR;
}
}
if (localObjv != objv) {
ckfree((char *) localObjv);
}
if (interp != targetInterp) {
if (result == TCL_ERROR) {
if (!(iPtr->flags & ERR_ALREADY_LOGGED)) {
Tcl_AddErrorInfo(targetInterp, "");
}
iPtr->flags &= (~(ERR_ALREADY_LOGGED));
Tcl_ResetResult(interp);
namePtr = Tcl_NewStringObj("errorInfo", -1);
objPtr = Tcl_ObjGetVar2(targetInterp, namePtr, (Tcl_Obj *) NULL,
TCL_GLOBAL_ONLY);
string = Tcl_GetStringFromObj(objPtr, &len);
Tcl_AddObjErrorInfo(interp, string, len);
Tcl_SetVar2(interp, "errorCode", (char *) NULL,
Tcl_GetVar2(targetInterp, "errorCode", (char *) NULL,
TCL_GLOBAL_ONLY),
TCL_GLOBAL_ONLY);
Tcl_DecrRefCount(namePtr);
}
Tcl_SetObjResult(interp, Tcl_GetObjResult(targetInterp));
Tcl_ResetResult(targetInterp);
}
Tcl_Release((ClientData) targetInterp);
return result;
}
static void
AliasCmdDeleteProc(clientData)
ClientData clientData;
{
Alias *aliasPtr;
Target *targetPtr;
int i;
aliasPtr = (Alias *) clientData;
targetPtr = (Target *) Tcl_GetHashValue(aliasPtr->targetEntry);
ckfree((char *) targetPtr);
Tcl_DeleteHashEntry(aliasPtr->targetEntry);
ckfree((char *) aliasPtr->targetName);
ckfree((char *) aliasPtr->aliasName);
for (i = 0; i < aliasPtr->objc; i++) {
Tcl_DecrRefCount(aliasPtr->objv[i]);
}
if (aliasPtr->objv != (Tcl_Obj **) NULL) {
ckfree((char *) aliasPtr->objv);
}
Tcl_DeleteHashEntry(aliasPtr->aliasEntry);
ckfree((char *) aliasPtr);
}
static void
MasterRecordDeleteProc(clientData, interp)
ClientData clientData;
Tcl_Interp *interp;
{
Target *targetPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
Slave *slavePtr;
Master *masterPtr;
masterPtr = (Master *) clientData;
for (hPtr = Tcl_FirstHashEntry(&(masterPtr->slaveTable), &hSearch);
hPtr != NULL;
hPtr = Tcl_NextHashEntry(&hSearch)) {
slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
(void) Tcl_DeleteCommandFromToken(interp, slavePtr->interpCmd);
}
Tcl_DeleteHashTable(&(masterPtr->slaveTable));
for (hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch);
hPtr != NULL;
hPtr = Tcl_FirstHashEntry(&(masterPtr->targetTable), &hSearch)) {
targetPtr = (Target *) Tcl_GetHashValue(hPtr);
(void) Tcl_DeleteCommandFromToken(targetPtr->slaveInterp,
targetPtr->slaveCmd);
}
Tcl_DeleteHashTable(&(masterPtr->targetTable));
ckfree((char *) masterPtr);
}
static void
SlaveRecordDeleteProc(clientData, interp)
ClientData clientData;
Tcl_Interp *interp;
{
Slave *slavePtr;
Alias *aliasPtr;
Tcl_HashTable *hTblPtr;
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
slavePtr = (Slave *) clientData;
if (slavePtr == NULL) {
panic("SlaveRecordDeleteProc: NULL slavePtr");
}
if (slavePtr->interpCmd != (Tcl_Command) NULL) {
Command *cmdPtr = (Command *) slavePtr->interpCmd;
Tcl_DeleteHashEntry(slavePtr->slaveEntry);
cmdPtr->clientData = NULL;
cmdPtr->deleteProc = NULL;
cmdPtr->deleteData = NULL;
Tcl_DeleteCommandFromToken(slavePtr->masterInterp,
slavePtr->interpCmd);
}
hTblPtr = (Tcl_HashTable *) &(slavePtr->aliasTable);
for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
hPtr != (Tcl_HashEntry *) NULL;
hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
Tcl_DeleteCommandFromToken(interp, aliasPtr->slaveCmd);
}
Tcl_DeleteHashTable(hTblPtr);
ckfree((char *) slavePtr);
}
int
TclInterpInit(interp)
Tcl_Interp *interp;
{
Master *masterPtr;
Slave *slavePtr;
masterPtr = (Master *) ckalloc((unsigned) sizeof(Master));
Tcl_InitHashTable(&(masterPtr->slaveTable), TCL_STRING_KEYS);
Tcl_InitHashTable(&(masterPtr->targetTable), TCL_ONE_WORD_KEYS);
(void) Tcl_SetAssocData(interp, "tclMasterRecord", MasterRecordDeleteProc,
(ClientData) masterPtr);
slavePtr = (Slave *) ckalloc((unsigned) sizeof(Slave));
slavePtr->masterInterp = (Tcl_Interp *) NULL;
slavePtr->slaveEntry = (Tcl_HashEntry *) NULL;
slavePtr->slaveInterp = interp;
slavePtr->interpCmd = (Tcl_Command) NULL;
Tcl_InitHashTable(&(slavePtr->aliasTable), TCL_STRING_KEYS);
(void) Tcl_SetAssocData(interp, "tclSlaveRecord", SlaveRecordDeleteProc,
(ClientData) slavePtr);
return TCL_OK;
}
int
Tcl_IsSafe(interp)
Tcl_Interp *interp;
{
Interp *iPtr;
if (interp == (Tcl_Interp *) NULL) {
return 0;
}
iPtr = (Interp *) interp;
return ( (iPtr->flags) & SAFE_INTERP ) ? 1 : 0 ;
}
Tcl_Interp *
Tcl_CreateSlave(interp, slavePath, isSafe)
Tcl_Interp *interp;
char *slavePath;
int isSafe;
{
Master *masterPtr;
if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
return NULL;
}
masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord",
NULL);
if (masterPtr == (Master *) NULL) {
panic("CreatSlave: could not find master record");
}
return CreateSlave(interp, masterPtr, slavePath, isSafe);
}
Tcl_Interp *
Tcl_GetSlave(interp, slavePath)
Tcl_Interp *interp;
char *slavePath;
{
Master *masterPtr;
if ((interp == (Tcl_Interp *) NULL) || (slavePath == (char *) NULL)) {
return NULL;
}
masterPtr = (Master *) Tcl_GetAssocData(interp, "tclMasterRecord", NULL);
if (masterPtr == (Master *) NULL) {
panic("Tcl_GetSlave: could not find master record");
}
return GetInterp(interp, masterPtr, slavePath, NULL);
}
Tcl_Interp *
Tcl_GetMaster(interp)
Tcl_Interp *interp;
{
Slave *slavePtr;
if (interp == (Tcl_Interp *) NULL) {
return NULL;
}
slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
return NULL;
}
return slavePtr->masterInterp;
}
int
Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv)
Tcl_Interp *slaveInterp;
char *slaveCmd;
Tcl_Interp *targetInterp;
char *targetCmd;
int argc;
char **argv;
{
Master *masterPtr;
Tcl_Obj **objv;
int i;
int result;
if ((slaveInterp == (Tcl_Interp *) NULL) ||
(targetInterp == (Tcl_Interp *) NULL) ||
(slaveCmd == (char *) NULL) ||
(targetCmd == (char *) NULL)) {
return TCL_ERROR;
}
masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
NULL);
if (masterPtr == (Master *) NULL) {
panic("Tcl_CreateAlias: could not find master record");
}
objv = (Tcl_Obj **) ckalloc((unsigned) sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
}
result = AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
masterPtr, slaveCmd, targetCmd, argc, objv);
ckfree((char *) objv);
return result;
}
int
Tcl_CreateAliasObj(slaveInterp, slaveCmd, targetInterp, targetCmd, objc, objv)
Tcl_Interp *slaveInterp;
char *slaveCmd;
Tcl_Interp *targetInterp;
char *targetCmd;
int objc;
Tcl_Obj *CONST objv[];
{
Master *masterPtr;
if ((slaveInterp == (Tcl_Interp *) NULL) ||
(targetInterp == (Tcl_Interp *) NULL) ||
(slaveCmd == (char *) NULL) ||
(targetCmd == (char *) NULL)) {
return TCL_ERROR;
}
masterPtr = (Master *) Tcl_GetAssocData(targetInterp, "tclMasterRecord",
NULL);
if (masterPtr == (Master *) NULL) {
panic("Tcl_CreateAlias: could not find master record");
}
return AliasCreationHelper(slaveInterp, slaveInterp, targetInterp,
masterPtr, slaveCmd, targetCmd, objc, objv);
}
int
Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr,
argvPtr)
Tcl_Interp *interp;
char *aliasName;
Tcl_Interp **targetInterpPtr;
char **targetNamePtr;
int *argcPtr;
char ***argvPtr;
{
Slave *slavePtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
int len;
int i;
if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
return TCL_ERROR;
}
slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
panic("Tcl_GetAlias: could not find slave record");
}
hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendResult(interp, "alias \"", aliasName, "\" not found",
(char *) NULL);
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
if (targetInterpPtr != (Tcl_Interp **) NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
}
if (targetNamePtr != (char **) NULL) {
*targetNamePtr = aliasPtr->targetName;
}
if (argcPtr != (int *) NULL) {
*argcPtr = aliasPtr->objc;
}
if (argvPtr != (char ***) NULL) {
*argvPtr = (char **) ckalloc((unsigned) sizeof(char *) *
aliasPtr->objc);
for (i = 0; i < aliasPtr->objc; i++) {
*argvPtr[i] = Tcl_GetStringFromObj(aliasPtr->objv[i], &len);
}
}
return TCL_OK;
}
int
Tcl_GetAliasObj(interp, aliasName, targetInterpPtr, targetNamePtr, objcPtr,
objvPtr)
Tcl_Interp *interp;
char *aliasName;
Tcl_Interp **targetInterpPtr;
char **targetNamePtr;
int *objcPtr;
Tcl_Obj ***objvPtr;
{
Slave *slavePtr;
Tcl_HashEntry *hPtr;
Alias *aliasPtr;
if ((interp == (Tcl_Interp *) NULL) || (aliasName == (char *) NULL)) {
return TCL_ERROR;
}
slavePtr = (Slave *) Tcl_GetAssocData(interp, "tclSlaveRecord", NULL);
if (slavePtr == (Slave *) NULL) {
panic("Tcl_GetAlias: could not find slave record");
}
hPtr = Tcl_FindHashEntry(&(slavePtr->aliasTable), aliasName);
if (hPtr == (Tcl_HashEntry *) NULL) {
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"alias \"", aliasName, "\" not found", (char *) NULL);
return TCL_ERROR;
}
aliasPtr = (Alias *) Tcl_GetHashValue(hPtr);
if (targetInterpPtr != (Tcl_Interp **) NULL) {
*targetInterpPtr = aliasPtr->targetInterp;
}
if (targetNamePtr != (char **) NULL) {
*targetNamePtr = aliasPtr->targetName;
}
if (objcPtr != (int *) NULL) {
*objcPtr = aliasPtr->objc;
}
if (objvPtr != (Tcl_Obj ***) NULL) {
*objvPtr = aliasPtr->objv;
}
return TCL_OK;
}