Make 'clock' and 'encoding' into compilable ensembles that play with safe interpskbk_clock_encoding_ensembles

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