* library/package.tcl: Removed [file readable] testing from

        [tclPkgUnknown] and friends.  We find out soon enough whether a
        file is readable when we try to [source] it, and not testing
        before allows us to workaround the bugs on some common filesystems
        where [file readable] lies to us.  [Patch 1969717]

2 files changed, 37 insertions, 11 deletions

diff --git a/ChangeLog b/ChangeLog
index 3767add..585305b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2008-07-03  Don Porter  <dgp@users.sourceforge.net>
+
+	* library/package.tcl:  Removed [file readable] testing from
+	[tclPkgUnknown] and friends.  We find out soon enough whether a
+	file is readable when we try to [source] it, and not testing
+	before allows us to workaround the bugs on some common filesystems
+	where [file readable] lies to us.  [Patch 1969717]
+
 2008-07-01  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/regc_nfa.c (duptraverse): Impose a maximum stack depth on
diff --git a/library/package.tcl b/library/package.tcl
index 64197f7..56dccd0 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -3,7 +3,7 @@
 # utility procs formerly in init.tcl which can be loaded on demand
 # for package management.
 #
-# RCS: @(#) $Id: package.tcl,v 1.35 2006/11/03 00:34:52 hobbs Exp $
+# RCS: @(#) $Id: package.tcl,v 1.36 2008/07/03 17:28:46 dgp Exp $
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1998 Sun Microsystems, Inc.
@@ -485,8 +485,15 @@ proc tclPkgUnknown {name args} {
 	    foreach file [glob -directory $dir -join -nocomplain \
 		    * pkgIndex.tcl] {
 		set dir [file dirname $file]
-		if {![info exists procdDirs($dir)] && [file readable $file]} {
-		    if {[catch {source $file} msg]} {
+		if {![info exists procdDirs($dir)]} {
+		    set code [catch {source $file} msg opt]
+		    if {$code == 1 &&
+			    [lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
+			    [lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
+			# $file was not readable; silently ignore
+			continue
+		    }
+		    if {$code} {
 			tclLog "error reading package index file $file: $msg"
 		    } else {
 			set procdDirs($dir) 1
@@ -497,10 +504,16 @@ proc tclPkgUnknown {name args} {
 	set dir [lindex $use_path end]
 	if {![info exists procdDirs($dir)]} {
 	    set file [file join $dir pkgIndex.tcl]
-	    # safe interps usually don't have "file readable", 
-	    # nor stderr channel
-	    if {([interp issafe] || [file readable $file])} {
-		if {[catch {source $file} msg] && ![interp issafe]}  {
+	    # safe interps usually don't have "file exists", 
+	    if {([interp issafe] || [file exists $file])} {
+		set code [catch {source $file} msg opt]
+		if {$code == 1 &&
+			[lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
+			[lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
+		    # $file was not readable; silently ignore
+		    continue
+		}
+		if {$code}  {
 		    tclLog "error reading package index file $file: $msg"
 		} else {
 		    set procdDirs($dir) 1
@@ -546,8 +559,6 @@ proc tclPkgUnknown {name args} {
 # This procedure extends the "package unknown" function for MacOSX.
 # It scans the Resources/Scripts directories of the immediate children
 # of the auto_path directories for pkgIndex files.
-# Only installed in interps that are not safe so we don't check
-# for [interp issafe] as in tclPkgUnknown.
 #
 # Arguments:
 # original -		original [package unknown] procedure
@@ -583,8 +594,15 @@ proc tcl::MacOSXPkgUnknown {original name args} {
 	foreach file [glob -directory $dir -join -nocomplain \
 		* Resources Scripts pkgIndex.tcl] {
 	    set dir [file dirname $file]
-	    if {![info exists procdDirs($dir)] && [file readable $file]} {
-		if {[catch {source $file} msg]} {
+	    if {![info exists procdDirs($dir)]} {
+		set code [catch {source $file} msg opt]
+		if {$code == 1 &&
+			[lindex [dict get $opt -errorcode] 0] eq "POSIX" &&
+			[lindex [dict get $opt -errorcode] 1] eq "EACCES"} {
+		    # $file was not readable; silently ignore
+		    continue
+		}
+		if {$code} {
 		    tclLog "error reading package index file $file: $msg"
 		} else {
 		    set procdDirs($dir) 1