Make zipfs inaccessible to safe interps. See bug [a47b587499]

5 files changed, 22 insertions, 16 deletions

diff --git a/doc/interp.n b/doc/interp.n
index 74745be..36eb99b 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -652,7 +652,7 @@ creates a safe interpreter:
 \fBcd\fR	\fBencoding\fR	\fBexec\fR	\fBexit\fR
 \fBfconfigure\fR	\fBfile\fR	\fBglob\fR	\fBload\fR
 \fBopen\fR	\fBpwd\fR	\fBsocket\fR	\fBsource\fR
-\fBunload\fR
+\fBunload\fR	\fBzipfs\fR
 .DE
 These commands can be recreated later as Tcl procedures or aliases, or
 re-exposed by \fBinterp expose\fR.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7f8d68c..7dece25 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -463,7 +463,15 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
     {"process", "status"},
     {"process", "purge"},
     {"process", "autopurge"},
-    /* [zipfs] has MANY unsafe commands! */
+    /* 
+     * [zipfs] perhaps has some safe commands. But like file make it inaccessible
+     * until they are analyzed to be safe.
+     */
+    {"zipfs", NULL},
+    {"zipfs", "canonical"},
+    {"zipfs", "exists"},
+    {"zipfs", "info"},
+    {"zipfs", "list"},
     {"zipfs", "lmkimg"},
     {"zipfs", "lmkzip"},
     {"zipfs", "mkimg"},
@@ -471,6 +479,7 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
     {"zipfs", "mkzip"},
     {"zipfs", "mount"},
     {"zipfs", "mount_data"},
+    {"zipfs", "root"},
     {"zipfs", "unmount"},
     {NULL, NULL}
 };
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
index 11d41bf..6e248a3 100644
--- a/generic/tclZipfs.c
+++ b/generic/tclZipfs.c
@@ -6206,12 +6206,11 @@ TclZipfs_Init(
 	{"mount_data",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
 	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
 	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
-	/* The 8 entries above are not available in safe interpreters */
-	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 0},
-	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 0},
-	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 0},
-	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 0},
-	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 0},
+	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 1},
+	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 1},
+	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 1},
+	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 1},
+	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 1},
 	{NULL, NULL, NULL, NULL, NULL, 0}
     };
     static const char findproc[] =
diff --git a/tests/interp.test b/tests/interp.test
index 05c987c..dc424dd 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -20,7 +20,7 @@ catch [list package require -exact tcl::test [info patchlevel]]
 
 testConstraint testinterpdelete [llength [info commands testinterpdelete]]
 
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system 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:home 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:tempdir tcl:file:tempfile tcl:file:tildeexpand tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
+set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system 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:home 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:tempdir tcl:file:tempfile tcl:file:tildeexpand tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:canonical tcl:zipfs:exists tcl:zipfs:info tcl:zipfs:list tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:root tcl:zipfs:unmount unload zipfs}
 
 proc _ms_limit_args {ms {t0 {}}} {
     if {$t0 eq {}} { set t0 [clock milliseconds] }
diff --git a/tests/zipfs.test b/tests/zipfs.test
index 3d583c7..290b3e7 100644
--- a/tests/zipfs.test
+++ b/tests/zipfs.test
@@ -27,9 +27,6 @@ set CWD [pwd]
 set tmpdir  [file join $CWD tmp]
 file mkdir $tmpdir
 
-test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
-    package require tcl::zipfs
-} -result {2.0}
 test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
     expr {${ziproot} in [file volumes]}
 } -result 1
@@ -229,16 +226,17 @@ test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup {
     }
 } -returnCodes error -cleanup {
     interp delete $safe
-} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
-test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup {
+} -result {invalid command name "zipfs"}
+
+test zipfs-3.4 {zipfs in safe interpreters} -constraints zipfs -setup {
     set safe [interp create -safe]
 } -body {
     interp eval $safe {
-	zipfs mkzip
+	zipfs
     }
 } -returnCodes error -cleanup {
     interp delete $safe
-} -result {not allowed to invoke subcommand mkzip of zipfs}
+} -result {invalid command name "zipfs"}
 
 test zipfs-4.1 {zipfs lmkimg} -constraints zipfs -setup {
     set baseImage [makeFile "return sourceWorking\n\x1A" base]