fix to file normalization with relative links

7 files changed, 183 insertions, 47 deletions

diff --git a/ChangeLog b/ChangeLog
index 04e90eb..9db7bd5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,17 @@
 2003-12-17  Vince Darley  <vincentdarley@users.sourceforge.net>
 
+	* generic/tclCmdAH.c: 
+	* unix/tclUnixFile.c: 
+	* win/tclWinFCmd.c: 
+	* tests/fCmd.test: 
+	* tests/fileSystem.test: 
+	* doc/file.n: final fix to support for relative links and
+	its implications on normalization and other parts of the
+	filesystem code.  Fixes [Bug 859251] and some Windows
+	problems with recursive file delete/copy and symbolic links.
+	
+2003-12-17  Vince Darley  <vincentdarley@users.sourceforge.net>
+
 	* generic/tclPathObj.c: 
 	* tests/fileSystem.test: fix and tests for [Bug 860402] in new 
 	file normalization code.
diff --git a/doc/file.n b/doc/file.n
index 0658009..f119a83 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\" 
-'\" RCS: @(#) $Id: file.n,v 1.26 2003/12/12 17:02:13 vincentdarley Exp $
+'\" RCS: @(#) $Id: file.n,v 1.27 2003/12/17 17:47:28 vincentdarley Exp $
 '\" 
 .so man.macros
 .TH file n 8.3 Tcl "Tcl Built-In Commands"
@@ -206,30 +206,34 @@ If only one argument is given, that argument is assumed to be
 seems to be the case with hard links, which look just like ordinary
 files), then an error is returned.
 .
-If 2 arguments are given, then these are assumed to be \fIlinkName\fR and
-\fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR
+If 2 arguments are given, then these are assumed to be \fIlinkName\fR
+and \fItarget\fR. If \fIlinkName\fR already exists, or if \fItarget\fR
 doesn't exist, an error will be returned.  Otherwise, Tcl creates a new
-link called \fIlinkName\fR which points to the existing filesystem object
-at \fItarget\fR, where the type of the link is platform-specific (on Unix
-a symbolic link will be the default).  This is useful for the case where
-the user wishes to create a link in a cross-platform way, and doesn't
-care what type of link is created.
+link called \fIlinkName\fR which points to the existing filesystem
+object at \fItarget\fR (which is also the returned value), where the
+type of the link is platform-specific (on Unix a symbolic link will be
+the default).  This is useful for the case where the user wishes to
+create a link in a cross-platform way, and doesn't care what type of
+link is created.
 .
 If the user wishes to make a link of a specific type only, (and signal an
 error if for some reason that is not possible), then the optional
 \fI-linktype\fR argument should be given.  Accepted values for
 \fI-linktype\fR are "-symbolic" and "-hard".
 .
-On Unix, symbolic links can be made to relative paths, but on all other
-platforms target paths will be converted to absolute, normalized form
-before the link is created (and "~user" paths are always expanded to
-absolute form).  When creating links on filesystems that
-either do not support any links, or do not support the specific type
-requested, an error message will be returned.  In particular Windows 95,
-98 and ME do not support any links at present, but most Unix platforms
-support both symbolic and hard links (the latter for files only), MacOS
-supports symbolic links and Windows NT/2000/XP (on NTFS drives) support
-symbolic directory links and hard file links.
+On Unix, symbolic links can be made to relative paths, and those paths
+must be relative to the actual \fIlinkName\fR's location (not to the
+cwd), but on all other platforms where relative links are not supported,
+target paths will always be converted to absolute, normalized form
+before the link is created (and therefore relative paths are interpreted
+as relative to the cwd).  Furthermore, "~user" paths are always expanded
+to absolute form.  When creating links on filesystems that either do not
+support any links, or do not support the specific type requested, an
+error message will be returned.  In particular Windows 95, 98 and ME do
+not support any links at present, but most Unix platforms support both
+symbolic and hard links (the latter for files only), MacOS supports
+symbolic links and Windows NT/2000/XP (on NTFS drives) support symbolic
+directory links and hard file links.
 .TP
 \fBfile lstat \fIname varName\fR
 .
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 97266c0..41c9873 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.37 2003/12/12 17:02:37 vincentdarley Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.38 2003/12/17 17:47:28 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -1071,7 +1071,19 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 				Tcl_GetString(objv[index]), 
 				"\": that path already exists", (char *) NULL);
 		    } else if (errno == ENOENT) {
-			if (Tcl_FSAccess(objv[index+1], F_OK) == 0) {
+			/*
+			 * There are two cases here: either the target
+			 * doesn't exist, or the directory of the src
+			 * doesn't exist.
+			 */
+			int access;
+			Tcl_Obj *dirPtr = TclFileDirname(interp, objv[index]);
+			if (dirPtr == NULL) {
+			    return TCL_ERROR;
+			}
+			access = Tcl_FSAccess(dirPtr, F_OK);
+			Tcl_DecrRefCount(dirPtr);
+			if (access != 0) {
 			    Tcl_AppendResult(interp, 
 			            "could not create new link \"", 
 				    Tcl_GetString(objv[index]), 
@@ -1081,7 +1093,7 @@ Tcl_FileObjCmd(dummy, interp, objc, objv)
 			    Tcl_AppendResult(interp, 
 			            "could not create new link \"", 
 				    Tcl_GetString(objv[index]), 
-				    "\" since target \"", 
+				    "\": target \"", 
 				    Tcl_GetString(objv[index+1]), 
 				    "\" doesn't exist", 
 				    (char *) NULL);
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 71a72cf..c0f6948 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.34 2003/12/16 15:26:44 vincentdarley Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.35 2003/12/17 17:47:28 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -2154,7 +2154,7 @@ test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unixOnly notRoot} {
 		
     file mkdir tfad1
     file mkdir tfad2
-    file link -symbolic [file join tfad2 link] tfad1
+    file link -symbolic [file join tfad2 link] [file join .. tfad1]
     file delete -force tfad2
 
     set r1 [file isdir tfad1]
@@ -2306,7 +2306,7 @@ test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
     set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
     cd [workingDirectory]
     set res
-} {1 {could not create new link "abc.link" since target "abc2.doesnt" doesn't exist}}
+} {1 {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}}
 
 test fCmd-28.10.1 {file link: linking to nonexistent path} {linkDirectory} {
     cd [temporaryDirectory]
@@ -2388,7 +2388,10 @@ test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
 cd [temporaryDirectory]
 file delete -force abc.link
 file delete -force abc2.link
-
+cd abc.dir
+file delete -force abc.file
+file delete -force abc2.file
+cd ..
 file copy abc.file abc.dir
 file copy abc2.file abc.dir
 cd [workingDirectory]
@@ -2416,12 +2419,40 @@ test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
     set res
 } [lsort [list abc.link abc.dir abc2.dir]]
 
+test fCmd-28.19 {file link: relative paths} {winOnly linkDirectory} {
+    cd [temporaryDirectory]
+    file mkdir d1/d2/d3
+    set res [list [catch {file link d1/l2 d1/d2} err] $err]
+    lappend res [catch {file delete -force d1} err] $err
+} {0 d1/d2 0 {}}
+
+test fCmd-28.20 {file link: relative paths} {unixOnly linkDirectory} {
+    cd [temporaryDirectory]
+    file mkdir d1/d2/d3
+    list [catch {file link d1/l2 d1/d2} res] $res
+} {1 {could not create new link "d1/l2": target "d1/d2" doesn't exist}}
+
+test fCmd-28.21 {file link: relative paths} {unixOnly linkDirectory} {
+    cd [temporaryDirectory]
+    file mkdir d1/d2/d3
+    list [catch {file link d1/l2 d2} res] $res
+} {0 d2}
+
+test fCmd-28.22 {file link: relative paths} {unixOnly linkDirectory} {
+    cd [temporaryDirectory]
+    file mkdir d1/d2/d3
+    catch {file delete -force d1/l2}
+    list [catch {file link d1/l2 d2/d3} res] $res
+} {0 d2/d3}
+
 test fCmd-29.1 {weird memory corruption fault} {
     catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
 } 1
 
 cd [temporaryDirectory]
 file delete -force abc.link
+file delete -force d1/d2
+file delete -force d1
 cd [workingDirectory]
 
 removeFile abc2.file
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 3a78665..91a468f 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -41,13 +41,17 @@ proc testPathEqual {one two} {
 }
 
 if {[catch {
-    file link link.file gorp.file 
+    file link link.file gorp.file
+    cd dir.dir
     file link \
-      [file join dir.dir linkinside.file] \
-      [file join dir.dir inside.file]
+      [file join linkinside.file] \
+      [file join inside.file]
+    cd ..
     file link dir.link dir.dir
-    file link [file join dir.dir dirinside.link] \
-      [file join dir.dir dirinside.dir]
+    cd dir.dir
+    file link [file join dirinside.link] \
+      [file join dirinside.dir]
+    cd ..
 }]} {
     tcltest::testConstraint hasLinks 0
 } else {
@@ -121,7 +125,7 @@ test filesystem-1.10 {link normalisation: double link} {macOrUnix hasLinks} {
 makeDirectory dir2.file
 
 test filesystem-1.11 {link normalisation: double link, back in tree} {macOrUnix hasLinks} {
-    file link [file join dir2.file dir2.link] dir2.link
+    file link [file join dir2.file dir2.link] [file join .. dir2.link]
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
       [file normalize [file join dir2.file dir2.link inside.file foo]]
 } {1}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 66c31b9..96d2fda 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclUnixFile.c,v 1.35 2003/12/12 17:09:34 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.36 2003/12/17 17:47:28 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -715,21 +715,57 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 {
     if (toPtr != NULL) {
 	CONST char *src = Tcl_FSGetNativePath(pathPtr);
-	CONST char *target = Tcl_FSGetNativePath(toPtr);
+	CONST char *target = NULL;
+	if (src == NULL) return NULL;
 	
-	if (src == NULL || target == NULL) {
-	    return NULL;
+	/* 
+	 * If we're making a symbolic link and the path is relative,
+	 * then we must check whether it exists _relative_ to the
+	 * directory in which the src is found (not relative to the
+	 * current cwd which is just not relevant in this case).
+	 * 
+	 * If we're making a hard link, then a relative path is
+	 * just converted to absolute relative to the cwd.
+	 */
+	if ((linkAction & TCL_CREATE_SYMBOLIC_LINK)
+	  && (Tcl_FSGetPathType(toPtr) == TCL_PATH_RELATIVE)) {
+	    Tcl_Obj *dirPtr, *absPtr;
+	    dirPtr = TclFileDirname(NULL, pathPtr);
+	    if (dirPtr == NULL) {
+	        return NULL;
+	    }
+	    absPtr = Tcl_FSJoinToPath(dirPtr, 1, &toPtr);
+	    Tcl_IncrRefCount(absPtr);
+	    if (Tcl_FSAccess(absPtr, F_OK) == -1) {
+		Tcl_DecrRefCount(absPtr);
+		Tcl_DecrRefCount(dirPtr);
+		/* target doesn't exist */
+		errno = ENOENT;
+	        return NULL;
+	    }
+	    /* 
+	     * Target exists; we'll construct the relative
+	     * path we want below.
+	     */
+	    Tcl_DecrRefCount(absPtr);
+	    Tcl_DecrRefCount(dirPtr);
+	} else {
+	    target = Tcl_FSGetNativePath(toPtr);
+	    if (access(target, F_OK) == -1) {
+		/* target doesn't exist */
+		errno = ENOENT;
+		return NULL;
+	    }
+	    if (target == NULL) {
+		return NULL;
+	    }
 	}
+	
 	if (access(src, F_OK) != -1) {
 	    /* src exists */
 	    errno = EEXIST;
 	    return NULL;
 	}
-	if (access(target, F_OK) == -1) {
-	    /* target doesn't exist */
-	    errno = ENOENT;
-	    return NULL;
-	}
 	/* 
 	 * Check symbolic link flag first, since we prefer to
 	 * create these.
@@ -740,8 +776,8 @@ TclpObjLink(pathPtr, toPtr, linkAction)
 	    Tcl_Obj *transPtr;
 	    /* 
 	     * Now we don't want to link to the absolute, normalized path.
-	     * Relative links are quite acceptable, as are links to '~user',
-	     * for example.
+	     * Relative links are quite acceptable (but links to ~user
+	     * are not -- these must be expanded first).
 	     */
 	    transPtr = Tcl_FSGetTranslatedPath(NULL, toPtr);
 	    if (transPtr == NULL) {
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 519df62..c565d33 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFCmd.c,v 1.37 2003/10/13 16:48:07 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFCmd.c,v 1.38 2003/12/17 17:47:28 vincentdarley Exp $
  */
 
 #include "tclWinInt.h"
@@ -22,6 +22,7 @@
 #define DOTREE_PRED   1     /* pre-order directory  */
 #define DOTREE_POSTD  2     /* post-order directory */
 #define DOTREE_F      3     /* regular file */
+#define DOTREE_LINK   4     /* symbolic link */
 
 /*
  * Callbacks for file attributes code.
@@ -969,6 +970,7 @@ DoRemoveJustDirectory(
 				 * DString filled with UTF-8 name of file
 				 * causing error. */
 {
+    DWORD attr;
     /*
      * The RemoveDirectory API acts differently under Win95/98 and NT
      * WRT NULL and "". Avoid passing these values.
@@ -979,13 +981,24 @@ DoRemoveJustDirectory(
 	goto end;
     }
 
-    if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
-	return TCL_OK;
+    attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+
+    if (attr & FILE_ATTRIBUTE_REPARSE_POINT) {
+	/* It is a symbolic link -- remove it */
+	if (TclWinSymLinkDelete(nativePath, 0) == 0) {
+	    return TCL_OK;
+	}
+    } else {
+	/* Ordinary directory */
+	if ((*tclWinProcs->removeDirectoryProc)(nativePath) != FALSE) {
+	    return TCL_OK;
+	}
     }
+    
     TclWinConvertError(GetLastError());
 
     if (Tcl_GetErrno() == EACCES) {
-	DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+	attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
 	if (attr != 0xffffffff) {
 	    if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
 		/* 
@@ -1021,6 +1034,7 @@ DoRemoveJustDirectory(
 	     * Windows 95 and Win32s report removing a non-empty directory 
 	     * as EACCES, not EEXIST.  If the directory is not empty,
 	     * change errno so caller knows what's going on.
+
 	     */
 
 	    if (TclWinGetPlatformId() != VER_PLATFORM_WIN32_NT) {
@@ -1166,6 +1180,16 @@ TraverseWinTree(
 	nativeErrfile = nativeSource;
 	goto end;
     }
+    
+    if (sourceAttr & FILE_ATTRIBUTE_REPARSE_POINT) {
+	/*
+	 * Process the symbolic link
+	 */
+
+	return (*traverseProc)(nativeSource, nativeTarget, 
+			       DOTREE_LINK, errorPtr);
+    }
+    
     if ((sourceAttr & FILE_ATTRIBUTE_DIRECTORY) == 0) {
 	/*
 	 * Process the regular file
@@ -1344,10 +1368,17 @@ TraversalCopy(
 	    }
 	    break;
 	}
+	case DOTREE_LINK: {
+	    if (TclWinSymLinkCopyDirectory(nativeSrc, nativeDst) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+	}
 	case DOTREE_PRED: {
 	    if (DoCreateDirectory(nativeDst) == TCL_OK) {
 		DWORD attr = (*tclWinProcs->getFileAttributesProc)(nativeSrc);
-		if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) != FALSE) {
+		if ((*tclWinProcs->setFileAttributesProc)(nativeDst, attr) 
+		  != FALSE) {
 		    return TCL_OK;
 		}
 		TclWinConvertError(GetLastError());
@@ -1406,6 +1437,12 @@ TraversalDelete(
 	    }
 	    break;
 	}
+	case DOTREE_LINK: {
+	    if (DoRemoveJustDirectory(nativeSrc, 0, NULL) == TCL_OK) {
+		return TCL_OK;
+	    }
+	    break;
+	}
 	case DOTREE_PRED: {
 	    return TCL_OK;
 	}