From 6bfe1939c253c345f00fe81c00bb5dcaefab19ff Mon Sep 17 00:00:00 2001 From: Jean-Claude Wippler Date: Wed, 19 May 2004 20:46:17 +0000 Subject: [PATCH] starkit symlink fix, bump to 1.3.1 --- ChangeLog | 12 +++++++-- library/pkgIndex.tcl | 2 +- library/starkit.tcl | 61 ++++++++++++++++++++++++++++++++++++++------ 3 files changed, 64 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index 082dfdf..1d9beb6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,11 +1,19 @@ +2004-05-19 Jean-Claude Wippler + + * starkit.tcl: added a patch from Bryan Schofield to properly + resolve all symbolic links so starkit::startup detection works. + * pkgIndex.tcl: bumped starkit version from 1.3 to 1.3.1 + + * ChangeLog: cleaned up a few tab-vs-space indentations + 2004-04-18 Daniel Steffen - * generic/vfs.c: continue to #include tclPort.h, otherwise + * generic/vfs.c: continue to #include tclPort.h, otherwise compilation breaks against tcl 8.4.x. 2004-04-01 Vince Darley - * generic/vfs.c: added #include tclInt.h given recent Tcl + * generic/vfs.c: added #include tclInt.h given recent Tcl changes which broke compilation. Fix to privately reported vfs bug with 'glob -type d -dir . *' diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl index dfc587a..ecb959c 100644 --- a/library/pkgIndex.tcl +++ b/library/pkgIndex.tcl @@ -45,7 +45,7 @@ proc loadvfs {dir dll} { } package ifneeded vfs 1.3.0 [list loadvfs $dir $dll] -package ifneeded starkit 1.3 [list source [file join $dir starkit.tcl]] +package ifneeded starkit 1.3.1 [list source [file join $dir starkit.tcl]] package ifneeded vfslib 1.3.1 [list source [file join $dir vfslib.tcl]] # Old diff --git a/library/starkit.tcl b/library/starkit.tcl index 9536a30..a773835 100644 --- a/library/starkit.tcl +++ b/library/starkit.tcl @@ -1,7 +1,7 @@ # Starkit support, see http://www.equi4.com/starkit/ # by Jean-Claude Wippler, July 2002 -package provide starkit 1.3 +package provide starkit 1.3.1 # Starkit scripts can launched in a number of ways: # - wrapped or unwrapped @@ -40,6 +40,47 @@ namespace eval starkit { package require ${driver}vfs eval [list ::vfs::${driver}::Mount $self $self] $args + + + # resolveFile -- + # + # Resolves the filename to an absolute path with no links anywhere in + # the file name or directories in the file path. + # B.Schofield 19 May 2004 + # + # Arguments: + # filename - a file name + # Results: + # absolute file path + # + proc resolveFile {filename} { + # remember where we are, we'll be changing directories and will need to + # restore the current working directory + set cwd [pwd] + + # If the filename is a link, we'll need to follow it. Hopefully, the + # link doesn't point to another link... + if {[file type $filename] eq "link"} { + # we'd better change to directory where the link is, or our + # normalize might give an incorrect result + cd [file dirname $filename] + set filename [file readlink $filename] + } + + # normalize the file name to get a good guess as to where the file is + set filename [file normalize $filename] + # change to it's parent directory so we know exactly where it is. + cd [file dirname $filename] + # resolve all links that might be in the path to the file. By using + # [pwd] in the file's directory, we'll remove all links in the path + set filename [file join [pwd] [file tail $filename]] + # return to the directory where we started + cd $cwd + # now give back one link free, full path to the file + return $filename + } + + uplevel [list source [file join $self main.tcl]] }]} { panic $::errorInfo @@ -61,16 +102,20 @@ namespace eval starkit { # 2003/02/11: new behavior, if starkit::topdir exists, don't disturb it if {![info exists starkit::topdir]} { variable topdir } - set script [file normalize [info script]] - set topdir [file dirname $script] + # 2004/05/19: added "resolveFile" calls instead of "file normalize" to + # remove any links in the paths to the file names, which were causing + # this method to return in correct start up modes. + set script [resolveFile [info script]] + set topdir [resolveFile [file dirname $script]] + set noe [resolveFile [info nameofexe]] - if {$topdir eq [file normalize [info nameofexe]]} { return starpack } + if {$topdir eq [file normalize $noe]} { return starpack } # pkgs live in the $topdir/lib/ directory - set lib [file join $topdir lib] + set lib [resolveFile [file join $topdir lib]] if {[file isdir $lib]} { autoextend $lib } - set a0 [file normalize $argv0] + set a0 [resolveFile $argv0] if {$topdir eq $a0} { return starkit } if {$script eq $a0} { return unwrapped } @@ -82,8 +127,8 @@ namespace eval starkit { # detect when run as an NT service if {[info exists ::tcl_service]} { return service } - - return sourced + + return sourced } # append an entry to auto_path if it's not yet listed -- 2.23.0