4 fs fixes

1 files changed, 219 insertions, 196 deletions

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);
 }
 
 /*