summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFile.c')
-rw-r--r--unix/tclUnixFile.c460
1 files changed, 261 insertions, 199 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index e278eae..2cb0027 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -6,17 +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.
- *
- * RCS: @(#) $Id: tclUnixFile.c,v 1.50 2006/08/29 00:36:57 coldstore Exp $
+ * 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);
/*
*---------------------------------------------------------------------------
@@ -24,7 +22,8 @@ static int NativeMatchType(Tcl_Interp *interp, CONST char* nativeEntry,
* TclpFindExecutable --
*
* This function computes the absolute path name of the current
- * application, given its argv[0] value.
+ * application, given its argv[0] value. For Cygwin, argv[0] is
+ * ignored and the path is determined the same as under win32.
*
* Results:
* None.
@@ -37,13 +36,28 @@ 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;
+ Tcl_Encoding encoding;
+#ifdef __CYGWIN__
+ int length;
+ char buf[PATH_MAX * 2];
+ char name[PATH_MAX * TCL_UTF_MAX + 1];
+ GetModuleFileNameW(NULL, buf, PATH_MAX);
+ cygwin_conv_path(3, buf, name, PATH_MAX);
+ length = strlen(name);
+ if ((length > 4) && !strcasecmp(name + length - 4, ".exe")) {
+ /* Strip '.exe' part. */
+ length -= 4;
+ }
+ encoding = Tcl_GetEncoding(NULL, NULL);
+ TclSetObjNameOfExecutable(
+ Tcl_NewStringObj(name, length), encoding);
+#else
+ const char *name, *p;
Tcl_StatBuf statBuf;
Tcl_DString buffer, nameString, cwd, utfName;
- Tcl_Encoding encoding;
if (argv0 == NULL) {
return;
@@ -84,18 +98,18 @@ TclpFindExecutable(
*/
while (1) {
- while (isspace(UCHAR(*p))) { /* INTL: BUG */
+ while (TclIsSpaceProc(*p)) {
p++;
}
name = p;
while ((*p != ':') && (*p != 0)) {
p++;
}
- Tcl_DStringSetLength(&buffer, 0);
+ TclDStringClear(&buffer);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
}
name = Tcl_DStringAppend(&buffer, argv0, -1);
@@ -160,11 +174,10 @@ TclpFindExecutable(
Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&cwd),
Tcl_DStringLength(&cwd), &buffer);
if (Tcl_DStringValue(&cwd)[Tcl_DStringLength(&cwd) -1] != '/') {
- Tcl_DStringAppend(&buffer, "/", 1);
+ TclDStringAppendLiteral(&buffer, "/");
}
Tcl_DStringFree(&cwd);
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(&nameString),
- Tcl_DStringLength(&nameString));
+ TclDStringAppendDString(&buffer, &nameString);
Tcl_DStringFree(&nameString);
encoding = Tcl_GetEncoding(NULL, NULL);
@@ -176,6 +189,7 @@ TclpFindExecutable(
done:
Tcl_DStringFree(&buffer);
+#endif
}
/*
@@ -202,12 +216,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 +242,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);
@@ -243,10 +258,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 +271,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".
@@ -273,7 +287,7 @@ TclpMatchInDirectory(
*/
if (dirName[dirLength-1] != '/') {
- dirName = Tcl_DStringAppend(&dsOrig, "/", 1);
+ dirName = TclDStringAppendLiteral(&dsOrig, "/");
dirLength++;
}
}
@@ -296,10 +310,9 @@ TclpMatchInDirectory(
if (d == NULL) {
Tcl_DStringFree(&ds);
if (interp != NULL) {
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- Tcl_DStringValue(&dsOrig), "\": ",
- Tcl_PosixError(interp), (char *) NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't read directory \"%s\": %s",
+ Tcl_DStringValue(&dsOrig), Tcl_PosixError(interp)));
}
Tcl_DStringFree(&dsOrig);
Tcl_DecrRefCount(fileNamePtr);
@@ -314,11 +327,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
@@ -326,13 +339,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 +391,8 @@ TclpMatchInDirectory(
}
if (matchResult < 0) {
return TCL_ERROR;
- } else {
- return TCL_OK;
}
+ return TCL_OK;
}
/*
@@ -382,13 +400,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 +417,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 +433,126 @@ 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 != '.'))
-#endif
+ || ((types->perm & TCL_GLOB_PERM_HIDDEN) &&
+ (*nativeName != '.'))
+#endif /* MAC_OSX_TCL */
) {
- 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;
- }
- }
- }
- return 0;
+ if ((types->type & TCL_GLOB_TYPE_LINK)
+ && (TclOSlstat(nativeEntry, &buf) == 0)
+ && S_ISLNK(buf.st_mode)) {
+ return 1;
}
+ 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;
- }
- }
- }
-#endif /* S_ISLNK */
- return 0;
+ if ((types->type & TCL_GLOB_TYPE_LINK)
+ && (TclOSlstat(nativeEntry, &buf) == 0)
+ && S_ISLNK(buf.st_mode)) {
+ goto filetypeOK;
}
+#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;
}
@@ -556,26 +577,23 @@ 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 = getpwnam(native); /* INTL: Native. */
+ pwPtr = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (pwPtr == NULL) {
- endpwent();
return NULL;
}
Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
- endpwent();
return Tcl_DStringValue(bufferPtr);
}
@@ -600,12 +618,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 +646,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 +706,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 /* USEGETWD */
+
+ 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;
}
/*
@@ -730,7 +751,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
@@ -742,12 +763,12 @@ TclpGetCwd(
if (getwd(buffer) == NULL) /* INTL: Native. */
#else
if (getcwd(buffer, MAXPATHLEN+1) == NULL) /* INTL: Native. */
-#endif
+#endif /* USEGETWD */
{
if (interp != NULL) {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "error getting working directory name: %s",
+ Tcl_PosixError(interp)));
}
return NULL;
}
@@ -776,14 +797,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);
@@ -798,7 +819,7 @@ TclpReadlink(
return Tcl_DStringValue(linkPtr);
#else
return NULL;
-#endif
+#endif /* !DJGPP */
}
/*
@@ -822,25 +843,25 @@ 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
-Tcl_Obj*
+Tcl_Obj *
TclpObjLink(
Tcl_Obj *pathPtr,
Tcl_Obj *toPtr,
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;
@@ -886,6 +907,9 @@ TclpObjLink(
Tcl_DecrRefCount(dirPtr);
} else {
target = Tcl_FSGetNativePath(toPtr);
+ if (target == NULL) {
+ return NULL;
+ }
if (access(target, F_OK) == -1) {
/*
* Target doesn't exist.
@@ -894,9 +918,6 @@ TclpObjLink(
errno = ENOENT;
return NULL;
}
- if (target == NULL) {
- return NULL;
- }
}
if (access(src, F_OK) != -1) {
@@ -964,12 +985,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;
}
}
@@ -1031,19 +1048,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);
}
/*
@@ -1067,10 +1074,10 @@ TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
char *nativePathPtr;
+ const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
int len;
- char *str;
if (TclFSCwdIsNative()) {
/*
@@ -1098,12 +1105,18 @@ TclNativeCreateNativeRep(
str = Tcl_GetStringFromObj(validPathPtr, &len);
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
+ if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
+ /* See bug [3118489]: NUL in filenames */
+ Tcl_DecrRefCount(validPathPtr);
+ Tcl_DStringFree(&ds);
+ return NULL;
+ }
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;
}
/*
@@ -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 copy;
}
/*
@@ -1169,6 +1182,55 @@ TclpUtime(
return utime(Tcl_FSGetNativePath(pathPtr), tval);
}
+#ifdef __CYGWIN__
+
+int
+TclOSstat(
+ const char *name,
+ void *cygstat)
+{
+ struct stat buf;
+ Tcl_StatBuf *statBuf = cygstat;
+ int result = stat(name, &buf);
+
+ statBuf->st_mode = buf.st_mode;
+ statBuf->st_ino = buf.st_ino;
+ statBuf->st_dev = buf.st_dev;
+ statBuf->st_rdev = buf.st_rdev;
+ statBuf->st_nlink = buf.st_nlink;
+ statBuf->st_uid = buf.st_uid;
+ statBuf->st_gid = buf.st_gid;
+ statBuf->st_size = buf.st_size;
+ statBuf->st_atime = buf.st_atime;
+ statBuf->st_mtime = buf.st_mtime;
+ statBuf->st_ctime = buf.st_ctime;
+ return result;
+}
+
+int
+TclOSlstat(
+ const char *name,
+ void *cygstat)
+{
+ struct stat buf;
+ Tcl_StatBuf *statBuf = cygstat;
+ int result = lstat(name, &buf);
+
+ statBuf->st_mode = buf.st_mode;
+ statBuf->st_ino = buf.st_ino;
+ statBuf->st_dev = buf.st_dev;
+ statBuf->st_rdev = buf.st_rdev;
+ statBuf->st_nlink = buf.st_nlink;
+ statBuf->st_uid = buf.st_uid;
+ statBuf->st_gid = buf.st_gid;
+ statBuf->st_size = buf.st_size;
+ statBuf->st_atime = buf.st_atime;
+ statBuf->st_mtime = buf.st_mtime;
+ statBuf->st_ctime = buf.st_ctime;
+ return result;
+}
+#endif /* CYGWIN */
+
/*
* Local Variables:
* mode: c
generated by cgit v0.12 at 2025-10-26 05:53:49 (GMT)