From 3826a26f8a75540c7f3ff0b45f76498e85486dc9 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 7 Oct 2018 19:34:52 +0000 Subject: Centralise the de-fanging of standard ensembles in safe interpreters. Doing it right once is easier than repeating hacks... --- generic/tclBasic.c | 158 ++++++++++++++++++++++++++- generic/tclCmdAH.c | 306 ++++++----------------------------------------------- generic/tclCmdIL.c | 2 +- generic/tclInt.h | 2 - generic/tclZipfs.c | 28 ++--- library/safe.tcl | 47 ++++---- tests/info.test | 12 +-- tests/interp.test | 2 +- tests/safe.test | 12 +-- tests/zipfs.test | 36 +++++++ 10 files changed, 269 insertions(+), 336 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index da43a5d..d3ecbf3 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -105,6 +105,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -207,6 +208,24 @@ typedef struct { * it for it. Defined in tclInt.h. */ /* + * The following struct states that the command it talks about (a subcommand + * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an + * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these + * structs.) Alas, we can't sensibly just store the information directly in + * the commands. + */ + +typedef struct { + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ +} UnsafeEnsembleInfo; + +/* * The built-in commands, and the functions that implement them: */ @@ -307,6 +326,69 @@ static const CmdInfo builtInCmds[] = { }; /* + * Information about which pieces of ensembles to hide when making an + * interpreter safe: + */ + +static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { + /* [encoding] has two unsafe commands. Assumed by older security policies + * to be overall unsafe; it isn't but... */ + {"encoding", NULL}, + {"encoding", "dirs"}, + {"encoding", "system"}, + /* [file] has MANY unsafe commands! Assumed by older security policies to + * be overall unsafe; it isn't but... */ + {"file", NULL}, + {"file", "atime"}, + {"file", "attributes"}, + {"file", "copy"}, + {"file", "delete"}, + {"file", "dirname"}, + {"file", "executable"}, + {"file", "exists"}, + {"file", "extension"}, + {"file", "isdirectory"}, + {"file", "isfile"}, + {"file", "link"}, + {"file", "lstat"}, + {"file", "mtime"}, + {"file", "mkdir"}, + {"file", "nativename"}, + {"file", "normalize"}, + {"file", "owned"}, + {"file", "readable"}, + {"file", "readlink"}, + {"file", "rename"}, + {"file", "rootname"}, + {"file", "size"}, + {"file", "stat"}, + {"file", "tail"}, + {"file", "tempfile"}, + {"file", "type"}, + {"file", "volumes"}, + {"file", "writable"}, + /* [info] has two unsafe commands */ + {"info", "cmdtype"}, + {"info", "nameofexecutable"}, + /* [tcl::process] has ONLY unsafe commands! */ + {"process", "list"}, + {"process", "status"}, + {"process", "purge"}, + {"process", "autopurge"}, + /* [zipfs] has MANY unsafe commands! */ + {"zipfs", "lmkimg"}, + {"zipfs", "lmkzip"}, + {"zipfs", "mkimg"}, + {"zipfs", "mkkey"}, + {"zipfs", "mkzip"}, + {"zipfs", "mount"}, + {"zipfs", "mount_data"}, + {"zipfs", "tcl_library"}, + {"zipfs", "unmount"}, + {NULL, NULL} +}; + +/* * Math functions. All are safe. */ @@ -1135,6 +1217,7 @@ TclHideUnsafeCommands( Tcl_Interp *interp) /* Hide commands in this interpreter. */ { register const CmdInfo *cmdInfoPtr; + register const UnsafeEnsembleInfo *unsafePtr; if (interp == NULL) { return TCL_ERROR; @@ -1144,12 +1227,83 @@ TclHideUnsafeCommands( Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } - TclMakeEncodingCommandSafe(interp); /* Ugh! */ - TclMakeFileCommandSafe(interp); /* Ugh! */ + + for (unsafePtr = unsafeEnsembleCommands; + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + + if (TclRenameCommand(interp, TclGetString(cmdName), + "___tmp") != TCL_OK + || Tcl_HideCommand(interp, "___tmp", + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetString(Tcl_GetObjResult(interp))); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (ClientData) unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetString(Tcl_GetObjResult(interp))); + } + } + } + return TCL_OK; } /* + *---------------------------------------------------------------------- + * + * BadEnsembleSubcommand -- + * + * Command used to act as a backstop implementation when subcommands of + * ensembles are unsafe (the real implementations of the subcommands are + * hidden). The clientData is description of what was hidden. + * + * Results: + * A standard Tcl result (always a TCL_ERROR). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +BadEnsembleSubcommand( + ClientData clientData, + Tcl_Interp *interp, + int objc, + Tcl_Obj *const objv[]) +{ + const UnsafeEnsembleInfo *infoPtr = clientData; + + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); + Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); + return TCL_ERROR; +} + +/* *-------------------------------------------------------------- * * Tcl_CallWhenDeleted -- diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 94cb8aa..334121f 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -46,9 +46,6 @@ struct ForeachState { static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode); -static int BadEncodingSubcommand(ClientData dummy, - Tcl_Interp *interp, int objc, - Tcl_Obj *const objv[]); static int EncodingConvertfromObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -84,7 +81,6 @@ static Tcl_NRPostProc ForPostNextCallback; static Tcl_NRPostProc ForeachLoopStep; static Tcl_NRPostProc EvalCmdErrMsg; -static Tcl_ObjCmdProc BadFileSubcommand; static Tcl_ObjCmdProc FileAttrAccessTimeCmd; static Tcl_ObjCmdProc FileAttrIsDirectoryCmd; static Tcl_ObjCmdProc FileAttrIsExecutableCmd; @@ -536,9 +532,9 @@ TclInitEncodingCmd( static const EnsembleImplMap encodingImplMap[] = { {"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, {"convertto", EncodingConverttoObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, - {"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, {"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, - {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, + {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; @@ -546,113 +542,6 @@ TclInitEncodingCmd( } /* - *----------------------------------------------------------------------------- - * - * TclMakeEncodingCommandSafe -- - * - * This function hides the unsafe 'dirs' and 'system' subcommands of - * the "encoding" Tcl command ensemble. It must be called only from - * TclHideUnsafeCommands. - * - * Results: - * A standard Tcl result - * - * Side effects: - * Adds commands to the table of hidden commands. - * - *----------------------------------------------------------------------------- - */ - -int -TclMakeEncodingCommandSafe( - Tcl_Interp* interp) /* Tcl interpreter */ -{ - static const struct { - const char *cmdName; - int unsafe; - } unsafeInfo[] = { - {"convertfrom", 0}, - {"convertto", 0}, - {"dirs", 1}, - {"names", 0}, - {"system", 0}, - {NULL, 0} - }; - - int i; - Tcl_DString oldBuf, newBuf; - - Tcl_DStringInit(&oldBuf); - TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::"); - Tcl_DStringInit(&newBuf); - TclDStringAppendLiteral(&newBuf, "tcl:encoding:"); - for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { - if (unsafeInfo[i].unsafe) { - const char *oldName, *newName; - - Tcl_DStringSetLength(&oldBuf, 17); - oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1); - Tcl_DStringSetLength(&newBuf, 13); - newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1); - if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) { - Tcl_Panic("problem making 'encoding %s' safe: %s", - unsafeInfo[i].cmdName, - Tcl_GetString(Tcl_GetObjResult(interp))); - } - Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand, - (ClientData) unsafeInfo[i].cmdName, NULL); - } - } - Tcl_DStringFree(&oldBuf); - Tcl_DStringFree(&newBuf); - - /* - * Ugh. The [encoding] command is now actually safe, but it is assumed by - * scripts that it is not, which messes up security policies. - */ - - if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) { - Tcl_Panic("problem making 'encoding' safe: %s", - Tcl_GetString(Tcl_GetObjResult(interp))); - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * BadEncodingSubcommand -- - * - * Command used to act as a backstop implementation when subcommands of - * "encoding" are unsafe (the real implementations of the subcommands are - * hidden). The clientData is always the full official subcommand name. - * - * Results: - * A standard Tcl result (always a TCL_ERROR). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -BadEncodingSubcommand( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *subcommandName = (const char *) clientData; - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of encoding", subcommandName)); - Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); - return TCL_ERROR; -} - -/* *---------------------------------------------------------------------- * * EncodingConvertfromObjCmd -- @@ -1174,40 +1063,40 @@ TclInitFileCmd( */ static const EnsembleImplMap initMap[] = { - {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, - {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0}, + {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1}, + {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 1}, {"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, - {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0}, - {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"copy", TclFileCopyCmd, NULL, NULL, NULL, 1}, + {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, + {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0}, - {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0}, - {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, - {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, - {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0}, - {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 1}, + {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1}, + {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1}, + {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1}, + {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0}, - {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"rename", TclFileRenameCmd, NULL, NULL, NULL, 1}, + {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, - {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0}, + {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1}, {"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, - {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0}, - {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, - {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, - {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, + {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1}, + {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, + {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, + {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; return TclMakeEnsemble(interp, "file", initMap); @@ -1216,141 +1105,6 @@ TclInitFileCmd( /* *---------------------------------------------------------------------- * - * TclMakeFileCommandSafe -- - * - * This function hides the unsafe subcommands of the "file" Tcl command - * ensemble. It must only be called from TclHideUnsafeCommands. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * Adds commands to the table of hidden commands. - * - *---------------------------------------------------------------------- - */ - -int -TclMakeFileCommandSafe( - Tcl_Interp *interp) -{ - static const struct { - const char *cmdName; - int unsafe; - } unsafeInfo[] = { - {"atime", 1}, - {"attributes", 1}, - {"channels", 0}, - {"copy", 1}, - {"delete", 1}, - {"dirname", 1}, - {"executable", 1}, - {"exists", 1}, - {"extension", 1}, - {"isdirectory", 1}, - {"isfile", 1}, - {"join", 0}, - {"link", 1}, - {"lstat", 1}, - {"mtime", 1}, - {"mkdir", 1}, - {"nativename", 1}, - {"normalize", 1}, - {"owned", 1}, - {"pathtype", 0}, - {"readable", 1}, - {"readlink", 1}, - {"rename", 1}, - {"rootname", 1}, - {"separator", 0}, - {"size", 1}, - {"split", 0}, - {"stat", 1}, - {"system", 0}, - {"tail", 1}, - {"tempfile", 1}, - {"type", 1}, - {"volumes", 1}, - {"writable", 1}, - {NULL, 0} - }; - int i; - Tcl_DString oldBuf, newBuf; - - Tcl_DStringInit(&oldBuf); - TclDStringAppendLiteral(&oldBuf, "::tcl::file::"); - Tcl_DStringInit(&newBuf); - TclDStringAppendLiteral(&newBuf, "tcl:file:"); - for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) { - if (unsafeInfo[i].unsafe) { - const char *oldName, *newName; - - Tcl_DStringSetLength(&oldBuf, 13); - oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1); - Tcl_DStringSetLength(&newBuf, 9); - newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1); - if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) { - Tcl_Panic("problem making 'file %s' safe: %s", - unsafeInfo[i].cmdName, - Tcl_GetString(Tcl_GetObjResult(interp))); - } - Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand, - (ClientData) unsafeInfo[i].cmdName, NULL); - } - } - Tcl_DStringFree(&oldBuf); - Tcl_DStringFree(&newBuf); - - /* - * Ugh. The [file] command is now actually safe, but it is assumed by - * scripts that it is not, which messes up security policies. [Bug - * 3211758] - */ - - if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) { - Tcl_Panic("problem making 'file' safe: %s", - Tcl_GetString(Tcl_GetObjResult(interp))); - } - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * BadFileSubcommand -- - * - * Command used to act as a backstop implementation when subcommands of - * "file" are unsafe (the real implementations of the subcommands are - * hidden). The clientData is always the full official subcommand name. - * - * Results: - * A standard Tcl result (always a TCL_ERROR). - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -BadFileSubcommand( - ClientData clientData, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[]) -{ - const char *subcommandName = (const char *) clientData; - - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of file", subcommandName)); - Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL); - return TCL_ERROR; -} - -/* - *---------------------------------------------------------------------- - * * FileAttrAccessTimeCmd -- * * This function is invoked to process the "file atime" Tcl command. See diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index 1dae740..434840e 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -173,7 +173,7 @@ static const EnsembleImplMap defaultInfoMap[] = { {"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, - {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, + {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1}, {"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0}, {"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, {"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, diff --git a/generic/tclInt.h b/generic/tclInt.h index 4a1b459..8ef0218 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3360,7 +3360,6 @@ MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp); MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); @@ -3389,7 +3388,6 @@ MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp); -MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp); MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index ea6d5ad..ff04971 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -4713,21 +4713,21 @@ TclZipfs_Init( { #ifdef HAVE_ZLIB static const EnsembleImplMap initMap[] = { - {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 0}, - {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 0}, - {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 0}, - {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 0}, + {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 1}, + {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 1}, + {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 1}, + {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 1}, /* The 4 entries above are not available in safe interpreters */ - {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 0}, - {"mount_data", ZipFSMountBufferObjCmd, NULL, NULL, NULL, 0}, - {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 0}, - {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 0}, - {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 1}, - {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 1}, - {"list", ZipFSListObjCmd, NULL, NULL, NULL, 1}, - {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1}, - {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 1}, - {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 0}, + {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 1}, + {"mount_data", ZipFSMountBufferObjCmd, NULL, NULL, NULL, 1}, + {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 1}, + {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 1}, + {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 0}, + {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 0}, + {"list", ZipFSListObjCmd, NULL, NULL, NULL, 0}, + {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 0}, + {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 0}, + {"tcl_library", ZipFSTclLibraryObjCmd, NULL, NULL, NULL, 1}, {NULL, NULL, NULL, NULL, NULL, 0} }; static const char findproc[] = diff --git a/library/safe.tcl b/library/safe.tcl index ea6391d..7b165d2 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -455,37 +455,35 @@ proc ::safe::InterpInit { foreach {command alias} { source AliasSource load AliasLoad - encoding AliasEncoding exit interpDelete glob AliasGlob } { ::interp alias $slave $command {} [namespace current]::$alias $slave } + # UGLY POINT! These commands are safe (they're ensembles with unsafe + # subcommands), but is assumed to not be by existing policies so it is + # hidden by default. Hack it... + foreach command {encoding file} { + ::interp alias $slave $command {} interp invokehidden $slave $command + } + # This alias lets the slave have access to a subset of the 'file' # command functionality. - ::interp expose $slave file foreach subcommand {dirname extension rootname tail} { ::interp alias $slave ::tcl::file::$subcommand {} \ ::safe::AliasFileSubcommand $slave $subcommand } - foreach subcommand { - atime attributes copy delete executable exists isdirectory isfile - link lstat mtime mkdir nativename normalize owned readable readlink - rename size stat tempfile type volumes writable - } { - ::interp alias $slave ::tcl::file::$subcommand {} \ - ::safe::BadSubcommand $slave file $subcommand - } + + # Subcommand of 'encoding' that has special handling; [encoding system] is + # OK provided it has no other arguments passed to it. + ::interp alias $slave ::tcl::encoding::system {} \ + ::safe::AliasEncodingSystem $slave # Subcommands of info - foreach {subcommand alias} { - nameofexecutable AliasExeName - } { - ::interp alias $slave ::tcl::info::$subcommand \ - {} [namespace current]::$alias $slave - } + ::interp alias $slave ::tcl::info::nameofexecutable {} \ + ::safe::AliasExeName $slave # The allowed slave variables already have been set by Tcl_MakeSafe(3) @@ -1027,16 +1025,13 @@ proc ::safe::BadSubcommand {slave command subcommand args} { return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg } -# AliasEncoding is the target of the "encoding" alias in safe interpreters. - -proc ::safe::AliasEncoding {slave option args} { - # Note that [encoding dirs] is not supported in safe slaves at all - set subcommands {convertfrom convertto names system} +# AliasEncodingSystem is the target of the "encoding system" alias in safe +# interpreters. +proc ::safe::AliasEncodingSystem {slave args} { try { - set option [tcl::prefix match -error [list -level 1 -errorcode \ - [list TCL LOOKUP INDEX option $option]] $subcommands $option] - # Special case: [encoding system] ok, but [encoding system foo] not - if {$option eq "system" && [llength $args]} { + # Must not pass extra arguments; safe slaves may not set the system + # encoding but they may read it. + if {[llength $args]} { return -code error -errorcode {TCL WRONGARGS} \ "wrong # args: should be \"encoding system\"" } @@ -1044,7 +1039,7 @@ proc ::safe::AliasEncoding {slave option args} { Log $slave $msg return -options $options $msg } - tailcall ::interp invokehidden $slave encoding $option {*}$args + tailcall ::interp invokehidden $slave tcl:encoding:system } # Various minor hiding of platform features. [Bug 2913625] diff --git a/tests/info.test b/tests/info.test index 0de1510..a12d45c 100644 --- a/tests/info.test +++ b/tests/info.test @@ -2535,9 +2535,9 @@ test info-40.18 {info cmdtype: aliases in slave interpreters} -setup { $safe eval { info cmdtype foo } -} -cleanup { +} -returnCodes error -cleanup { interp delete $safe -} -result native +} -result {not allowed to invoke subcommand cmdtype of info} test info-40.19 {info cmdtype: aliases in slave interpreters} -setup { set safe [interp create -safe] } -body { @@ -2548,9 +2548,9 @@ test info-40.19 {info cmdtype: aliases in slave interpreters} -setup { info cmdtype foo } } -} -cleanup { +} -returnCodes error -cleanup { interp delete $safe -} -result native +} -result {not allowed to invoke subcommand cmdtype of info} test info-40.20 {info cmdtype: aliases in slave interpreters} -setup { set safe [interp create -safe] } -body { @@ -2558,9 +2558,9 @@ test info-40.20 {info cmdtype: aliases in slave interpreters} -setup { interp alias {} foo {} gorp info cmdtype foo } -} -cleanup { +} -returnCodes error -cleanup { interp delete $safe -} -result alias +} -result {not allowed to invoke subcommand cmdtype of info} namespace delete ::testinfocmdtype # ------------------------------------------------------------------------- diff --git a/tests/interp.test b/tests/interp.test index 4ea04e3..e9f95d7 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -20,7 +20,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testinterpdelete [llength [info commands testinterpdelete]] -set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload} +set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:tcl_library tcl:zipfs:unmount unload} foreach i [interp slaves] { interp delete $i diff --git a/tests/safe.test b/tests/safe.test index 217507e..356e176 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -92,7 +92,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} -setup { lsort [a aliases] } -cleanup { safe::interpDelete a -} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source} +} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source} test safe-3.3 {calling safe::interpCreate on trusted interp} -setup { catch {safe::interpDelete a} } -body { @@ -464,14 +464,14 @@ test safe-11.1 {testing safe encoding} -setup { interp eval $i encoding } -returnCodes error -cleanup { safe::interpDelete $i -} -result {wrong # args: should be "encoding option ?arg ...?"} +} -result {wrong # args: should be "encoding subcommand ?arg ...?"} test safe-11.1a {testing safe encoding} -setup { set i [safe::interpCreate] } -body { interp eval $i encoding foobar } -returnCodes error -cleanup { safe::interpDelete $i -} -match glob -result {bad option "foobar": must be *} +} -match glob -result {unknown or ambiguous subcommand "foobar": must be *} test safe-11.2 {testing safe encoding} -setup { set i [safe::interpCreate] } -body { @@ -526,8 +526,6 @@ test safe-11.7.1 {testing safe encoding} -setup { while executing "encoding convertfrom" invoked from within -"::interp invokehidden interp* encoding convertfrom" - invoked from within "encoding convertfrom" invoked from within "interp eval $i encoding convertfrom"} @@ -550,8 +548,6 @@ test safe-11.8.1 {testing safe encoding} -setup { while executing "encoding convertto" invoked from within -"::interp invokehidden interp* encoding convertto" - invoked from within "encoding convertto" invoked from within "interp eval $i encoding convertto"} @@ -765,7 +761,7 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup { unset -nocomplain msg interp delete $i } -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}} -test safe-15.1.1 {safe file ensemble does not surprise code} -setup { +test safe-15.2 {safe file ensemble does not surprise code} -setup { set i [interp create -safe] } -body { set result [expr {"file" in [interp hidden $i]}] diff --git a/tests/zipfs.test b/tests/zipfs.test index 9d60f8d..631b525 100644 --- a/tests/zipfs.test +++ b/tests/zipfs.test @@ -239,6 +239,42 @@ test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body { catch {file delete -force $tmpdir} +test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup { + set interp [interp create] +} -body { + interp eval $interp { + zipfs ? + } +} -returnCodes error -cleanup { + interp delete $interp +} -result {unknown or ambiguous subcommand "?": must be canonical, exists, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, tcl_library, or unmount} +test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup { + set interp [interp create] +} -body { + interp eval $interp { + zipfs mkzip + } +} -returnCodes error -cleanup { + interp delete $interp +} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"} +test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup { + set safe [interp create -safe] +} -body { + interp eval $safe { + zipfs ? + } +} -returnCodes error -cleanup { + interp delete $safe +} -result {unknown or ambiguous subcommand "?": must be canonical, exists, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, tcl_library, or unmount} +test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup { + set safe [interp create -safe] +} -body { + interp eval $safe { + zipfs mkzip + } +} -returnCodes error -cleanup { + interp delete $safe +} -result {not allowed to invoke subcommand mkzip of zipfs} ::tcltest::cleanupTests return -- cgit v0.12