Fix [Bug 2906841] and a few other smaller issues.

1 files changed, 25 insertions, 29 deletions

diff --git a/library/safe.tcl b/library/safe.tcl
index 662a727..8bc26f9 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: safe.tcl,v 1.33 2009/11/19 11:59:54 dkf Exp $
+# RCS: @(#) $Id: safe.tcl,v 1.34 2009/12/03 15:49:22 dkf Exp $
 
 #
 # The implementation is based on namespaces. These naming conventions are
@@ -651,7 +651,6 @@ proc ::safe::CheckFileName {slave file} {
 }
 
 # AliasGlob is the target of the "glob" alias in safe interpreters.
-
 proc ::safe::AliasGlob {slave args} {
     Log $slave "GLOB ! $args" NOTICE
     set cmd {}
@@ -663,30 +662,22 @@ proc ::safe::AliasGlob {slave args} {
     while {$at < [llength $args]} {
 	switch -glob -- [set opt [lindex $args $at]] {
 	    -nocomplain -
-	    -join       {
+	    -join {
 		lappend cmd $opt
 		incr at
 	    }
-	    -directory  {
-		lappend cmd $opt
-		incr at
-		set virtualdir [lindex $args $at]
-
-		# get the real path from the virtual one.
+	    -directory {
+		set virtualdir [lindex $args [incr at]]
+		# Get the real path from the virtual one and check that the
+		# path is in the access path of that slave.
 		try {
 		    set dir [TranslatePath $slave $virtualdir]
-		} on error msg {
-		    Log $slave $msg
-		    return -code error "permission denied"
-		}
-		# check that the path is in the access path of that slave
-		try {
 		    DirInAccessPath $slave $dir
 		} on error msg {
 		    Log $slave $msg
 		    return -code error "permission denied"
 		}
-		lappend cmd $dir
+		lappend cmd -directory $dir
 		incr at
 	    }
 	    pkgIndex.tcl {
@@ -701,6 +692,14 @@ proc ::safe::AliasGlob {slave args} {
 		return -code error "Safe base rejecting glob option '$opt'"
 	    }
 	    default {
+		if {[regexp {(.*)[\\/]} $opt -> thedir]} {
+		    try {
+			DirInAccessPath $slave [TranslatePath $slave $thedir]
+		    } on error msg {
+			Log $slave $msg
+			return -code error "permission denied"
+		    }
+		}
 		lappend cmd $opt
 		incr at
 	    }
@@ -928,18 +927,14 @@ proc ::safe::AliasSubset {slave alias target args} {
 
 # AliasEncoding is the target of the "encoding" alias in safe interpreters.
 
-proc ::safe::AliasEncoding {slave args} {
-    set argc [llength $args]
-
-    set okpat "^(name.*|convert.*)\$"
-    set subcommand [lindex $args 0]
-
-    if {[regexp $okpat $subcommand]} {
-	return [::interp invokehidden $slave encoding {*}$args]
+proc ::safe::AliasEncoding {slave option args} {
+    # Careful; do not want empty option to get through to the [string equal]
+    if {[regexp {^(name.*|convert.*|)$} $option]} {
+	return [::interp invokehidden $slave encoding $option {*}$args]
     }
 
-    if {[string first $subcommand system] == 0} {
-	if {$argc == 1} {
+    if {[string equal -length [string length $option] $option "system"]} {
+	if {[llength $args] == 0} {
 	    # passed all the tests , lets source it:
 	    try {
 		return [::interp invokehidden $slave encoding system]
@@ -949,16 +944,17 @@ proc ::safe::AliasEncoding {slave args} {
 	    }
 	}
 	set msg "wrong # args: should be \"encoding system\""
+	set code {TCL WRONGARGS}
     } else {
-	set msg "wrong # args: should be \"encoding option ?arg ...?\""
+	set msg "bad option \"$option\": must be convertfrom, convertto, names, or system"
+	set code [list TCL LOOKUP INDEX option $option]
     }
     Log $slave $msg
-    return -code error $msg
+    return -code error -errorcode $code $msg
 }
 
 
 proc ::safe::Setup {} {
-
     ####
     #
     # Setup the arguments parsing