[Bug 2964715]: fixes to globbing in safe interpreters

1 files changed, 30 insertions, 17 deletions

diff --git a/library/safe.tcl b/library/safe.tcl
index 8a99032..1a340a1 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -491,7 +491,8 @@ proc ::safe::InterpInit {
     # now, after tm.tcl was loaded.
     namespace upvar ::safe S$slave state
     if {[llength $state(tm_path_slave)] > 0} {
-	::interp eval $slave [list ::tcl::tm::add {*}$state(tm_path_slave)]
+	::interp eval $slave [list \
+		::tcl::tm::add {*}[lreverse $state(tm_path_slave)]]
     }
     return $slave
 }
@@ -670,9 +671,9 @@ proc ::safe::AliasGlob {slave args} {
     }
 
     if {$::tcl_platform(platform) eq "windows"} {
-	set dirPartRE {^(.*)[\\/]}
+	set dirPartRE {^(.*)[\\/]([^\\/]*)$}
     } else {
-	set dirPartRE {^(.*)/}
+	set dirPartRE {^(.*)/([^/]*)$}
     }
 
     set dir        {}
@@ -725,11 +726,10 @@ proc ::safe::AliasGlob {slave args} {
 	    DirInAccessPath $slave $dir
 	} msg]} {
 	    Log $slave $msg
-	    if {!$got(-nocomplain)} {
-		return -code error "permission denied"
-	    } else {
+	    if {$got(-nocomplain)} {
 		return
 	    }
+	    return -code error "permission denied"
 	}
 	lappend cmd -directory $dir
     }
@@ -741,19 +741,32 @@ proc ::safe::AliasGlob {slave args} {
 
     # Process remaining pattern arguments
     set firstPattern [llength $cmd]
-    while {$at < [llength $args]} {
-	set opt [lindex $args $at]
-	incr at
-	if {[regexp $dirPartRE $opt -> thedir] && [catch {
+    foreach opt [lrange $args $at end] {
+	if {![regexp $dirPartRE $opt -> thedir thefile]} {
+	    set thedir .
+	}
+	if {$thedir eq "*"} {
+	    set mapped 0
+	    foreach d [glob -directory [TranslatePath $slave $virtualdir] \
+			   -types d -tails *] {
+		catch {
+		    DirInAccessPath $slave \
+			[TranslatePath $slave [file join $virtualdir $d]]
+		    if {$thefile eq "pkgIndex.tcl" || $thefile eq "*.tm"} {
+			lappend cmd [file join $d $thefile]
+			set mapped 1
+		    }
+		}
+	    }
+	    if {$mapped} continue
+	}
+	if {[catch {
 	    set thedir [file join $virtualdir $thedir]
 	    DirInAccessPath $slave [TranslatePath $slave $thedir]
 	} msg]} {
 	    Log $slave $msg
-	    if {$got(-nocomplain)} {
-		continue
-	    } else {
-		return -code error "permission denied"
-	    }
+	    if {$got(-nocomplain)} continue
+	    return -code error "permission denied"
 	}
 	lappend cmd $opt
     }
@@ -770,7 +783,7 @@ proc ::safe::AliasGlob {slave args} {
 	return -code error "script error"
     }
 
-    Log $slave "GLOB @ $msg" NOTICE
+    Log $slave "GLOB < $msg" NOTICE
 
     # Translate path back to what the slave should see.
     set res {}
@@ -782,7 +795,7 @@ proc ::safe::AliasGlob {slave args} {
 	lappend res $p
     }
 
-    Log $slave "GLOB @ $res" NOTICE
+    Log $slave "GLOB > $res" NOTICE
     return $res
 }