starkit symlink fix, bump to 1.3.1

diff --git a/ChangeLog b/ChangeLog
index 082dfdf6e68192bbb675e4e9719793bd9a25eb30..1d9beb65e38b5c84a22d3343b3b375116f0d372d 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,11 +1,19 @@
+2004-05-19  Jean-Claude Wippler  <jcw@equi4.com>
+
+       * 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 <das@users.sourceforge.net>
 
-        * 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 <vincentdarley@sourceforge.net>
 
-        * 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 dfc587a3901a0563c7b8dfdd8e305361f708bc85..ecb959c49593aa0b7321836a87ffef31663e16f0 100644 (file)
--- 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 9536a30c2807433694842142c3e6b8873bc2fa23..a7738354cdf399c992457de77305ce55c7d5bd64 100644 (file)
--- 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