summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c415
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);
}
/*
generated by cgit v0.12 at 2024-11-23 19:51:12 (GMT)