summaryrefslogtreecommitdiffstats
path: root/win/tclWinFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinFile.c')
-rw-r--r--win/tclWinFile.c216
1 files changed, 95 insertions, 121 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 4a07f04..c0dd4fd 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -149,8 +149,8 @@ typedef struct {
* Other typedefs required by this code.
*/
-static time_t ToCTime(FILETIME fileTime);
-static void FromCTime(time_t posixTime, FILETIME *fileTime);
+static __time64_t ToCTime(FILETIME fileTime);
+static void FromCTime(__time64_t posixTime, FILETIME *fileTime);
/*
* Declarations for local functions defined in this file:
@@ -170,14 +170,14 @@ static int NativeWriteReparse(const WCHAR *LinkDirectory,
static int NativeMatchType(int isDrive, DWORD attr,
const WCHAR *nativeName, Tcl_GlobTypeData *types);
static int WinIsDrive(const char *name, size_t nameLen);
-static int WinIsReserved(const char *path);
+static size_t WinIsReserved(const char *path);
static Tcl_Obj * WinReadLink(const WCHAR *LinkSource);
static Tcl_Obj * WinReadLinkDirectory(const WCHAR *LinkDirectory);
static int WinLink(const WCHAR *LinkSource,
const WCHAR *LinkTarget, int linkAction);
static int WinSymLinkDirectory(const WCHAR *LinkDirectory,
const WCHAR *LinkTarget);
-MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
+MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
/*
*--------------------------------------------------------------------
@@ -808,7 +808,7 @@ NativeWriteReparse(
*----------------------------------------------------------------------
*/
-TCL_NORETURN void
+void
tclWinDebugPanic(
const char *format, ...)
{
@@ -838,16 +838,6 @@ tclWinDebugPanic(
MessageBoxW(NULL, msgString, L"Fatal Error",
MB_ICONSTOP | MB_OK | MB_TASKMODAL | MB_SETFOREGROUND);
}
-#if defined(__GNUC__)
- __builtin_trap();
-#elif defined(_WIN64)
- __debugbreak();
-#elif defined(_MSC_VER) && defined (_M_IX86)
- _asm {int 3}
-#else
- DebugBreak();
-#endif
- abort();
}
/*
@@ -874,21 +864,12 @@ TclpFindExecutable(
{
WCHAR wName[MAX_PATH];
char name[MAX_PATH * 3];
-
- /*
- * Under Windows we ignore argv0, and return the path for the file used to
- * create this process. Only if it is NULL, install a new panic handler.
- */
-
- if (argv0 == NULL) {
-# undef Tcl_SetPanicProc
- Tcl_SetPanicProc(tclWinDebugPanic);
- }
+ (void)argv0;
GetModuleFileNameW(NULL, wName, sizeof(wName)/sizeof(WCHAR));
WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
TclWinNoBackslash(name);
- TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
+ TclSetObjNameOfExecutable(Tcl_NewStringObj(name, TCL_INDEX_NONE), NULL);
}
/*
@@ -938,10 +919,10 @@ TclpMatchInDirectory(
* Match a single file directly.
*/
- int len;
DWORD attr;
WIN32_FILE_ATTRIBUTE_DATA data;
- const char *str = TclGetStringFromObj(norm, &len);
+ Tcl_Size len = 0;
+ const char *str = Tcl_GetStringFromObj(norm, &len);
native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
@@ -951,7 +932,7 @@ TclpMatchInDirectory(
}
attr = data.dwFileAttributes;
- if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
+ if (NativeMatchType(WinIsDrive(str, len), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
@@ -962,7 +943,7 @@ TclpMatchInDirectory(
WIN32_FIND_DATAW data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
- int dirLength;
+ Tcl_Size dirLength;
int matchSpecialDots;
Tcl_DString ds; /* Native encoding of dir, also used
* temporarily for other things. */
@@ -1001,7 +982,7 @@ TclpMatchInDirectory(
*/
Tcl_DStringInit(&dsOrig);
- dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
+ dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
lastChar = dirName[dirLength -1];
@@ -1024,13 +1005,13 @@ TclpMatchInDirectory(
* pattern.
*/
- dirName = Tcl_DStringAppend(&dsOrig, pattern, -1);
+ dirName = Tcl_DStringAppend(&dsOrig, pattern, TCL_INDEX_NONE);
} else {
dirName = TclDStringAppendLiteral(&dsOrig, "*.*");
}
Tcl_DStringInit(&ds);
- native = Tcl_UtfToWCharDString(dirName, -1, &ds);
+ native = Tcl_UtfToWCharDString(dirName, TCL_INDEX_NONE, &ds);
if ((types == NULL) || (types->type != TCL_GLOB_TYPE_DIR)) {
handle = FindFirstFileW(native, &data);
} else {
@@ -1103,7 +1084,7 @@ TclpMatchInDirectory(
native = data.cFileName;
attr = data.dwFileAttributes;
Tcl_DStringInit(&ds);
- utfname = Tcl_WCharToUtfDString(native, -1, &ds);
+ utfname = Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, &ds);
if (!matchSpecialDots) {
/*
@@ -1245,7 +1226,7 @@ WinIsDrive(
* (not any trailing :).
*/
-static int
+static size_t
WinIsReserved(
const char *path) /* Path in UTF-8 */
{
@@ -1457,27 +1438,45 @@ TclpGetUserHome(
if (domain == NULL) {
const char *ptr;
- /*
- * No domain. Firstly check it's the current user
- */
-
+ /*
+ * Treat the current user as a special case because the general case
+ * below does not properly retrieve the path. The NetUserGetInfo
+ * call returns an empty path and the code defaults to the user's
+ * name in the profiles directory. On modern Windows systems, this
+ * is generally wrong as when the account is a Microsoft account,
+ * for example abcdefghi@outlook.com, the directory name is
+ * abcde and not abcdefghi.
+ *
+ * Note we could have just used env(USERPROFILE) here but
+ * the intent is to retrieve (as on Unix) the system's view
+ * of the home irrespective of environment settings of HOME
+ * and USERPROFILE.
+ *
+ * Fixing this for the general user needs more investigating but
+ * at least for the current user we can use a direct call.
+ */
ptr = TclpGetUserName(&ds);
if (ptr != NULL && strcasecmp(name, ptr) == 0) {
- /*
- * Try safest and fastest way to get current user home
- */
-
- ptr = TclGetEnv("HOME", &ds);
- if (ptr != NULL) {
- Tcl_JoinPath(1, &ptr, bufferPtr);
- rc = 1;
- result = Tcl_DStringValue(bufferPtr);
+ HANDLE hProcess;
+ WCHAR buf[MAX_PATH];
+ DWORD nChars = sizeof(buf) / sizeof(buf[0]);
+ /* Sadly GetCurrentProcessToken not in Win 7 so slightly longer */
+ hProcess = GetCurrentProcess(); /* Need not be closed */
+ if (hProcess) {
+ HANDLE hToken;
+ if (OpenProcessToken(hProcess, TOKEN_QUERY, &hToken)) {
+ if (GetUserProfileDirectoryW(hToken, buf, &nChars)) {
+ result = Tcl_WCharToUtfDString(buf, nChars-1, (bufferPtr));
+ rc = 1;
+ }
+ CloseHandle(hToken);
+ }
}
}
Tcl_DStringFree(&ds);
} else {
Tcl_DStringInit(&ds);
- wName = Tcl_UtfToWCharDString(domain + 1, -1, &ds);
+ wName = Tcl_UtfToWCharDString(domain + 1, TCL_INDEX_NONE, &ds);
rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
Tcl_DStringFree(&ds);
nameLen = domain - name;
@@ -1543,30 +1542,6 @@ TclpGetUserHome(
if (wDomain != NULL) {
NetApiBufferFree((void *) wDomain);
}
- if (result == NULL) {
- /*
- * Look in the "Password Lists" section of system.ini for the local
- * user. There are also entries in that section that begin with a "*"
- * character that are used by Windows for other purposes; ignore user
- * names beginning with a "*".
- */
-
- char buf[MAX_PATH];
-
- if (name[0] != '*') {
- if (GetPrivateProfileStringA("Password Lists", name, "", buf,
- MAX_PATH, "system.ini") > 0) {
- /*
- * User exists, but there is no such thing as a home directory
- * in system.ini. Return "{Windows drive}:/".
- */
-
- GetWindowsDirectoryA(buf, MAX_PATH);
- Tcl_DStringAppend(bufferPtr, buf, 3);
- result = Tcl_DStringValue(bufferPtr);
- }
- }
- }
return result;
}
@@ -1685,7 +1660,7 @@ NativeAccess(
}
/*
- * We cannnot verify the access fast, check it below using security
+ * We cannot verify the access fast, check it below using security
* info.
*/
}
@@ -1805,7 +1780,7 @@ NativeAccess(
RevertToSelf();
/*
- * Setup desiredAccess according to the access priveleges we are
+ * Setup desiredAccess according to the access privileges we are
* checking.
*/
@@ -1989,7 +1964,7 @@ TclpGetCwd(
native += 2;
}
Tcl_DStringInit(bufferPtr);
- Tcl_WCharToUtfDString(native, -1, bufferPtr);
+ Tcl_WCharToUtfDString(native, TCL_INDEX_NONE, bufferPtr);
/*
* Convert to forward slashes for easier use in scripts.
@@ -2062,7 +2037,7 @@ NativeStat(
* 'getFileAttributesExProc', and if that isn't available, then on even
* simpler routines.
*
- * Special consideration must be given to Windows hardcoded names like
+ * Special consideration must be given to Windows hard-coded names like
* CON, NULL, COM1, LPT1 etc. For these, we still need to do the
* CreateFile as some may not exist (e.g. there is no CON in wish by
* default). However the subsequent GetFileInformationByHandle will
@@ -2198,7 +2173,7 @@ NativeDev(
GetFullPathNameW(nativePath, MAX_PATH, nativeFullPath, &nativePart);
Tcl_DStringInit(&ds);
- fullPath = Tcl_WCharToUtfDString(nativeFullPath, -1, &ds);
+ fullPath = Tcl_WCharToUtfDString(nativeFullPath, TCL_INDEX_NONE, &ds);
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
const char *p;
@@ -2294,7 +2269,7 @@ NativeStatMode(
*
* ToCTime --
*
- * Converts a Windows FILETIME to a time_t in UTC.
+ * Converts a Windows FILETIME to a __time64_t in UTC.
*
* Results:
* Returns the count of seconds from the Posix epoch.
@@ -2302,7 +2277,7 @@ NativeStatMode(
*------------------------------------------------------------------------
*/
-static time_t
+static __time64_t
ToCTime(
FILETIME fileTime) /* UTC time */
{
@@ -2311,7 +2286,7 @@ ToCTime(
convertedTime.LowPart = fileTime.dwLowDateTime;
convertedTime.HighPart = (LONG) fileTime.dwHighDateTime;
- return (time_t) ((convertedTime.QuadPart -
+ return (__time64_t) ((convertedTime.QuadPart -
(long long) POSIX_EPOCH_AS_FILETIME) / (long long) 10000000);
}
@@ -2320,7 +2295,7 @@ ToCTime(
*
* FromCTime --
*
- * Converts a time_t to a Windows FILETIME
+ * Converts a __time64_t to a Windows FILETIME
*
* Results:
* Returns the count of 100-ns ticks seconds from the Windows epoch.
@@ -2330,7 +2305,7 @@ ToCTime(
static void
FromCTime(
- time_t posixTime,
+ __time64_t posixTime,
FILETIME *fileTime) /* UTC Time */
{
LARGE_INTEGER convertedTime;
@@ -2353,7 +2328,7 @@ FromCTime(
* is either the given clientData, if the working directory hasn't
* changed, or a new clientData (owned by our caller), giving the new
* native path, or NULL if the current directory could not be determined.
- * If NULL is returned, the caller can examine the standard posix error
+ * If NULL is returned, the caller can examine the standard Posix error
* codes to determine the cause of the problem.
*
* Side effects:
@@ -2362,9 +2337,9 @@ FromCTime(
*----------------------------------------------------------------------
*/
-ClientData
+void *
TclpGetNativeCwd(
- ClientData clientData)
+ void *clientData)
{
WCHAR buffer[MAX_PATH];
@@ -2477,12 +2452,12 @@ TclpFilesystemPathType(
if (normPath == NULL) {
return NULL;
}
- path = Tcl_GetString(normPath);
+ path = TclGetString(normPath);
if (path == NULL) {
return NULL;
}
- firstSeparator = strchr(path, '/');
+ firstSeparator = strchr((char *)path, '/');
if (firstSeparator == NULL) {
found = GetVolumeInformationW((const WCHAR *)Tcl_FSGetNativePath(pathPtr),
NULL, 0, NULL, NULL, NULL, volType, VOL_BUF_SIZE);
@@ -2501,8 +2476,8 @@ TclpFilesystemPathType(
Tcl_DString ds;
Tcl_DStringInit(&ds);
- Tcl_WCharToUtfDString(volType, -1, &ds);
- return TclDStringToObj(&ds);
+ Tcl_WCharToUtfDString(volType, TCL_INDEX_NONE, &ds);
+ return Tcl_DStringToObj(&ds);
}
#undef VOL_BUF_SIZE
}
@@ -2557,7 +2532,7 @@ TclpObjNormalizePath(
Tcl_DString ds; /* Some workspace. */
Tcl_DStringInit(&dsNorm);
- path = Tcl_GetString(pathPtr);
+ path = TclGetString(pathPtr);
currentPathEndPosition = path + nextCheckpoint;
if (*currentPathEndPosition == '/') {
@@ -2585,17 +2560,17 @@ TclpObjNormalizePath(
*/
if (isDrive) {
- int len = WinIsReserved(path);
+ size_t len = WinIsReserved(path);
if (len > 0) {
/*
* Actually it does exist - COM1, etc.
*/
- int i;
+ size_t i;
for (i=0 ; i<len ; i++) {
- WCHAR wc = ((WCHAR *) nativePath)[i];
+ WCHAR wc = ((WCHAR *)nativePath)[i];
if (wc >= 'a') {
wc -= ('a' - 'A');
@@ -2604,7 +2579,7 @@ TclpObjNormalizePath(
}
Tcl_DStringAppend(&dsNorm,
(const char *)nativePath,
- (int)(sizeof(WCHAR) * len));
+ sizeof(WCHAR) * len);
lastValidPathEnd = currentPathEndPosition;
} else if (nextCheckpoint == 0) {
/*
@@ -2649,18 +2624,18 @@ TclpObjNormalizePath(
*/
nextCheckpoint = 0;
- Tcl_AppendToObj(to, currentPathEndPosition, -1);
+ Tcl_AppendToObj(to, currentPathEndPosition, TCL_INDEX_NONE);
/*
* Convert link to forward slashes.
*/
- for (path = Tcl_GetString(to); *path != 0; path++) {
+ for (path = TclGetString(to); *path != 0; path++) {
if (*path == '\\') {
*path = '/';
}
}
- path = Tcl_GetString(to);
+ path = TclGetString(to);
currentPathEndPosition = path + nextCheckpoint;
if (temp != NULL) {
Tcl_DecrRefCount(temp);
@@ -2750,7 +2725,7 @@ TclpObjNormalizePath(
sizeof(WCHAR));
Tcl_DStringAppend(&dsNorm,
(const char *) nativeName,
- (int) (wcslen(nativeName)*sizeof(WCHAR)));
+ wcslen(nativeName)*sizeof(WCHAR));
}
}
}
@@ -2820,13 +2795,13 @@ TclpObjNormalizePath(
* Not the end of the string.
*/
- int len;
Tcl_Obj *tmpPathPtr;
+ Tcl_Size len;
tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
- Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
- path = TclGetStringFromObj(tmpPathPtr, &len);
+ Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, TCL_INDEX_NONE);
+ path = Tcl_GetStringFromObj(tmpPathPtr, &len);
Tcl_SetStringObj(pathPtr, path, len);
Tcl_DecrRefCount(tmpPathPtr);
} else {
@@ -2895,10 +2870,10 @@ TclWinVolumeRelativeNormalize(
* current volume.
*/
- const char *drive = Tcl_GetString(useThisCwd);
+ const char *drive = TclGetString(useThisCwd);
absolutePath = Tcl_NewStringObj(drive,2);
- Tcl_AppendToObj(absolutePath, path, -1);
+ Tcl_AppendToObj(absolutePath, path, TCL_INDEX_NONE);
Tcl_IncrRefCount(absolutePath);
/*
@@ -2910,8 +2885,8 @@ TclWinVolumeRelativeNormalize(
* also on drive C.
*/
- int cwdLen;
- const char *drive = TclGetStringFromObj(useThisCwd, &cwdLen);
+ Tcl_Size cwdLen;
+ const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
char drive_cur = path[0];
if (drive_cur >= 'a') {
@@ -2951,7 +2926,7 @@ TclWinVolumeRelativeNormalize(
Tcl_AppendToObj(absolutePath, "/", 1);
}
Tcl_IncrRefCount(absolutePath);
- Tcl_AppendToObj(absolutePath, path+2, -1);
+ Tcl_AppendToObj(absolutePath, path+2, TCL_INDEX_NONE);
}
*useThisCwdPtr = useThisCwd;
return absolutePath;
@@ -2980,15 +2955,15 @@ TclWinVolumeRelativeNormalize(
Tcl_Obj *
TclpNativeToNormalized(
- ClientData clientData)
+ void *clientData)
{
Tcl_DString ds;
Tcl_Obj *objPtr;
- int len;
+ size_t len;
char *copy, *p;
Tcl_DStringInit(&ds);
- Tcl_WCharToUtfDString((const WCHAR *) clientData, -1, &ds);
+ Tcl_WCharToUtfDString((const WCHAR *) clientData, TCL_INDEX_NONE, &ds);
copy = Tcl_DStringValue(&ds);
len = Tcl_DStringLength(&ds);
@@ -3040,14 +3015,14 @@ TclpNativeToNormalized(
*---------------------------------------------------------------------------
*/
-ClientData
+void *
TclNativeCreateNativeRep(
Tcl_Obj *pathPtr)
{
WCHAR *nativePathPtr = NULL;
const char *str;
Tcl_Obj *validPathPtr;
- size_t len;
+ Tcl_Size len;
WCHAR *wp;
if (TclFSCwdIsNative()) {
@@ -3084,10 +3059,9 @@ TclNativeCreateNativeRep(
Tcl_IncrRefCount(validPathPtr);
}
- str = Tcl_GetString(validPathPtr);
- len = validPathPtr->length;
+ str = Tcl_GetStringFromObj(validPathPtr, &len);
- if (strlen(str) != len) {
+ if (strlen(str) != (size_t)len) {
/*
* String contains NUL-bytes. This is invalid.
*/
@@ -3116,7 +3090,7 @@ TclNativeCreateNativeRep(
* Overallocate 6 chars, making some room for extended paths
*/
- wp = nativePathPtr = (WCHAR *)ckalloc((len + 6) * sizeof(WCHAR));
+ wp = nativePathPtr = (WCHAR *)Tcl_Alloc((len + 6) * sizeof(WCHAR));
if (nativePathPtr==0) {
goto done;
}
@@ -3202,9 +3176,9 @@ TclNativeCreateNativeRep(
*---------------------------------------------------------------------------
*/
-ClientData
+void *
TclNativeDupInternalRep(
- ClientData clientData)
+ void *clientData)
{
char *copy;
size_t len;
@@ -3215,7 +3189,7 @@ TclNativeDupInternalRep(
len = sizeof(WCHAR) * (wcslen((const WCHAR *) clientData) + 1);
- copy = (char *)ckalloc(len);
+ copy = (char *)Tcl_Alloc(len);
memcpy(copy, clientData, len);
return copy;
}
@@ -3331,7 +3305,7 @@ TclWinFileOwned(
bufsz = 0;
GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
if (bufsz) {
- buf = (LPBYTE)ckalloc(bufsz);
+ buf = (LPBYTE)Tcl_Alloc(bufsz);
if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
}
@@ -3347,7 +3321,7 @@ TclWinFileOwned(
LocalFree(secd); /* Also frees ownerSid */
}
if (buf) {
- ckfree(buf);
+ Tcl_Free(buf);
}
return (owned != 0); /* Convert non-0 to 1 */
generated by cgit v0.12 at 2024-09-12 13:28:42 (GMT)