Make the guts of [chan] more robust.

3 files changed, 64 insertions, 30 deletions

diff --git a/ChangeLog b/ChangeLog
index ce83e3c..829f493 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2006-11-20  Donal K. Fellows  <dkf@users.sf.net>
+
+	* generic/tclBasic.c (Tcl_CreateInterp, TclHideUnsafeCommands): 
+	* library/init.tcl: Refactored the [chan] command's guts so that it
+	does not use aliases to global commands, making the code more robust.
+
 2006-11-17  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclExecute.c (INST_EXPON):	Corrected crash on
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 3844e16..a817bd9 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.218 2006/11/15 20:08:42 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.219 2006/11/20 14:28:02 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -83,7 +83,7 @@ static void	MathFuncWrongNumArgs (Tcl_Interp* interp, int expected,
 extern TclStubs tclStubs;
 
 /*
- * The following structure defines the commands in the Tcl core.
+ * The following structures define the commands in the Tcl core.
  */
 
 typedef struct {
@@ -94,12 +94,20 @@ typedef struct {
 				 * safe interpreter. Otherwise it will be
 				 * hidden. */
 } CmdInfo;
+typedef struct {
+    const char *name;		/* Name of object-based command. */
+    const char *name2;		/* Name of secondary object-based command. */
+    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
+    int isSafe;			/* If non-zero, command will be present in
+				 * safe interpreter. Otherwise it will be
+				 * hidden. */
+} CmdInfo2;
 
 /*
  * The built-in commands, and the functions that implement them:
  */
 
-static CmdInfo builtInCmds[] = {
+static const CmdInfo builtInCmds[] = {
     /*
      * Commands in the generic core.
      */
@@ -119,8 +127,6 @@ static CmdInfo builtInCmds[] = {
     {"eval",		Tcl_EvalObjCmd,		NULL,			1},
     {"exit",		Tcl_ExitObjCmd,		NULL,			0},
     {"expr",		Tcl_ExprObjCmd,		TclCompileExprCmd,	1},
-    {"fcopy",		Tcl_FcopyObjCmd,	NULL,			1},
-    {"fileevent",	Tcl_FileEventObjCmd,	NULL,			1},
     {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	1},
     {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	1},
     {"format",		Tcl_FormatObjCmd,	NULL,			1},
@@ -171,22 +177,12 @@ static CmdInfo builtInCmds[] = {
 #ifndef TCL_GENERIC_ONLY
     {"after",		Tcl_AfterObjCmd,	NULL,			1},
     {"cd",		Tcl_CdObjCmd,		NULL,			0},
-    {"close",		Tcl_CloseObjCmd,	NULL,			1},
-    {"eof",		Tcl_EofObjCmd,		NULL,			1},
-    {"fblocked",	Tcl_FblockedObjCmd,	NULL,			1},
-    {"fconfigure",	Tcl_FconfigureObjCmd,	NULL,			0},
     {"file",		Tcl_FileObjCmd,		NULL,			0},
-    {"flush",		Tcl_FlushObjCmd,	NULL,			1},
-    {"gets",		Tcl_GetsObjCmd,		NULL,			1},
     {"glob",		Tcl_GlobObjCmd,		NULL,			0},
     {"open",		Tcl_OpenObjCmd,		NULL,			0},
     {"pid",		Tcl_PidObjCmd,		NULL,			1},
-    {"puts",		Tcl_PutsObjCmd,		NULL,			1},
     {"pwd",		Tcl_PwdObjCmd,		NULL,			0},
-    {"read",		Tcl_ReadObjCmd,		NULL,			1},
-    {"seek",		Tcl_SeekObjCmd,		NULL,			1},
     {"socket",		Tcl_SocketObjCmd,	NULL,			0},
-    {"tell",		Tcl_TellObjCmd,		NULL,			1},
     {"time",		Tcl_TimeObjCmd,		NULL,			1},
     {"update",		Tcl_UpdateObjCmd,	NULL,			1},
     {"vwait",		Tcl_VwaitObjCmd,	NULL,			1},
@@ -196,6 +192,24 @@ static CmdInfo builtInCmds[] = {
     {NULL,		NULL,			NULL,			0}
 };
 
+static const CmdInfo2 builtInCmds2[] = {
+    {"fileevent",	"::tcl::chan::event",	  Tcl_FileEventObjCmd,	1},
+    {"fcopy",		"::tcl::chan::copy",	  Tcl_FcopyObjCmd,	1},
+#ifndef TCL_GENERIC_ONLY
+    {"close",		"::tcl::chan::close",	  Tcl_CloseObjCmd,	1},
+    {"eof",		"::tcl::chan::eof",	  Tcl_EofObjCmd,	1},
+    {"fblocked",	"::tcl::chan::blocked",	  Tcl_FblockedObjCmd,	1},
+    {"fconfigure",	"::tcl::chan::configure", Tcl_FconfigureObjCmd,	0},
+    {"flush",		"::tcl::chan::flush",	  Tcl_FlushObjCmd,	1},
+    {"gets",		"::tcl::chan::gets",	  Tcl_GetsObjCmd,	1},
+    {"puts",		"::tcl::chan::puts",	  Tcl_PutsObjCmd,	1},
+    {"read",		"::tcl::chan::read",	  Tcl_ReadObjCmd,	1},
+    {"seek",		"::tcl::chan::seek",	  Tcl_SeekObjCmd,	1},
+    {"tell",		"::tcl::chan::tell",	  Tcl_TellObjCmd,	1},
+#endif /* TCL_GENERIC_ONLY */
+    {NULL,		NULL,			0}
+};
+
 /*
  * Math functions
  */
@@ -206,7 +220,7 @@ typedef struct {
     Tcl_ObjCmdProc *objCmdProc;	/* Function that evaluates the function */
     ClientData clientData;	/* Client data for the function */
 } BuiltinFuncDef;
-static BuiltinFuncDef BuiltinFuncTable[] = {
+static const BuiltinFuncDef BuiltinFuncTable[] = {
     { "abs",	ExprAbsFunc,	NULL 			},
     { "acos",	ExprUnaryFunc,	(ClientData) acos 	},
     { "asin",	ExprUnaryFunc,	(ClientData) asin 	},
@@ -262,8 +276,9 @@ Tcl_CreateInterp(void)
     Interp *iPtr;
     Tcl_Interp *interp;
     Command *cmdPtr;
-    BuiltinFuncDef *builtinFuncPtr;
+    const BuiltinFuncDef *builtinFuncPtr;
     const CmdInfo *cmdInfoPtr;
+    const CmdInfo2 *cmdInfo2Ptr;
     Tcl_Namespace *mathfuncNSPtr;
     union {
 	char c[sizeof(short)];
@@ -501,6 +516,12 @@ Tcl_CreateInterp(void)
 
     TclClockInit(interp);
 
+    for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
+	Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->objProc,
+		NULL, NULL);
+	Tcl_CreateObjCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->objProc,
+		NULL, NULL);
+    }
     /* TIP #208 */
     Tcl_CreateObjCommand(interp, "::tcl::chan::Truncate",
 	    TclChanTruncateObjCmd, (ClientData) NULL, NULL);
@@ -632,6 +653,7 @@ TclHideUnsafeCommands(
     Tcl_Interp *interp)		/* Hide commands in this interpreter. */
 {
     register const CmdInfo *cmdInfoPtr;
+    register const CmdInfo2 *cmdInfo2Ptr;
 
     if (interp == NULL) {
 	return TCL_ERROR;
@@ -641,6 +663,12 @@ TclHideUnsafeCommands(
 	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
 	}
     }
+    for (cmdInfo2Ptr=builtInCmds2; cmdInfo2Ptr->name!=NULL; cmdInfo2Ptr++) {
+	if (!cmdInfo2Ptr->isSafe) {
+	    Tcl_HideCommand(interp, cmdInfo2Ptr->name, cmdInfo2Ptr->name);
+	    Tcl_HideCommand(interp, cmdInfo2Ptr->name2, cmdInfo2Ptr->name2);
+	}
+    }
     return TCL_OK;
 }
 
diff --git a/library/init.tcl b/library/init.tcl
index 1c7a3a9..13f6d96 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
 # Default system startup file for Tcl-based applications.  Defines
 # "unknown" procedure and auto-load facilities.
 #
-# RCS: @(#) $Id: init.tcl,v 1.88 2006/11/03 00:34:52 hobbs Exp $
+# RCS: @(#) $Id: init.tcl,v 1.89 2006/11/20 14:28:03 dkf Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -79,21 +79,21 @@ namespace eval tcl {
     namespace eval chan {
         # TIP #219. Added methods: create, postevent.
         namespace ensemble create -command ::chan -map {
-            blocked     ::fblocked
-            close       ::close
-            configure   ::fconfigure
-            copy        ::fcopy
+            blocked     ::tcl::chan::blocked
+            close       ::tcl::chan::close
+            configure   ::tcl::chan::configure
+            copy        ::tcl::chan::copy
             create      ::tcl::chan::rCreate
-            eof         ::eof
-            event       ::fileevent
-            flush       ::flush
-            gets        ::gets
+            eof         ::tcl::chan::eof
+            event       ::tcl::chan::event
+            flush       ::tcl::chan::flush
+            gets        ::tcl::chan::gets
             names       {::file channels}
             postevent   ::tcl::chan::rPostevent
-            puts        ::puts
-            read        ::read
-            seek        ::seek
-            tell        ::tell
+            puts        ::tcl::chan::puts
+            read        ::tcl::chan::read
+            seek        ::tcl::chan::seek
+            tell        ::tcl::chan::tell
             truncate    ::tcl::chan::Truncate
         }
     }