summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c307
1 files changed, 160 insertions, 147 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index d11b43c..a24966c 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -9,14 +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.52 2007/12/13 15:28:42 dgp Exp $
+ * RCS: @(#) $Id: tclUnixFile.c,v 1.53 2008/04/27 22:21:34 dkf Exp $
*/
#include "tclInt.h"
#include "tclFileSystem.h"
-static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
- CONST char* nativeName, Tcl_GlobTypeData *types);
+static int NativeMatchType(Tcl_Interp *interp, const char* nativeEntry,
+ const char* nativeName, Tcl_GlobTypeData *types);
/*
*---------------------------------------------------------------------------
@@ -37,10 +37,10 @@ static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
void
TclpFindExecutable(
- CONST char *argv0) /* The value of the application's argv[0]
+ const char *argv0) /* The value of the application's argv[0]
* (native). */
{
- CONST char *name, *p;
+ const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
Tcl_Encoding encoding;
@@ -202,12 +202,12 @@ TclpMatchInDirectory(
Tcl_Interp *interp, /* Interpreter to receive errors. */
Tcl_Obj *resultPtr, /* List object to lappend results. */
Tcl_Obj *pathPtr, /* Contains path to directory to search. */
- CONST char *pattern, /* Pattern to match against. */
+ const char *pattern, /* Pattern to match against. */
Tcl_GlobTypeData *types) /* Object containing list of acceptable types.
* May be NULL. In particular the directory
* flag is very important. */
{
- CONST char *native;
+ const char *native;
Tcl_Obj *fileNamePtr;
int matchResult = 0;
@@ -228,12 +228,13 @@ TclpMatchInDirectory(
/*
* Match a file directly.
*/
+
Tcl_Obj *tailPtr;
- CONST char *nativeTail;
+ const char *nativeTail;
- native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+ native = (const char *) Tcl_FSGetNativePath(pathPtr);
tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
- nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr);
+ nativeTail = (const char *) Tcl_FSGetNativePath(tailPtr);
matchResult = NativeMatchType(interp, native, nativeTail, types);
if (matchResult == 1) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -243,10 +244,9 @@ TclpMatchInDirectory(
} else {
DIR *d;
Tcl_DirEntry *entryPtr;
- CONST char *dirName;
- int dirLength;
+ const char *dirName;
+ int dirLength, nativeDirLen;
int matchHidden, matchHiddenPat;
- int nativeDirLen;
Tcl_StatBuf statBuf;
Tcl_DString ds; /* native encoding of dir */
Tcl_DString dsOrig; /* utf-8 encoding of dir */
@@ -257,7 +257,7 @@ TclpMatchInDirectory(
/*
* Make sure that the directory part of the name really is a
- * directory. If the directory name is "", use the name "." instead,
+ * 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".
@@ -299,7 +299,7 @@ TclpMatchInDirectory(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "couldn't read directory \"",
Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_PosixError(interp), NULL);
}
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
@@ -318,7 +318,7 @@ TclpMatchInDirectory(
|| (types && (types->perm & TCL_GLOB_PERM_HIDDEN));
while ((entryPtr = TclOSreaddir(d)) != NULL) { /* INTL: Native. */
Tcl_DString utfDs;
- CONST char *utfname;
+ const char *utfname;
/*
* Skip this file if it doesn't agree with the hidden parameters
@@ -326,13 +326,19 @@ TclpMatchInDirectory(
*/
if (*entryPtr->d_name == '.') {
- if (!matchHidden) continue;
+ if (!matchHidden) {
+ continue;
+ }
} else {
#ifdef MAC_OSX_TCL
- if (matchHiddenPat) continue;
+ if (matchHiddenPat) {
+ continue;
+ }
/* Also need to check HFS hidden flag in TclMacOSXMatchType. */
#else
- if (matchHidden) continue;
+ if (matchHidden) {
+ continue;
+ }
#endif
}
@@ -372,9 +378,8 @@ TclpMatchInDirectory(
}
if (matchResult < 0) {
return TCL_ERROR;
- } else {
- return TCL_OK;
}
+ return TCL_OK;
}
/*
@@ -382,13 +387,13 @@ TclpMatchInDirectory(
*
* NativeMatchType --
*
- * This routine is used by the globbing code to check if a file
- * matches a given type description.
+ * This routine is used by the globbing code to check if a file matches a
+ * given type description.
*
* Results:
- * The return value is 1, 0 or -1 indicating whether the file
- * matches the given criteria, does not match them, or an error
- * occurred (in wich case an error is left in interp).
+ * The return value is 1, 0 or -1 indicating whether the file matches the
+ * given criteria, does not match them, or an error occurred (in which
+ * case an error is left in interp).
*
* Side effects:
* None.
@@ -399,11 +404,12 @@ TclpMatchInDirectory(
static int
NativeMatchType(
Tcl_Interp *interp, /* Interpreter to receive errors. */
- CONST char *nativeEntry, /* Native path to check. */
- CONST char *nativeName, /* Native filename to check. */
+ const char *nativeEntry, /* Native path to check. */
+ const char *nativeName, /* Native filename 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
@@ -414,124 +420,130 @@ NativeMatchType(
if (TclOSlstat(nativeEntry, &buf) != 0) {
return 0;
}
- } else {
- if (types->perm != 0) {
- if (TclOSstat(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.
- */
-
- return 0;
- }
+ return 1;
+ }
+ if (types->perm != 0) {
+ if (TclOSstat(nativeEntry, &buf) != 0) {
/*
- * readonly means that there are NO write permissions (even for
- * user), but execute is OK for anybody OR that the user immutable
- * flag is set (where supported).
+ * 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 & TCL_GLOB_PERM_RONLY) &&
+ return 0;
+ }
+
+ /*
+ * readonly means that there are NO write permissions (even for user),
+ * but execute is OK for anybody OR that the user immutable flag is
+ * set (where supported).
+ */
+
+ if (((types->perm & TCL_GLOB_PERM_RONLY) &&
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
- !(buf.st_flags & UF_IMMUTABLE) &&
+ !(buf.st_flags & UF_IMMUTABLE) &&
#endif
- (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))
+ (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))
#ifndef MAC_OSX_TCL
- || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
- (*nativeName != '.'))
+ || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ (*nativeName != '.'))
#endif
) {
- return 0;
- }
+ return 0;
}
- if (types->type != 0) {
- if (types->perm == 0) {
+ }
+ if (types->type != 0) {
+ if (types->perm == 0) {
+ /*
+ * We haven't yet done a stat on the file.
+ */
+
+ if (TclOSstat(nativeEntry, &buf) != 0) {
/*
- * We haven't yet done a stat on the file.
+ * Posix error occurred. The only ok case is if this is a link
+ * to a nonexistent file, and the user did 'glob -l'. So we
+ * check that here:
*/
- if (TclOSstat(nativeEntry, &buf) != 0) {
- /*
- * Posix error occurred. The only ok case is if this is a
- * link to a nonexistent file, and the user did 'glob -l'.
- * So we check that here:
- */
-
- if (types->type & TCL_GLOB_TYPE_LINK) {
- if (TclOSlstat(nativeEntry, &buf) == 0) {
- if (S_ISLNK(buf.st_mode)) {
- return 1;
- }
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclOSlstat(nativeEntry, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ return 1;
}
}
- return 0;
}
+ return 0;
}
+ }
- /*
- * In order bcdpfls as in 'find -t'
- */
+ /*
+ * In order bcdpsfl as in 'find -t'
+ */
- if (((types->type & TCL_GLOB_TYPE_BLOCK)&& S_ISBLK(buf.st_mode)) ||
+ 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))
+ ((types->type & TCL_GLOB_TYPE_SOCK) && S_ISSOCK(buf.st_mode))||
#endif /* S_ISSOCK */
- ) {
- /*
- * Do nothing - this file is ok.
- */
- } else {
+ ((types->type & TCL_GLOB_TYPE_FILE) && S_ISREG(buf.st_mode))) {
+ /*
+ * Do nothing - this file is ok.
+ */
+ } else {
#ifdef S_ISLNK
- if (types->type & TCL_GLOB_TYPE_LINK) {
- if (TclOSlstat(nativeEntry, &buf) == 0) {
- if (S_ISLNK(buf.st_mode)) {
- goto filetypeOK;
- }
+ if (types->type & TCL_GLOB_TYPE_LINK) {
+ if (TclOSlstat(nativeEntry, &buf) == 0) {
+ if (S_ISLNK(buf.st_mode)) {
+ goto filetypeOK;
}
}
-#endif /* S_ISLNK */
- return 0;
}
+#endif /* S_ISLNK */
+ return 0;
}
- filetypeOK: ;
+ }
+ filetypeOK:
+
+ /*
+ * If we're on OSX, we also have to worry about matching the file creator
+ * code (if specified). Do that now.
+ */
+
#ifdef MAC_OSX_TCL
- if (types->macType != NULL || types->macCreator != NULL ||
- (types->perm & TCL_GLOB_PERM_HIDDEN)) {
- int matchResult;
+ if (types->macType != NULL || types->macCreator != NULL ||
+ (types->perm & TCL_GLOB_PERM_HIDDEN)) {
+ int matchResult;
- if (types->perm == 0 && types->type == 0) {
- /*
- * We haven't yet done a stat on the file.
- */
+ if (types->perm == 0 && types->type == 0) {
+ /*
+ * We haven't yet done a stat on the file.
+ */
- if (TclOSstat(nativeEntry, &buf) != 0) {
- return 0;
- }
+ if (TclOSstat(nativeEntry, &buf) != 0) {
+ return 0;
}
+ }
- matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
- &buf, types);
- if (matchResult != 1) {
- return matchResult;
- }
+ matchResult = TclMacOSXMatchType(interp, nativeEntry, nativeName,
+ &buf, types);
+ if (matchResult != 1) {
+ return matchResult;
}
-#endif
}
+#endif /* MAC_OSX_TCL */
+
return 1;
}
@@ -558,15 +570,14 @@ NativeMatchType(
char *
TclpGetUserHome(
- CONST char *name, /* User name for desired home directory. */
+ const char *name, /* User name for desired home directory. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
* name of user's home directory. */
{
struct passwd *pwPtr;
Tcl_DString ds;
- CONST char *native;
+ const char *native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
- native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
pwPtr = getpwnam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -600,12 +611,12 @@ TclpObjAccess(
Tcl_Obj *pathPtr, /* Path of file to access */
int mode) /* Permission setting. */
{
- CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ const char *path = Tcl_FSGetNativePath(pathPtr);
+
if (path == NULL) {
return -1;
- } else {
- return access(path, mode);
}
+ return access(path, mode);
}
/*
@@ -628,12 +639,12 @@ int
TclpObjChdir(
Tcl_Obj *pathPtr) /* Path to new working directory */
{
- CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ const char *path = Tcl_FSGetNativePath(pathPtr);
+
if (path == NULL) {
return -1;
- } else {
- return chdir(path);
}
+ return chdir(path);
}
/*
@@ -688,24 +699,27 @@ TclpGetNativeCwd(
char buffer[MAXPATHLEN+1];
#ifdef USEGETWD
- if (getwd(buffer) == NULL) /* INTL: Native. */
+ if (getwd(buffer) == NULL) { /* INTL: Native. */
+ return NULL;
+ }
#else
- if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
-#endif
- {
+ if (getcwd(buffer, MAXPATHLEN+1) == NULL) { /* INTL: Native. */
return NULL;
}
- if ((clientData != NULL) && strcmp(buffer, (CONST char*)clientData) == 0) {
- /*
- * No change to pwd.
- */
+#endif
+
+ if ((clientData == NULL) || strcmp(buffer, (const char*)clientData)) {
+ char *newCd = ckalloc((unsigned) strlen(buffer) + 1);
- return clientData;
- } else {
- char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
strcpy(newCd, buffer);
return (ClientData) newCd;
}
+
+ /*
+ * No change to pwd.
+ */
+
+ return clientData;
}
/*
@@ -730,7 +744,7 @@ TclpGetNativeCwd(
*----------------------------------------------------------------------
*/
-CONST char *
+const char *
TclpGetCwd(
Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
Tcl_DString *bufferPtr) /* Uninitialized or free DString filled with
@@ -776,14 +790,14 @@ TclpGetCwd(
char *
TclpReadlink(
- CONST char *path, /* Path of file to readlink (UTF-8). */
+ const char *path, /* Path of file to readlink (UTF-8). */
Tcl_DString *linkPtr) /* Uninitialized or free DString filled with
* contents of link (UTF-8). */
{
#ifndef DJGPP
char link[MAXPATHLEN];
int length;
- CONST char *native;
+ const char *native;
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
@@ -822,12 +836,12 @@ TclpObjStat(
Tcl_Obj *pathPtr, /* Path of file to stat */
Tcl_StatBuf *bufPtr) /* Filled with results of stat call. */
{
- CONST char *path = Tcl_FSGetNativePath(pathPtr);
+ const char *path = Tcl_FSGetNativePath(pathPtr);
+
if (path == NULL) {
return -1;
- } else {
- return TclOSstat(path, bufPtr);
}
+ return TclOSstat(path, bufPtr);
}
#ifdef S_IFLNK
@@ -839,8 +853,8 @@ TclpObjLink(
int linkAction)
{
if (toPtr != NULL) {
- CONST char *src = Tcl_FSGetNativePath(pathPtr);
- CONST char *target = NULL;
+ const char *src = Tcl_FSGetNativePath(pathPtr);
+ const char *target = NULL;
if (src == NULL) {
return NULL;
@@ -1034,8 +1048,8 @@ TclpNativeToNormalized(
Tcl_Obj *objPtr;
int len;
- CONST char *copy;
- Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
+ const char *copy;
+ Tcl_ExternalToUtfDString(NULL, (const char*)clientData, -1, &ds);
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
@@ -1066,11 +1080,10 @@ ClientData
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
- char *nativePathPtr;
+ char *nativePathPtr, *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
int len;
- char *str;
if (TclFSCwdIsNative()) {
/*
@@ -1100,7 +1113,7 @@ TclNativeCreateNativeRep(
len = Tcl_DStringLength(&ds) + sizeof(char);
Tcl_DecrRefCount(validPathPtr);
nativePathPtr = ckalloc((unsigned) len);
- memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);
+ memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
return (ClientData)nativePathPtr;
@@ -1138,11 +1151,11 @@ TclNativeDupInternalRep(
* ASCII representation when running on Unix.
*/
- len = sizeof(char) + (strlen((CONST char*) clientData) * sizeof(char));
+ len = (strlen((const char*) clientData) + 1) * sizeof(char);
- copy = (char *) ckalloc(len);
- memcpy((void *) copy, (void *) clientData, len);
- return (ClientData)copy;
+ copy = ckalloc(len);
+ memcpy(copy, clientData, len);
+ return (ClientData) copy;
}
/*