From 6ec7c04557d86c9e5ddec92b3594634dba89e007 Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 27 Sep 2018 11:06:59 +0000 Subject: Restricted the information made available to safe interpreters a bit. --- doc/info.n | 8 +++-- generic/tclBasic.c | 1 + generic/tclCmdIL.c | 16 ++++++++-- generic/tclInt.h | 1 + generic/tclInterp.c | 84 +++++++++++++++++++++++++++++++++++++++++++++++++---- tests/info.test | 43 +++++++++++++++++++++++++++ 6 files changed, 142 insertions(+), 11 deletions(-) diff --git a/doc/info.n b/doc/info.n index 99d11d5..5732a13 100644 --- a/doc/info.n +++ b/doc/info.n @@ -45,12 +45,14 @@ Returns a count of the total number of commands that have been invoked in this interpreter. .TP \fBinfo cmdtype \fIcommandName\fR -.VS "info cmdtype feature" +.VS TIP426 Returns a description of the kind of command named by \fIcommandName\fR. The supported types are: .RS .IP \fBalias\fR -Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. +Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that +safe interpreters can only see a subset of aliases (specifically those between +two commands within themselves). .IP \fBcoroutine\fR Indicates that \fIcommandName\fR was created by \fBcoroutine\fR. .IP \fBensemble\fR @@ -76,7 +78,7 @@ Indicates that \fIcommandName\fR was created by \fBzlib stream\fR. There may be other registered types as well; this is a set that is extensible at the implementation level with \fBTcl_RegisterCommandTypeName\fR. .RE -.VE "info cmdtype feature" +.VE TIP426 .TP \fBinfo commands \fR?\fIpattern\fR? . diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 37f0560..da43a5d 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -530,6 +530,7 @@ Tcl_CreateInterp(void) TclRegisterCommandTypeName(TclObjInterpProc, "proc"); TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); TclRegisterCommandTypeName(TclSlaveObjCmd, "slave"); TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 8454db1..1dae740 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -158,7 +158,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, - {"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0}, {"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, {"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0}, @@ -2171,8 +2171,18 @@ InfoCmdTypeCmd( return TCL_ERROR; } - Tcl_SetObjResult(interp, - Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); + /* + * There's one special case: safe slave interpreters can't see aliases as + * aliases as they're part of the security mechanisms. + */ + + if (Tcl_IsSafe(interp) + && (((Command *) command)->objProc == TclAliasObjCmd)) { + Tcl_AppendResult(interp, "native", NULL); + } else { + Tcl_SetObjResult(interp, + Tcl_NewStringObj(TclGetCommandTypeName(command), -1)); + } return TCL_OK; } diff --git a/generic/tclInt.h b/generic/tclInt.h index 19f9d0e..4a1b459 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4123,6 +4123,7 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd; MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd; +MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd; MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd; diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 08cbef8..550e2fe 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1414,7 +1414,8 @@ TclPreventAliasLoop( * create or rename the command. */ - if (cmdPtr->objProc != TclAliasObjCmd) { + if (cmdPtr->objProc != TclAliasObjCmd + && cmdPtr->objProc != TclLocalAliasObjCmd) { return TCL_OK; } @@ -1469,7 +1470,8 @@ TclPreventAliasLoop( * Otherwise we do not have a loop. */ - if (aliasCmdPtr->objProc != TclAliasObjCmd) { + if (aliasCmdPtr->objProc != TclAliasObjCmd + && aliasCmdPtr->objProc != TclLocalAliasObjCmd) { return TCL_OK; } nextAliasPtr = aliasCmdPtr->objClientData; @@ -1535,8 +1537,8 @@ AliasCreate( if (slaveInterp == masterInterp) { aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp, - TclGetString(namePtr), TclAliasObjCmd, AliasNRCmd, aliasPtr, - AliasObjCmdDeleteProc); + TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd, + aliasPtr, AliasObjCmdDeleteProc); } else { aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp, TclGetString(namePtr), TclAliasObjCmd, aliasPtr, @@ -1776,7 +1778,7 @@ AliasList( /* *---------------------------------------------------------------------- * - * TclAliasObjCmd -- + * TclAliasObjCmd, TclLocalAliasObjCmd -- * * This is the function that services invocations of aliases in a slave * interpreter. One such command exists for each alias. When invoked, @@ -1784,6 +1786,11 @@ AliasList( * master interpreter as designated by the Alias record associated with * this command. * + * TclLocalAliasObjCmd is a stripped down version used when the source + * and target interpreters of the alias are the same. That lets a number + * of safety precautions be avoided: the state is much more precisely + * known. + * * Results: * A standard Tcl result. * @@ -1933,6 +1940,73 @@ TclAliasObjCmd( return result; #undef ALIAS_CMDV_PREALLOC } + +int +TclLocalAliasObjCmd( + ClientData clientData, /* Alias record. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument vector. */ +{ +#define ALIAS_CMDV_PREALLOC 10 + Alias *aliasPtr = clientData; + int result, prefc, cmdc, i; + Tcl_Obj **prefv, **cmdv; + Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC]; + Interp *iPtr = (Interp *) interp; + int isRootEnsemble; + + /* + * Append the arguments to the command prefix and invoke the command in + * the global namespace. + */ + + prefc = aliasPtr->objc; + prefv = &aliasPtr->objPtr; + cmdc = prefc + objc - 1; + if (cmdc <= ALIAS_CMDV_PREALLOC) { + cmdv = cmdArr; + } else { + cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *)); + } + + memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *))); + memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *))); + + for (i=0; i