From: Vince Darley <vincentdarley@sourceforge.net>
Date: Tue, 4 Feb 2003 18:54:39 +0000 (+0000)
Subject: VfsFullyNormalizePath fix
X-Git-Tag: vfs-1-2
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=e5d74b4a8b08d171b8e34c449499e8b495880fd8;p=tclvfs

VfsFullyNormalizePath fix
---

diff --git a/ChangeLog b/ChangeLog
index 096b565..c9d5b16 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,10 @@
-2003-01-28  Vince Darley <vincentdarley@sourceforge.net>
+2003-02-04  Vince Darley <vincentdarley@sourceforge.net>
+
+	* generic/vfs.c: fixed version of VfsFullyNormalizePath,
+	should resolve some problems with symlinks. Tcl really needs
+	a 'file normalized -full' and equivalent C api.
+	
+2003-02-04  Vince Darley <vincentdarley@sourceforge.net>
 
 	* tests/*.test: cleanup
 	
diff --git a/generic/vfs.c b/generic/vfs.c
index 8ba028f..f49ee02 100644
--- a/generic/vfs.c
+++ b/generic/vfs.c
@@ -801,6 +801,39 @@ VfsFullyNormalizePath(Tcl_Interp *interp, Tcl_Obj *pathPtr) {
 	if (path == NULL) {
 	    break;
 	}
+	if (Tcl_FSGetPathType(path) != TCL_PATH_ABSOLUTE) {
+	    /* 
+	     * This is more complex, we need to find the path
+	     * relative to the original file, effectively:
+	     * 
+	     *  file join [file dirname $pathPtr] $path
+	     *  
+	     * or 
+	     * 
+	     *  file join $pathPtr .. $path
+	     *  
+	     * So...
+	     */
+	    Tcl_Obj *dotdotPtr, *joinedPtr;
+	    Tcl_Obj *joinElements[2];
+	    
+	    dotdotPtr = Tcl_NewStringObj("..",2);
+	    Tcl_IncrRefCount(dotdotPtr);
+	    
+	    joinElements[0] = dotdotPtr;
+	    joinElements[1] = path;
+
+	    joinedPtr = Tcl_FSJoinToPath(pathPtr, 2, joinElements);
+	    
+	    if (joinedPtr != NULL) {
+		Tcl_IncrRefCount(joinedPtr);
+		Tcl_DecrRefCount(path);
+		path = joinedPtr;
+	    } else {
+		/* We failed, and our action is undefined */
+	    }
+	    Tcl_DecrRefCount(dotdotPtr);
+	}
 	Tcl_DecrRefCount(pathPtr);
 	pathPtr = path;
 	counter++;