--- original/library/tcl8.5/safe.tcl	2010-01-23 04:36:42.000000000 +0000
+++ patched/library/tcl8.5/safe.tcl	2010-03-10 16:13:18.000000000 +0000
@@ -337,11 +337,15 @@
 	incr i
     }
 
-    set morepaths [::tcl::tm::list]
+    # Reverse the list because ::tcl::tm::add adds to the head of the list.
+    set morepaths [lreverse [::tcl::tm::list]]
+    set firstpass 1
     while {[llength $morepaths]} {
 	set addpaths $morepaths
 	set morepaths {}
 
+	# Add each $dir to the access path if it is not already there.
+	# Set morepaths to the subdirectories of the $dir that are added.
 	foreach dir $addpaths {
 	    # Prevent the addition of dirs on the tm list to the
 	    # result if they are already known.
@@ -355,7 +359,12 @@
 	    lappend map_access_path    $token $dir
 	    lappend remap_access_path  $dir $token
 	    lappend norm_access_path   [file normalize $dir]
-	    lappend slave_tm_path $token
+	    if {$firstpass} {
+		# $dir is in [::tcl::tm::list] and belongs in the slave_tm_path.
+		# Later passes handle subdirectories, which belong in the
+		# access path but not in the module path.
+		lappend slave_tm_path  $token
+	    }
 	    incr i
 
 	    # [Bug 2854929]
@@ -366,6 +375,7 @@
 	    # subdirectories.
 	    lappend morepaths {*}[glob -nocomplain -directory $dir -type d *]
 	}
+	set firstpass 0
     }
 
     set state(access_path)       $access_path
@@ -658,9 +668,69 @@
     }
 }
 
+
+# Description of alterations to ::safe::AliasGlob from core-8-5-branch v 1.16.4.6
+#
+# (1) - add a comment header
+# (2) - change test for "pkgIndex.tcl" and move it so that it is effective
+# (3) - give a meaningful error message if pkgIndex.tcl is detected
+# (4) - give a meaningful error message if -directory is used twice
+# (5) - supply a value for dir in cmd
+# (6) - require option -directory
+#       - This is a change to the (undocumented) behaviour of the exposed glob
+#         command.
+#       - The change is compatible with the required use cases for tm.tcl and
+#         (if the pkgIndex.tcl test is removed in future) package.tcl.
+#       - It is a good fit to the Safe Base idea that operations are permitted
+#         only in certain directories.
+
+# Further Alterations against {core-8-5-branch v 1.16.4.6 patched by safe.tcl.patch, safe.tcl.patch2}
+#  (7) Reverse (4) - use the same misleading error message as glob itself
+#  (8) -nocomplain protects against error return if there are no matches; it
+#      should not protect against errors in arguments, e.g. no pattern
+#  (9) - therefore we can move the test of -directory back into the
+#        argument-processing loop
+# (10) Return a specific error message for option -path
+# (11) Give a standard error message for invalid arguments other than -path
+# (12) There is no requirement for -join (if present) to be the last argument
+# (13) Remove the test that the directory part of a (compounded) glob pattern
+#      belongs to the access path.  Instead, test whether each result of the
+#      glob belongs to a directory in the access path.  The reason is that the
+#      DirInAccessPath test fails for a directory that has a glob wildcard.
+# (14) - therefore we do not need to do the pattern -join here - let glob do it
+
+
+# ------------------------------------------------------------------------------
+#  Proc ::safe::AliasGlob
+# ------------------------------------------------------------------------------
 # AliasGlob is the target of the "glob" alias in safe interpreters.
+#
+# This command provides a restricted form of glob that a safe interpreter
+# requires to handle Tcl Modules. See tm.tcl, proc ::tcl::tm::UnknownHandler.
+#
+# The restricted glob must use the -directory option (which must supply a
+# directory in the slave's access path), and returns only files and directories
+# whose parent directory belongs to the access_path.
+#
+# Restrictions cf. standard glob:
+# (1) option -path      is not allowed
+# (2) option -directory must be supplied and must be a directory in the safe
+#                       interpreter's access path.
+# (3) Final argument must not be "pkgIndex.tcl".  This restriction is a kludge
+#     to prevent the existence of "safe" glob from breaking tclPkgUnknown.
+# ------------------------------------------------------------------------------
+
 proc ::safe::AliasGlob {slave args} {
     Log $slave "GLOB ! $args" NOTICE
+
+    if {[lindex $args end] eq "pkgIndex.tcl"} {
+	# Oops, this is globbing a subdirectory in regular package
+	# search. That is not wanted. Abort, handler does catch
+	# already (because glob was not defined before). See
+	# package.tcl, lines 484ff in tclPkgUnknown.
+	return -code error "Safe base rejecting glob call apparently from tclPkgUnknown"
+    }
+
     set cmd {}
     set at 0
     array set got {
@@ -671,12 +741,6 @@
 	-- 0
     }
 
-    if {$::tcl_platform(platform) eq "windows"} {
-	set dirPartRE {^(.*)[\\/]}
-    } else {
-	set dirPartRE {^(.*)/}
-    }
-
     set dir        {}
     set virtualdir {}
 
@@ -692,6 +756,7 @@
 		incr at
 	    }
 	    -directory {
+		# Use the same misleading error message as glob:
 		if {$got($opt)} {
 		    return -code error \
 			{"-directory" cannot be used with "-path"}
@@ -699,72 +764,50 @@
 		set got($opt) 1
 		set virtualdir [lindex $args [incr at]]
 		incr at
+
+		# Get the real path from the virtual one and check that the path
+		# is in the access path of that slave.
+		if {[catch {
+		    set dir [TranslatePath $slave $virtualdir]
+		    DirInAccessPath $slave $dir
+		} msg]} {
+		    Log $slave $msg
+		    return -code error {directory is not in the access path}
+		}
+
 		lappend cmd -directory $dir
 	    }
-	    pkgIndex.tcl {
-		# Oops, this is globbing a subdirectory in regular package
-		# search. That is not wanted. Abort, handler does catch
-		# already (because glob was not defined before). See
-		# package.tcl, lines 484ff in tclPkgUnknown.
-		return -code error "unknown command glob"
+	    -path {
+		Log $slave {Safe Base does not allow glob option "-path"}
+		return -code error {Safe Base does not allow glob option "-path"}
 	    }
 	    -* {
-		Log $slave "Safe base rejecting glob option '$opt'"
-		return -code error "Safe base rejecting glob option '$opt'"
+		Log $slave "bad option \"$opt\": must be -directory, -join, -nocomplain, -tails, -types, or --"
+		return -code error "bad option \"$opt\": must be -directory, -join, -nocomplain, -tails, -types, or --"
 	    }
 	    default {
 		break
 	    }
 	}
-	if {$got(--) || $got(-join)} break
-    }
-
-    # Get the real path from the virtual one and check that the path is in the
-    # access path of that slave. Done after basic argument processing so that
-    # we know if -nocomplain is set.
-    if {$got(-directory)} {
-	if {[catch {
-	    set dir [TranslatePath $slave $virtualdir]
-	    DirInAccessPath $slave $dir
-	} msg]} {
-	    Log $slave $msg
-	    if {!$got(-nocomplain)} {
-		return -code error "permission denied"
-	    } else {
-		return
-	    }
-	}
+	if {$got(--)} break
     }
 
-    # Apply the -join semantics ourselves
-    if {$got(-join)} {
-	set args [lreplace $args $at end [join [lrange $args $at end] "/"]]
+    if {!$got(-directory)} {
+	return -code error {when glob is used in the Safe Base, option "-directory" must be specified}
     }
 
     # 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 {
-	    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"
-	    }
-	}
-	lappend cmd $opt
+    set pattern [lrange $args $at end]
+    set cmd [concat $cmd $pattern]
+
+    # We could let glob raise this error, but this message is more helpful
+    # than our rewritten message "script error".
+    if {[llength $pattern] == 0} {
+	return -code error {wrong # args: should be "glob ?switches? name ?name ...?"}
     }
 
     Log $slave "GLOB = $cmd" NOTICE
 
-    if {$got(-nocomplain) && [llength $cmd] eq $firstPattern} {
-	return
-    }
     if {[catch {
 	::interp invokehidden $slave glob {*}$cmd
     } msg]} {
@@ -778,16 +821,62 @@
     set res {}
     set l [string length $dir]
     foreach p $msg {
+	# Return only results that are in the access path.
+	# Normalize because [dirname foo/..] is "foo".
+	if {[catch {
+	    DirInAccessPath $slave [file dirname [file normalize $p]]
+	}]} {
+	    continue
+	}
 	if {[string equal -length $l $dir $p]} {
 	    set p [string replace $p 0 [expr {$l-1}] $virtualdir]
+	    lappend res $p
+	} else {
+	    # Something's gone wrong: $p has not been normalized and so should
+	    # always begin with $dir.
+	    return -code error "error handling glob results"
 	}
-	lappend res $p
     }
 
+    # A non-empty result list $msg might have had all its members removed.
+    if {($res eq {}) && (!$got(-nocomplain))} {
+	# E.g. {no files matched glob pattern "foo"}
+	return -code error [GlobErrorText $got(-join) $pattern]
+    }
     Log $slave "GLOB @ $res" NOTICE
     return $res
 }
 
+
+# ------------------------------------------------------------------------------
+#  Proc ::safe::GlobErrorText
+# ------------------------------------------------------------------------------
+# Command to return a suitable error message for use by AliasGlob, for the case
+# when there are no matches in the access path.
+#
+# Arguments:
+# gotJoin     - (boolean) whether glob was called with option -join
+# pattern     - list of pattern arguments supplied to glob
+#
+# Return Value: an error message
+# ------------------------------------------------------------------------------
+
+proc ::safe::GlobErrorText {gotJoin pattern} {
+    if {$gotJoin} {
+	set errorPattern [join $pattern /]
+	set numPat 1
+    } else {
+	set errorPattern $pattern
+	set numPat [llength $pattern]
+    }
+    if {$numPat > 1} {
+	set errorWord patterns
+    } else {
+	set errorWord pattern
+    }
+    return "no files matched glob $errorWord \"$errorPattern\""
+}
+
 # AliasSource is the target of the "source" alias in safe interpreters.
 
 proc ::safe::AliasSource {slave args} {
@@ -1107,7 +1196,7 @@
     # access_path,slave : Ditto, as the path tokens as seen by the slave.
     # access_path,map   : dict ( token -> path )
     # access_path,remap : dict ( path -> token )
-    # tm_path_slave     : List of TM root directories, as tokens seen by the slave.
+    # tm_path_slave     : List of TM module paths, as tokens seen by the slave.
     # staticsok         : Value of option -statics
     # nestedok          : Value of option -nested
     # cleanupHook       : Value of option -deleteHook
