summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-05-16 14:11:45 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-05-16 14:11:45 (GMT)
commit6155ef4e5cc74b11bfb0eba745e4e9c9c5e5f6be (patch)
treea81f6c319efa17de42438905c0fa802e29c20736 /generic
parent82b68720faa0b64e3566567227373cfb315d656c (diff)
downloadtcl-6155ef4e5cc74b11bfb0eba745e4e9c9c5e5f6be.zip
tcl-6155ef4e5cc74b11bfb0eba745e4e9c9c5e5f6be.tar.gz
tcl-6155ef4e5cc74b11bfb0eba745e4e9c9c5e5f6be.tar.bz2
[Bug 3445787]: Improve the compatibility of safe interpreters' version of
'file' with that of unsafe interpreters.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdAH.c42
1 files changed, 40 insertions, 2 deletions
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 70aef8d..4292224 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -61,6 +61,7 @@ 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;
@@ -581,7 +582,7 @@ Tcl_EncodingObjCmd(
break;
}
case ENC_DIRS:
- return EncodingDirsObjCmd(dummy, interp, objc-1, objv+1);
+ return EncodingDirsObjCmd(dummy, interp, objc, objv);
case ENC_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
@@ -628,10 +629,12 @@ EncodingDirsObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- if (objc > 2) {
+ if (objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?dirList?");
return TCL_ERROR;
}
+ objc -= 1;
+ objv += 1;
if (objc == 1) {
Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
@@ -1057,6 +1060,8 @@ TclMakeFileCommandSafe(
unsafeInfo[i].cmdName,
Tcl_GetString(Tcl_GetObjResult(interp)));
}
+ Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
+ (ClientData) unsafeInfo[i].cmdName, NULL);
}
}
Tcl_DStringFree(&oldBuf);
@@ -1078,6 +1083,39 @@ TclMakeFileCommandSafe(
/*
*----------------------------------------------------------------------
*
+ * 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