From: Jean-Claude Wippler <jcw@equi4.com>
Date: Wed, 19 May 2004 20:46:17 +0000 (+0000)
Subject: starkit symlink fix, bump to 1.3.1
X-Git-Tag: vfs-1-4~100
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=6bfe1939c253c345f00fe81c00bb5dcaefab19ff;p=tclvfs

starkit symlink fix, bump to 1.3.1
---

diff --git a/ChangeLog b/ChangeLog
index 082dfdf..1d9beb6 100644
--- 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 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