summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2008-07-03 17:28:44 (GMT)
committerdgp <dgp@users.sourceforge.net>2008-07-03 17:28:44 (GMT)
commitcd7cb1f61d5ef41720805bb2fdb479a6e05e1ea4 (patch)
treeaddadf56adc39aab52cabc537fab11dbb07b82ba
parent349fc26e6c278e0d1de00458c76a113ae8425f88 (diff)
downloadtcl-cd7cb1f61d5ef41720805bb2fdb479a6e05e1ea4.zip
tcl-cd7cb1f61d5ef41720805bb2fdb479a6e05e1ea4.tar.gz
tcl-cd7cb1f61d5ef41720805bb2fdb479a6e05e1ea4.tar.bz2
* 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]
-rw-r--r--ChangeLog8
-rw-r--r--library/package.tcl40
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