diff options
| -rw-r--r-- | generic/tclBasic.c | 1 | ||||
| -rw-r--r-- | generic/tclCmdAH.c | 112 | ||||
| -rw-r--r-- | generic/tclInt.h | 1 | ||||
| -rw-r--r-- | tests/cmdAH.test | 4 | ||||
| -rw-r--r-- | tests/interp.test | 2 |
5 files changed, 116 insertions, 4 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index c14c15b..4bddbce 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1026,6 +1026,7 @@ TclHideUnsafeCommands( Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name); } } + TclMakeEncodingCommandSafe(interp); /* Ugh! */ TclMakeFileCommandSafe(interp); /* Ugh! */ return TCL_OK; } diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 61de353..6d66a32 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -46,6 +46,9 @@ 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[]); @@ -579,7 +582,7 @@ Tcl_EncodingObjCmd( * Side effects: * The ensemble is initialized. * - * This command is not installed in a safe interpreter. + * This command is hidden in a safe interpreter. */ Tcl_Command @@ -599,6 +602,113 @@ 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 -- diff --git a/generic/tclInt.h b/generic/tclInt.h index 6aa292c..3749735 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3240,6 +3240,7 @@ 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[]); diff --git a/tests/cmdAH.test b/tests/cmdAH.test index b4ef605..3c58c1b 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -167,10 +167,10 @@ test cmdAH-3.2 {Tcl_ContinueObjCmd, success} { test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding -} -result {wrong # args: should be "encoding option ?arg ...?"} +} -result {wrong # args: should be "encoding subcommand ?arg ...?"} test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding foo -} -result {bad option "foo": must be convertfrom, convertto, dirs, names, or system} +} -result {unknown or ambiguous subcommand "foo": must be convertfrom, convertto, dirs, names, or system} test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body { encoding convertto } -result {wrong # args: should be "encoding convertto ?encoding? data"} diff --git a/tests/interp.test b/tests/interp.test index 6000ffd..4d61e35 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: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: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} foreach i [interp slaves] { interp delete $i |