4 fs fixes

2 files changed, 283 insertions, 212 deletions

diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index 80383d8..49131de 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -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: tclUnixFCmd.c,v 1.17 2002/02/15 14:28:50 dkf Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.18 2002/03/24 11:41:51 vincentdarley Exp $
  *
  * Portions of this code were derived from NetBSD source code which has
  * the following copyright notice:
@@ -191,7 +191,7 @@ TclpObjRenameFile(srcPathPtr, destPathPtr)
     Tcl_Obj *srcPathPtr;
     Tcl_Obj *destPathPtr;
 {
-    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr),
+    return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), 
 			Tcl_FSGetNativePath(destPathPtr));
 }
 
@@ -308,7 +308,7 @@ TclpObjCopyFile(srcPathPtr, destPathPtr)
     Tcl_Obj *srcPathPtr;
     Tcl_Obj *destPathPtr;
 {
-    return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr),
+    return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), 
 		      Tcl_FSGetNativePath(destPathPtr));
 }
 
@@ -1618,17 +1618,17 @@ GetModeFromPermString(interp, modeStringPtr, modePtr)
  * TclpObjNormalizePath --
  *
  *	This function scans through a path specification and replaces
- *	it, in place, with a normalized version.  On unix, this simply
- *	ascertains where the valid path ends, and makes no change in
- *	place.
+ *	it, in place, with a normalized version.  A normalized version
+ *	is one in which all symlinks in the path are replaced with
+ *	their expanded form (except a symlink at the very end of the
+ *	path).
  *
  * Results:
  *	The new 'nextCheckpoint' value, giving as far as we could
  *	understand in the path.
  *
  * Side effects:
- *	The pathPtr string, which must contain a valid path, is
- *	not modified (unlike Windows, MacOS versions).
+ *	The pathPtr string, is modified.
  *
  *---------------------------------------------------------------------------
  */
@@ -1640,13 +1640,15 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
     int nextCheckpoint;
 {
     char *currentPathEndPosition;
-    char *path = Tcl_GetString(pathPtr);
+    int pathLen;
+    char cur;
+    char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
 
     currentPathEndPosition = path + nextCheckpoint;
 
     while (1) {
-	char cur = *currentPathEndPosition;
-	if ((cur == '/' || cur == 0) && (path != currentPathEndPosition)) {
+	cur = *currentPathEndPosition;
+	if ((cur == '/') && (path != currentPathEndPosition)) {
 	    /* Reached directory separator, or end of string */
 	    Tcl_DString ds;
 	    CONST char *nativePath;
@@ -1660,13 +1662,59 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
 		/* File doesn't exist */
 		break;
 	    }
-	    if (cur == 0) {
-		break;
-	    }
+	    /* Update the acceptable point */
+	    nextCheckpoint = currentPathEndPosition - path;
+	} else if (cur == 0) {
+	    break;
 	}
 	currentPathEndPosition++;
     }
-    nextCheckpoint = currentPathEndPosition - path;
-    /* We should really now convert this to a canonical path */
+    /* 
+     * We should really now convert this to a canonical path.  We do
+     * that with 'realpath' if we have it available.  Otherwise we could
+     * step through every single path component, checking whether it is a 
+     * symlink, but that would be a lot of work, and most modern OSes 
+     * have 'realpath'.
+     */
+#ifndef NO_REALPATH
+    if (1) {
+	char normPath[MAXPATHLEN];
+	Tcl_DString ds;
+	CONST char *nativePath = Tcl_UtfToExternalDString(NULL, path, 
+						   nextCheckpoint, &ds);
+	
+	if (realpath((char *) nativePath, normPath) != NULL) {
+	    /* 
+	     * Free up the native path and put in its place the
+	     * converted, normalized path.
+	     */
+	    Tcl_DStringFree(&ds);
+	    Tcl_ExternalToUtfDString(NULL,normPath,
+                                     strlen(normPath),&ds);
+
+	    if (path[nextCheckpoint] != '\0') {
+		/* not at end, append remaining path */
+	        int normLen = Tcl_DStringLength(&ds);
+		Tcl_DStringAppend(&ds, path + nextCheckpoint,
+				  pathLen - nextCheckpoint);
+                /* 
+                 * We recognise up to and including the directory
+                 * separator.
+		 */	
+	        nextCheckpoint = normLen + 1;
+	    } else {
+	        /* We recognise the whole string */ 
+	        nextCheckpoint = Tcl_DStringLength(&ds);
+	    }
+	    /* 
+	     * Overwrite with the normalized path.
+	     */
+	    Tcl_SetStringObj(pathPtr,Tcl_DStringValue(&ds),
+			     Tcl_DStringLength(&ds));
+	}
+	Tcl_DStringFree(&ds);
+    }
+#endif	/* !NO_REALPATH */
+
     return nextCheckpoint;
 }
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 99a0731..3e2c7c8 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,12 +9,14 @@
  * 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.18 2002/02/15 14:28:50 dkf Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.19 2002/03/24 11:41:51 vincentdarley Exp $
  */
 
 #include "tclInt.h"
 #include "tclPort.h"
 
+static int NativeMatchType(CONST char* nativeName, Tcl_GlobTypeData *types);
+
 
 /*
  *---------------------------------------------------------------------------
@@ -205,230 +207,256 @@ TclpMatchInDirectory(interp, resultPtr, pathPtr, pattern, types)
 				 * May be NULL. In particular the directory
 				 * flag is very important. */
 {
-    CONST char *native, *fname, *dirName;
-    DIR *d;
-    Tcl_DString ds;
-    Tcl_StatBuf statBuf;
-    int matchHidden;
-    int nativeDirLen;
-    int result = TCL_OK;
-    Tcl_DString dsOrig;
+    CONST char *native;
     Tcl_Obj *fileNamePtr;
-    int baseLength;
 
     fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
     if (fileNamePtr == NULL) {
 	return TCL_ERROR;
     }
-    Tcl_DStringInit(&dsOrig);
-    Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
-    baseLength = Tcl_DStringLength(&dsOrig);
     
-    /*
-     * Make sure that the directory part of the name really is a
-     * directory.  If the directory name is "", use the name "."
-     * instead, because some UNIX systems don't treat "" like "."
-     * automatically.  Keep the "" for use in generating file names,
-     * otherwise "glob foo.c" would return "./foo.c".
-     */
-
-    if (baseLength == 0) {
-	dirName = ".";
-    } else {
-	dirName = Tcl_DStringValue(&dsOrig);
-	/* Make sure we have a trailing directory delimiter */
-	if (dirName[baseLength-1] != '/') {
-	    dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
-	    baseLength++;
+    if (pattern == NULL || (*pattern == '\0')) {
+	/* Match a file directly */
+	CONST char *native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+	if (NativeMatchType(native, types)) {
+	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
 	}
-    }
+	return TCL_OK;
+    } else {
+	CONST char *fname, *dirName;
+	DIR *d;
+	Tcl_DString ds;
+	Tcl_StatBuf statBuf;
+	int matchHidden;
+	int nativeDirLen;
+	int result = TCL_OK;
+	Tcl_DString dsOrig;
+	int baseLength;
+	
+	Tcl_DStringInit(&dsOrig);
+	Tcl_DStringAppend(&dsOrig, Tcl_GetString(fileNamePtr), -1);
+	baseLength = Tcl_DStringLength(&dsOrig);
+	
+	/*
+	 * Make sure that the directory part of the name really is a
+	 * directory.  If the directory name is "", use the name "."
+	 * instead, because some UNIX systems don't treat "" like "."
+	 * automatically.  Keep the "" for use in generating file names,
+	 * otherwise "glob foo.c" would return "./foo.c".
+	 */
 
-    /*
-     * Check to see if the pattern needs to compare with hidden files.
-     */
+	if (baseLength == 0) {
+	    dirName = ".";
+	} else {
+	    dirName = Tcl_DStringValue(&dsOrig);
+	    /* Make sure we have a trailing directory delimiter */
+	    if (dirName[baseLength-1] != '/') {
+		dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
+		baseLength++;
+	    }
+	}
+	
+	/*
+	 * Check to see if the pattern needs to compare with hidden files.
+	 */
 
-    if ((pattern[0] == '.')
-	    || ((pattern[0] == '\\') && (pattern[1] == '.'))) {
-	matchHidden = 1;
-    } else {
-	matchHidden = 0;
-    }
+	if ((pattern[0] == '.')
+		|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
+	    matchHidden = 1;
+	} else {
+	    matchHidden = 0;
+	}
 
-    /*
-     * Now open the directory for reading and iterate over the contents.
-     */
+	/*
+	 * Now open the directory for reading and iterate over the contents.
+	 */
 
-    native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
 
-    if ((Tcl_PlatformStat(native, &statBuf) != 0)	/* INTL: UTF-8. */
-	    || !S_ISDIR(statBuf.st_mode)) {
-	Tcl_DStringFree(&dsOrig);
-	Tcl_DStringFree(&ds);
-	return TCL_OK;
-    }
+	if ((Tcl_PlatformStat(native, &statBuf) != 0)		/* INTL: UTF-8. */
+		|| !S_ISDIR(statBuf.st_mode)) {
+	    Tcl_DStringFree(&dsOrig);
+	    Tcl_DStringFree(&ds);
+	    return TCL_OK;
+	}
 
-    d = opendir(native);				/* INTL: Native. */
-    if (d == NULL) {
-        char savedChar = '\0';
-	Tcl_ResetResult(interp);
-	Tcl_DStringFree(&ds);
+	d = opendir(native);				/* INTL: Native. */
+	if (d == NULL) {
+	    char savedChar = '\0';
+	    Tcl_ResetResult(interp);
+	    Tcl_DStringFree(&ds);
 
-	/*
-	 * Strip off a trailing '/' if necessary, before reporting the error.
-	 */
+	    /*
+	     * Strip off a trailing '/' if necessary, before reporting the error.
+	     */
 
-	if (baseLength > 0) {
-	    savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
-	    if (savedChar == '/') {
-		(Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
+	    if (baseLength > 0) {
+		savedChar = (Tcl_DStringValue(&dsOrig))[baseLength-1];
+		if (savedChar == '/') {
+		    (Tcl_DStringValue(&dsOrig))[baseLength-1] = '\0';
+		}
 	    }
+	    Tcl_AppendResult(interp, "couldn't read directory \"",
+		    Tcl_DStringValue(&dsOrig), "\": ",
+		    Tcl_PosixError(interp), (char *) NULL);
+	    if (baseLength > 0) {
+		(Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
+	    }
+	    Tcl_DStringFree(&dsOrig);
+	    return TCL_ERROR;
 	}
-	Tcl_AppendResult(interp, "couldn't read directory \"",
-		Tcl_DStringValue(&dsOrig), "\": ",
-		Tcl_PosixError(interp), (char *) NULL);
-	if (baseLength > 0) {
-	    (Tcl_DStringValue(&dsOrig))[baseLength-1] = savedChar;
-	}
-	Tcl_DStringFree(&dsOrig);
-	return TCL_ERROR;
-    }
 
-    nativeDirLen = Tcl_DStringLength(&ds);
+	nativeDirLen = Tcl_DStringLength(&ds);
 
-    while (1) {
-        Tcl_DString utfDs;
-	CONST char *utf;
-	Tcl_DirEntry *entryPtr;
-	
-	entryPtr = Tcl_PlatformReaddir(d);		/* INTL: Native. */
-	if (entryPtr == NULL) {
-	    break;
-	}
-	if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
-	    /* 
-	     * We explicitly asked for hidden files, so turn around
-	     * and ignore any file which isn't hidden.
-	     */
-	    if (*entryPtr->d_name != '.') {
-	        continue;
+	while (1) {
+	    Tcl_DString utfDs;
+	    CONST char *utf;
+	    Tcl_DirEntry *entryPtr;
+	    
+	    entryPtr = Tcl_PlatformReaddir(d);		/* INTL: Native. */
+	    if (entryPtr == NULL) {
+		break;
 	    }
-	} else if (!matchHidden && (*entryPtr->d_name == '.')) {
+	    if (types != NULL && (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+		/* 
+		 * We explicitly asked for hidden files, so turn around
+		 * and ignore any file which isn't hidden.
+		 */
+		if (*entryPtr->d_name != '.') {
+		    continue;
+		}
+	    } else if (!matchHidden && (*entryPtr->d_name == '.')) {
+		/*
+		 * Don't match names starting with "." unless the "." is
+		 * present in the pattern.
+		 */
+		continue;
+	    }
+
 	    /*
-	     * Don't match names starting with "." unless the "." is
-	     * present in the pattern.
+	     * Now check to see if the file matches, according to both type
+	     * and pattern.  If so, add the file to the result.
 	     */
-	    continue;
+
+	    utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
+	    if (Tcl_StringMatch(utf, pattern) != 0) {
+		int typeOk = 1;
+
+		Tcl_DStringSetLength(&dsOrig, baseLength);
+		Tcl_DStringAppend(&dsOrig, utf, -1);
+		fname = Tcl_DStringValue(&dsOrig);
+		if (types != NULL) {
+		    char *nativeEntry;
+		    Tcl_DStringSetLength(&ds, nativeDirLen);
+		    nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+		    typeOk = NativeMatchType(nativeEntry, types);
+		}
+		if (typeOk) {
+		    Tcl_ListObjAppendElement(interp, resultPtr, 
+			    Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+		}
+	    }
+	    Tcl_DStringFree(&utfDs);
 	}
 
-	/*
-	 * Now check to see if the file matches, according to both type
-	 * and pattern.  If so, add the file to the result.
+	closedir(d);
+	Tcl_DStringFree(&ds);
+	Tcl_DStringFree(&dsOrig);
+	return result;
+    }
+}
+static int 
+NativeMatchType(
+    CONST char* nativeEntry,  /* Native path to check */
+    Tcl_GlobTypeData *types)  /* Type description to match against */
+{
+    Tcl_StatBuf buf;
+    if (types == NULL) {
+	/* 
+	 * Simply check for the file's existence, but do it
+	 * with lstat, in case it is a link to a file which
+	 * doesn't exist (since that case would not show up
+	 * if we used 'access' or 'stat')
 	 */
-
-	utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &utfDs);
-	if (Tcl_StringMatch(utf, pattern) != 0) {
-	    int typeOk = 1;
-
-	    Tcl_DStringSetLength(&dsOrig, baseLength);
-	    Tcl_DStringAppend(&dsOrig, utf, -1);
-	    fname = Tcl_DStringValue(&dsOrig);
-	    if (types != NULL) {
-		Tcl_StatBuf buf;
-		char *nativeEntry;
-		Tcl_DStringSetLength(&ds, nativeDirLen);
-		nativeEntry = Tcl_DStringAppend(&ds, entryPtr->d_name, -1);
+	if (Tcl_PlatformLStat(nativeEntry, &buf) != 0) {
+	    return 0;
+	}
+    } else {
+	if (types->perm != 0) {
+	    if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
 		/* 
-		 * The native name of the file is in entryPtr->d_name.
-		 * We can use this below.
+		 * Either the file has disappeared between the
+		 * 'readdir' call and the 'stat' call, or
+		 * the file is a link to a file which doesn't
+		 * exist (which we could ascertain with
+		 * lstat), or there is some other strange
+		 * problem.  In all these cases, we define this
+		 * to mean the file does not match any defined
+		 * permission, and therefore it is not 
+		 * added to the list of files to return.
 		 */
-		
-		if (types->perm != 0) {
-		    if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
-			/* 
-			 * Either the file has disappeared between the
-			 * 'readdir' call and the 'stat' call, or
-			 * the file is a link to a file which doesn't
-			 * exist (which we could ascertain with
-			 * lstat), or there is some other strange
-			 * problem.  In all these cases, we define this
-			 * to mean the file does not match any defined
-			 * permission, and therefore it is not 
-			 * added to the list of files to return.
-			 */
-			typeOk = 0;
-		    }
-		    
-		    /* 
-		     * readonly means that there are NO write permissions
-		     * (even for user), but execute is OK for anybody
-		     */
-		    if (typeOk && (
-			((types->perm & TCL_GLOB_PERM_RONLY) &&
-				(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
-			((types->perm & TCL_GLOB_PERM_R) &&
-				(access(nativeEntry, R_OK) != 0)) ||
-			((types->perm & TCL_GLOB_PERM_W) &&
-				(access(nativeEntry, W_OK) != 0)) ||
-			((types->perm & TCL_GLOB_PERM_X) &&
-				(access(nativeEntry, X_OK) != 0))
-			)) {
-			typeOk = 0;
-		    }
+		return 0;
+	    }
+	    
+	    /* 
+	     * readonly means that there are NO write permissions
+	     * (even for user), but execute is OK for anybody
+	     */
+	    if (((types->perm & TCL_GLOB_PERM_RONLY) &&
+			(buf.st_mode & (S_IWOTH|S_IWGRP|S_IWUSR))) ||
+		((types->perm & TCL_GLOB_PERM_R) &&
+			(access(nativeEntry, R_OK) != 0)) ||
+		((types->perm & TCL_GLOB_PERM_W) &&
+			(access(nativeEntry, W_OK) != 0)) ||
+		((types->perm & TCL_GLOB_PERM_X) &&
+			(access(nativeEntry, X_OK) != 0))
+		) {
+		return 0;
+	    }
+	}
+	if (types->type != 0) {
+	    if (types->perm == 0) {
+		/* We haven't yet done a stat on the file */
+		if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
+		    /* Posix error occurred */
+		    return 0;
 		}
-		if (typeOk && (types->type != 0)) {
-		    if (types->perm == 0) {
-			/* We haven't yet done a stat on the file */
-			if (Tcl_PlatformStat(nativeEntry, &buf) != 0) {
-			    /* Posix error occurred */
-			    typeOk = 0;
-			}
-		    }
-		    if (typeOk) {
-			/*
-			 * In order bcdpfls as in 'find -t'
-			 */
-			if (
-			    ((types->type & TCL_GLOB_TYPE_BLOCK) &&
-				    S_ISBLK(buf.st_mode)) ||
-			    ((types->type & TCL_GLOB_TYPE_CHAR) &&
-				    S_ISCHR(buf.st_mode)) ||
-			    ((types->type & TCL_GLOB_TYPE_DIR) &&
-				    S_ISDIR(buf.st_mode)) ||
-			    ((types->type & TCL_GLOB_TYPE_PIPE) &&
-				    S_ISFIFO(buf.st_mode)) ||
-			    ((types->type & TCL_GLOB_TYPE_FILE) &&
-				    S_ISREG(buf.st_mode))
-#ifdef S_ISSOCK
-			    || ((types->type & TCL_GLOB_TYPE_SOCK) &&
-				    S_ISSOCK(buf.st_mode))
-#endif
-			    ) {
-			    /* Do nothing -- this file is ok */
-			} else {
-			    typeOk = 0;
-#ifdef S_ISLNK
-			    if ((types->type & TCL_GLOB_TYPE_LINK)
-				    && Tcl_PlatformLStat(nativeEntry, &buf)==0
-				    && S_ISLNK(buf.st_mode)) {
-				typeOk = 1;
-			    }
-#endif
+	    }
+	    /*
+	     * In order bcdpfls as in 'find -t'
+	     */
+	    if (
+		((types->type & TCL_GLOB_TYPE_BLOCK) &&
+			S_ISBLK(buf.st_mode)) ||
+		((types->type & TCL_GLOB_TYPE_CHAR) &&
+			S_ISCHR(buf.st_mode)) ||
+		((types->type & TCL_GLOB_TYPE_DIR) &&
+			S_ISDIR(buf.st_mode)) ||
+		((types->type & TCL_GLOB_TYPE_PIPE) &&
+			S_ISFIFO(buf.st_mode)) ||
+		((types->type & TCL_GLOB_TYPE_FILE) &&
+			S_ISREG(buf.st_mode))
+    #ifdef S_ISSOCK
+		|| ((types->type & TCL_GLOB_TYPE_SOCK) &&
+			S_ISSOCK(buf.st_mode))
+    #endif
+		) {
+		/* Do nothing -- this file is ok */
+	    } else {
+    #ifdef S_ISLNK
+		if (types->type & TCL_GLOB_TYPE_LINK) {
+		    if (Tcl_PlatformLStat(nativeEntry, &buf) == 0) {
+			if (S_ISLNK(buf.st_mode)) {
+			    return 1;
 			}
 		    }
 		}
-	    }
-	    if (typeOk) {
-		Tcl_ListObjAppendElement(interp, resultPtr, 
-			Tcl_NewStringObj(fname, Tcl_DStringLength(&dsOrig)));
+    #endif
+		return 0;
 	    }
 	}
-	Tcl_DStringFree(&utfDs);
     }
-
-    closedir(d);
-    Tcl_DStringFree(&ds);
-    Tcl_DStringFree(&dsOrig);
-    return result;
+    return 1;
 }
 
 /*
@@ -553,12 +581,7 @@ TclpObjLstat(pathPtr, bufPtr)
     Tcl_Obj *pathPtr;		/* Path of file to stat */
     Tcl_StatBuf *bufPtr;	/* Filled with results of stat call. */
 {
-    CONST char *path = Tcl_FSGetNativePath(pathPtr);
-    if (path == NULL) {
-	return -1;
-    } else {
-	return Tcl_PlatformLStat(path, bufPtr);
-    }
+    return Tcl_PlatformLStat(Tcl_FSGetNativePath(pathPtr), bufPtr);
 }
 
 /*