summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c343
1 files changed, 171 insertions, 172 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 8fb9fd9..c187e0e 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -6,15 +6,15 @@
*
* Copyright (c) 1995-1998 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#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);
/*
*---------------------------------------------------------------------------
@@ -36,17 +36,17 @@ 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). */
{
#ifdef __CYGWIN__
+ int length;
char buf[PATH_MAX * TCL_UTF_MAX + 1];
char name[PATH_MAX * TCL_UTF_MAX + 1];
#else
- CONST char *name, *p;
+ const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
- Tcl_Encoding encoding;
#endif
#ifdef __CYGWIN__
@@ -66,9 +66,8 @@ TclpFindExecutable(
/* Strip '.exe' part. */
length -= 4;
}
- tclNativeExecutableName = (char *) ckalloc(length + 1);
- memcpy(tclNativeExecutableName, name, length);
- buf[length] = '\0';
+ TclSetObjNameOfExecutable(
+ Tcl_NewStringObj(name, length), Tcl_GetEncoding(NULL, NULL));
#else
if (argv0 == NULL) {
return;
@@ -228,12 +227,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;
@@ -254,12 +253,13 @@ TclpMatchInDirectory(
/*
* Match a file directly.
*/
+
Tcl_Obj *tailPtr;
- CONST char *nativeTail;
+ const char *nativeTail;
- native = (CONST char*) Tcl_FSGetNativePath(pathPtr);
+ native = Tcl_FSGetNativePath(pathPtr);
tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
- nativeTail = (CONST char*) Tcl_FSGetNativePath(tailPtr);
+ nativeTail = Tcl_FSGetNativePath(tailPtr);
matchResult = NativeMatchType(interp, native, nativeTail, types);
if (matchResult == 1) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
@@ -269,10 +269,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 */
@@ -283,7 +282,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".
@@ -325,7 +324,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);
@@ -340,11 +339,11 @@ TclpMatchInDirectory(
matchHiddenPat = (pattern[0] == '.')
|| ((pattern[0] == '\\') && (pattern[1] == '.'));
- matchHidden = matchHiddenPat
+ matchHidden = matchHiddenPat
|| (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
@@ -352,13 +351,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
}
@@ -398,9 +403,8 @@ TclpMatchInDirectory(
}
if (matchResult < 0) {
return TCL_ERROR;
- } else {
- return TCL_OK;
}
+ return TCL_OK;
}
/*
@@ -408,13 +412,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.
@@ -425,11 +429,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
@@ -440,124 +445,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;
}
@@ -582,17 +593,16 @@ NativeMatchType(
*----------------------------------------------------------------------
*/
-char *
+const 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 = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -624,12 +634,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);
}
/*
@@ -652,12 +662,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);
}
/*
@@ -712,24 +722,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(strlen(buffer) + 1);
- return clientData;
- } else {
- char *newCd = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
strcpy(newCd, buffer);
- return (ClientData) newCd;
+ return newCd;
}
+
+ /*
+ * No change to pwd.
+ */
+
+ return clientData;
}
/*
@@ -754,7 +767,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
@@ -800,14 +813,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);
@@ -846,12 +859,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
@@ -863,8 +876,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;
@@ -988,12 +1001,8 @@ TclpObjLink(
}
Tcl_ExternalToUtfDString(NULL, link, length, &ds);
- linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
- Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
- if (linkPtr != NULL) {
- Tcl_IncrRefCount(linkPtr);
- }
+ linkPtr = TclDStringToObj(&ds);
+ Tcl_IncrRefCount(linkPtr);
return linkPtr;
}
}
@@ -1055,19 +1064,9 @@ TclpNativeToNormalized(
ClientData clientData)
{
Tcl_DString ds;
- Tcl_Obj *objPtr;
- int len;
-
- CONST char *copy;
- Tcl_ExternalToUtfDString(NULL, (CONST char*)clientData, -1, &ds);
-
- copy = Tcl_DStringValue(&ds);
- len = Tcl_DStringLength(&ds);
-
- objPtr = Tcl_NewStringObj(copy,len);
- Tcl_DStringFree(&ds);
- return objPtr;
+ Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds);
+ return TclDStringToObj(&ds);
}
/*
@@ -1091,10 +1090,10 @@ TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
char *nativePathPtr;
+ const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
int len;
- char *str;
if (TclFSCwdIsNative()) {
/*
@@ -1123,11 +1122,11 @@ TclNativeCreateNativeRep(
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
Tcl_DecrRefCount(validPathPtr);
- nativePathPtr = ckalloc((unsigned) len);
- memcpy((void*)nativePathPtr, (void*)Tcl_DStringValue(&ds), (size_t) len);
+ nativePathPtr = ckalloc(len);
+ memcpy(nativePathPtr, Tcl_DStringValue(&ds), (size_t) len);
Tcl_DStringFree(&ds);
- return (ClientData)nativePathPtr;
+ return nativePathPtr;
}
/*
@@ -1162,11 +1161,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 copy;
}
/*