Add support for ./configure --disable-introspection

Sometimes it can be useful to provide an embedded interpreter
where introspection is not permitted.
This includes:

- info commands, procs, channels: only allow exact match, not glob pattern
- info frame: don't include cmd and proc in the returned dict
- info level: only return the command name, not the command arguments
- info body, args, statics: do not allow these to be called

Signed-off-by: Steve Bennett <steveb@workware.net.au>

3 files changed, 39 insertions, 13 deletions

diff --git a/auto.def b/auto.def
index 3fcf884..dc31fab 100644
--- a/auto.def
+++ b/auto.def
@@ -35,6 +35,7 @@ options {
     docdir:path     => "Path to install docs (if built)"
     random-hash     => "Randomise hash tables. more secure but hash table results are not predicable"
     coverage        => "Build with code coverage support"
+    introspection=1 => "Disable introspection"
     with-jim-ext: {with-ext:"ext1,ext2,..."} => {
         Specify additional Jim extensions to include.
         Use --extinfo to show information about available extensions.
@@ -475,6 +476,10 @@ if {[opt-bool compat]} {
     msg-result "Enabling compatibility mode"
     define JIM_COMPAT
 }
+if {![opt-bool introspection]} {
+    msg-result "Disabling introspection"
+    define JIM_NO_INTROSPECTION
+}
 if {[opt-bool shared with-jim-shared]} {
     msg-result "Building shared library"
 } else {
diff --git a/jim.c b/jim.c
index f4fd955..9059f48 100644
--- a/jim.c
+++ b/jim.c
@@ -11912,7 +11912,12 @@ static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr,
             int plen, slen;
             const char *pattern = Jim_GetStringNoQualifier(patternObj, &plen);
             const char *str = Jim_GetStringNoQualifier(keyObj, &slen);
+#ifdef JIM_NO_INTROSPECTION
+            /* Only exact match supported with no introspection */
+            match = (JimStringCompareUtf8(pattern, plen, str, slen, 0) == 0);
+#else
             match = JimGlobMatch(pattern, plen, str, slen, 0);
+#endif
         }
         if (match) {
             Jim_ListAppendElement(interp, listObjPtr, keyObj);
@@ -11974,7 +11979,12 @@ static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr, Jim_Obj **objP
     if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) {
         Jim_CallFrame *targetCallFrame = JimGetCallFrameByInteger(interp, level);
         if (targetCallFrame && targetCallFrame != interp->topFramePtr) {
+#ifdef JIM_NO_INTROSPECTION
+            /* Only return the command, not the args */
+            *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, 1);
+#else
             *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc);
+#endif
             return JIM_OK;
         }
     }
@@ -11992,7 +12002,6 @@ static int JimInfoFrame(Jim_Interp *interp, Jim_Obj *levelObjPtr, Jim_Obj **objP
             Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
             int linenr;
             Jim_Obj *fileNameObj;
-            Jim_Obj *cmdObj;
             /*Jim_EvalFrame *procEvalFrame;*/
 
             Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "type", -1));
@@ -12006,19 +12015,25 @@ static int JimInfoFrame(Jim_Interp *interp, Jim_Obj *levelObjPtr, Jim_Obj **objP
                 Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "file", -1));
                 Jim_ListAppendElement(interp, listObj, fileNameObj);
             }
-            cmdObj = Jim_NewListObj(interp, targetEvalFrame->argv, targetEvalFrame->argc);
-
-            Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "cmd", -1));
-            Jim_ListAppendElement(interp, listObj, cmdObj);
-            /* Look in parent frames for a proc name */
-            Jim_EvalFrame *p;
-            for (p = targetEvalFrame->parent; p ; p = p->parent) {
-                if (p->cmd && p->cmd->isproc) {
-                    Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "proc", -1));
-                    Jim_ListAppendElement(interp, listObj, p->cmd->cmdNameObj);
-                    break;
+#ifndef JIM_NO_INTROSPECTION
+            {
+                Jim_Obj *cmdObj;
+                /* Omit the command and proc */
+                cmdObj = Jim_NewListObj(interp, targetEvalFrame->argv, targetEvalFrame->argc);
+
+                Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "cmd", -1));
+                Jim_ListAppendElement(interp, listObj, cmdObj);
+                /* Look in parent frames for a proc name */
+                Jim_EvalFrame *p;
+                for (p = targetEvalFrame->parent; p ; p = p->parent) {
+                    if (p->cmd && p->cmd->isproc) {
+                        Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "proc", -1));
+                        Jim_ListAppendElement(interp, listObj, p->cmd->cmdNameObj);
+                        break;
+                    }
                 }
             }
+#endif
             Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "level", -1));
             Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, interp->framePtr->level - targetEvalFrame->callFrameLevel));
 
@@ -15718,12 +15733,18 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
                     return JIM_ERR;
                 }
                 switch (cmd) {
+#ifdef JIM_NO_INTROSPECTION
+                    default:
+                        Jim_SetResultString(interp, "unsupported", -1);
+                        return JIM_ERR;
+#else
                     case INFO_BODY:
                         Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr);
                         break;
                     case INFO_ARGS:
                         Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr);
                         break;
+#endif
                     case INFO_STATICS:
                         if (cmdPtr->u.proc.staticVars) {
                             Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars,
diff --git a/tclcompat.tcl b/tclcompat.tcl
index e0f4070..3485d00 100644
--- a/tclcompat.tcl
+++ b/tclcompat.tcl
@@ -9,7 +9,7 @@
 set env [env]
 
 # Provide Tcl-compatible I/O commands
-if {[info commands stdout] ne ""} {
+if {[exists -command stdout]} {
 	# Tcl-compatible I/O commands
 	foreach p {gets flush close eof seek tell} {
 		proc $p {chan args} {p} {