summaryrefslogtreecommitdiffstats
path: root/win/tclWinFile.c
diff options
context:
space:
mode:
Diffstat (limited to 'win/tclWinFile.c')
-rw-r--r--win/tclWinFile.c991
1 files changed, 637 insertions, 354 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index b43ff51..e7dce3f 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -6,58 +6,68 @@
* files, which can be manipulated through the Win32 console redirection
* interfaces.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * 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: tclWinFile.c,v 1.4 1999/03/10 05:52:53 stanton Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.5 1999/04/16 00:48:08 stanton Exp $
*/
#include "tclWinInt.h"
#include <sys/stat.h>
#include <shlobj.h>
+#include <lmaccess.h> /* For TclpGetUserHome(). */
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
+static time_t ToCTime(FILETIME fileTime);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC
+ (LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr);
-static char *currentDir = NULL;
+typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC
+ (LPVOID Buffer);
+
+typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC
+ (LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr);
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * Tcl_FindExecutable --
+ * TclpFindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
- * None.
+ * A dirty UTF string that is the path to the executable. At this
+ * point we may not know the system encoding. Convert the native
+ * string value to UTF using the default encoding. The assumption
+ * is that we will still be able to parse the path given the path
+ * name contains ASCII string and '/' chars do not conflict with
+ * other UTF chars.
*
* Side effects:
- * The variable tclExecutableName gets filled in with the file
+ * The variable tclNativeExecutableName gets filled in with the file
* name for the application, if we figured it out. If we couldn't
- * figure it out, Tcl_FindExecutable is set to NULL.
+ * figure it out, tclNativeExecutableName is set to NULL.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-void
-Tcl_FindExecutable(argv0)
- char *argv0; /* The value of the application's argv[0]. */
+char *
+TclpFindExecutable(argv0)
+ CONST char *argv0; /* The value of the application's argv[0]
+ * (native). */
{
- Tcl_DString buffer;
- int length;
-
- Tcl_DStringInit(&buffer);
+ Tcl_DString ds;
+ WCHAR wName[MAX_PATH];
- if (tclExecutableName != NULL) {
- ckfree(tclExecutableName);
- tclExecutableName = NULL;
+ if (argv0 == NULL) {
+ return NULL;
+ }
+ if (tclNativeExecutableName != NULL) {
+ return tclNativeExecutableName;
}
/*
@@ -65,26 +75,28 @@ Tcl_FindExecutable(argv0)
* create this process.
*/
- Tcl_DStringSetLength(&buffer, MAX_PATH+1);
- length = GetModuleFileName(NULL, Tcl_DStringValue(&buffer), MAX_PATH+1);
- if (length > 0) {
- tclExecutableName = (char *) ckalloc((unsigned) (length + 1));
- strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
- }
- Tcl_DStringFree(&buffer);
+ (*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH);
+ Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds);
+
+ tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1));
+ strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+
+ TclWinNoBackslash(tclNativeExecutableName);
+ return tclNativeExecutableName;
}
/*
*----------------------------------------------------------------------
*
- * TclMatchFiles --
+ * TclpMatchFiles --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
+ * added to the the interp's result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
@@ -95,25 +107,27 @@ Tcl_FindExecutable(argv0)
*---------------------------------------------------------------------- */
int
-TclMatchFiles(interp, separators, dirPtr, pattern, tail)
+TclpMatchFiles(interp, separators, dirPtr, pattern, tail)
Tcl_Interp *interp; /* Interpreter to receive results. */
char *separators; /* Directory separators to pass to TclDoGlob. */
Tcl_DString *dirPtr; /* Contains path to directory to search. */
char *pattern; /* Pattern to match against. */
char *tail; /* Pointer to end of pattern. Tail must
- * point to a location in pattern. */
+ * point to a location in pattern. Must not
+ * point to a static string. */
{
- char drivePattern[4] = "?:\\";
- char *newPattern, *p, *dir, *root, c;
- char *src, *dest;
- int length, matchDotFiles;
- int result = TCL_OK;
- int baseLength = Tcl_DStringLength(dirPtr);
- Tcl_DString buffer;
- DWORD atts, volFlags;
+ char drivePat[] = "?:\\";
+ const char *message;
+ char *dir, *newPattern, *root;
+ int matchDotFiles;
+ int dirLength, result = TCL_OK;
+ Tcl_DString dirString, patternString;
+ DWORD attr, volFlags;
HANDLE handle;
- WIN32_FIND_DATA data;
+ WIN32_FIND_DATAT data;
BOOL found;
+ Tcl_DString ds;
+ TCHAR *nativeName;
/*
* Convert the path to normalized form since some interfaces only
@@ -121,31 +135,37 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* separator character.
*/
- Tcl_DStringInit(&buffer);
- if (baseLength == 0) {
- Tcl_DStringAppend(&buffer, ".", 1);
+ dirLength = Tcl_DStringLength(dirPtr);
+ Tcl_DStringInit(&dirString);
+ if (dirLength == 0) {
+ Tcl_DStringAppend(&dirString, ".\\", 2);
} else {
- Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
+ char *p;
+
+ Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr),
Tcl_DStringLength(dirPtr));
- }
- for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
- if (*p == '/') {
- *p = '\\';
+ for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) {
+ if (*p == '/') {
+ *p = '\\';
+ }
+ }
+ p--;
+ if ((*p != '\\') && (*p != ':')) {
+ Tcl_DStringAppend(&dirString, "\\", 1);
}
}
- p--;
- if (*p != '\\' && *p != ':') {
- Tcl_DStringAppend(&buffer, "\\", 1);
- }
- dir = Tcl_DStringValue(&buffer);
-
+ dir = Tcl_DStringValue(&dirString);
+
/*
* First verify that the specified path is actually a directory.
*/
- atts = GetFileAttributes(dir);
- if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
- Tcl_DStringFree(&buffer);
+ nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
+
+ if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
+ Tcl_DStringFree(&dirString);
return TCL_OK;
}
@@ -158,82 +178,69 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
switch (Tcl_GetPathType(dir)) {
case TCL_PATH_RELATIVE:
- found = GetVolumeInformation(NULL, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
break;
case TCL_PATH_VOLUME_RELATIVE:
- if (*dir == '\\') {
+ if (dir[0] == '\\') {
root = NULL;
} else {
- root = drivePattern;
- *root = *dir;
+ root = drivePat;
+ *root = dir[0];
}
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
break;
case TCL_PATH_ABSOLUTE:
if (dir[1] == ':') {
- root = drivePattern;
- *root = *dir;
- found = GetVolumeInformation(root, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
+ root = drivePat;
+ *root = dir[0];
+ found = GetVolumeInformationA(root, NULL, 0, NULL, NULL,
+ &volFlags, NULL, 0);
} else if (dir[1] == '\\') {
- p = strchr(dir+2, '\\');
- p = strchr(p+1, '\\');
+ char *p;
+
+ p = strchr(dir + 2, '\\');
+ p = strchr(p + 1, '\\');
p++;
- c = *p;
- *p = 0;
- found = GetVolumeInformation(dir, NULL, 0, NULL,
- NULL, &volFlags, NULL, 0);
- *p = c;
+ nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds);
+ found = (*tclWinProcs->getVolumeInformationProc)(nativeName,
+ NULL, 0, NULL, NULL, &volFlags, NULL, 0);
+ Tcl_DStringFree(&ds);
}
break;
}
- if (!found) {
- Tcl_DStringFree(&buffer);
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read volume information for \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- return TCL_ERROR;
+ if (found == 0) {
+ message = "couldn't read volume information for \"";
+ goto error;
}
-
+
/*
* In Windows, although some volumes may support case sensitivity, Windows
* doesn't honor case. So in globbing we need to ignore the case
* of file names.
*/
- length = tail - pattern;
- newPattern = ckalloc(length+1);
- for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
- *dest = (char) tolower(*src);
+ Tcl_DStringInit(&patternString);
+ newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern);
+ if ((volFlags & FS_CASE_SENSITIVE) == 0) {
+ Tcl_UtfToLower(newPattern);
}
- *dest = '\0';
-
+
/*
* We need to check all files in the directory, so append a *.*
* to the path.
*/
-
- dir = Tcl_DStringAppend(&buffer, "*.*", 3);
-
- /*
- * Now open the directory for reading and iterate over the contents.
- */
-
- handle = FindFirstFile(dir, &data);
- Tcl_DStringFree(&buffer);
+ dir = Tcl_DStringAppend(&dirString, "*.*", 3);
+ nativeName = Tcl_WinUtfToTChar(dir, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data);
+ Tcl_DStringFree(&ds);
if (handle == INVALID_HANDLE_VALUE) {
- TclWinConvertError(GetLastError());
- Tcl_ResetResult(interp);
- Tcl_AppendResult(interp, "couldn't read directory \"",
- dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);
- ckfree(newPattern);
- return TCL_ERROR;
+ message = "couldn't read directory \"";
+ goto error;
}
/*
@@ -265,42 +272,41 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* Now iterate over all of the files in the directory.
*/
- Tcl_DStringInit(&buffer);
- for (found = 1; found; found = FindNextFile(handle, &data)) {
- char *matchResult;
-
- /*
- * Ignore hidden files.
- */
+ for (found = 1; found != 0;
+ found = (*tclWinProcs->findNextFileProc)(handle, &data)) {
+ TCHAR *nativeMatchResult;
+ char *name;
- if (!matchDotFiles && (data.cFileName[0] == '.')) {
- continue;
+ if (tclWinProcs->useWide) {
+ nativeName = (TCHAR *) data.w.cFileName;
+ } else {
+ nativeName = (TCHAR *) data.a.cFileName;
}
+ name = Tcl_WinTCharToUtf(nativeName, -1, &ds);
/*
* Check to see if the file matches the pattern. We need to convert
* the file name to lower case for comparison purposes. Note that we
* are ignoring the case sensitivity flag because Windows doesn't honor
* case even if the volume is case sensitive. If the volume also
- * doesn't preserve case, then we return the lower case form of the
- * name, otherwise we return the system form.
+ * doesn't preserve case, then we previously returned the lower case
+ * form of the name. This didn't seem quite right since there are
+ * non-case-preserving volumes that actually return mixed case. So now
+ * we are returning exactly what we get from the system.
*/
- matchResult = NULL;
- Tcl_DStringSetLength(&buffer, 0);
- Tcl_DStringAppend(&buffer, data.cFileName, -1);
- for (p = buffer.string; *p != '\0'; p++) {
- *p = (char) tolower(*p);
- }
- if (Tcl_StringMatch(buffer.string, newPattern)) {
- if (volFlags & FS_CASE_IS_PRESERVED) {
- matchResult = data.cFileName;
- } else {
- matchResult = buffer.string;
- }
- }
+ Tcl_UtfToLower(name);
+ nativeMatchResult = NULL;
- if (matchResult == NULL) {
+ if ((matchDotFiles == 0) && (name[0] == '.')) {
+ /*
+ * Ignore hidden files.
+ */
+ } else if (Tcl_StringMatch(name, newPattern) != 0) {
+ nativeMatchResult = nativeName;
+ }
+ Tcl_DStringFree(&ds);
+ if (nativeMatchResult == NULL) {
continue;
}
@@ -311,13 +317,19 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
* file to the result.
*/
- Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, matchResult, -1);
+ name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds);
+ Tcl_DStringAppend(dirPtr, name, -1);
+ Tcl_DStringFree(&ds);
+
if (tail == NULL) {
- Tcl_AppendElement(interp, dirPtr->string);
+ Tcl_AppendElement(interp, Tcl_DStringValue(dirPtr));
} else {
- atts = GetFileAttributes(dirPtr->string);
- if (atts & FILE_ATTRIBUTE_DIRECTORY) {
+ nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(dirPtr),
+ Tcl_DStringLength(dirPtr), &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativeName);
+ Tcl_DStringFree(&ds);
+
+ if (attr & FILE_ATTRIBUTE_DIRECTORY) {
Tcl_DStringAppend(dirPtr, "/", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
@@ -325,211 +337,353 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail)
}
}
}
+ Tcl_DStringSetLength(dirPtr, dirLength);
}
- Tcl_DStringFree(&buffer);
FindClose(handle);
- ckfree(newPattern);
+ Tcl_DStringFree(&dirString);
+ Tcl_DStringFree(&patternString);
+
return result;
+
+ error:
+ Tcl_DStringFree(&dirString);
+ TclWinConvertError(GetLastError());
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * TclChdir --
+ * TclpGetUserHome --
*
- * Change the current working directory.
+ * This function takes the passed in user name and finds the
+ * corresponding home directory specified in the password file.
*
* Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
+ * The result is a pointer to a string specifying the user's home
+ * directory, or NULL if the user's home directory could not be
+ * determined. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
*
* Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
+ * None.
*
*----------------------------------------------------------------------
*/
-int
-TclChdir(interp, dirName)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
- char *dirName; /* Path to new working directory. */
+char *
+TclpGetUserHome(name, bufferPtr)
+ CONST char *name; /* User name for desired home directory. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of user's home directory. */
{
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
+ char *result;
+ HINSTANCE netapiInst;
+
+ result = NULL;
+
+ Tcl_DStringInit(bufferPtr);
+
+ netapiInst = LoadLibraryA("netapi32.dll");
+ if (netapiInst != NULL) {
+ NETAPIBUFFERFREEPROC *netApiBufferFreeProc;
+ NETGETDCNAMEPROC *netGetDCNameProc;
+ NETUSERGETINFOPROC *netUserGetInfoProc;
+
+ netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *)
+ GetProcAddress(netapiInst, "NetApiBufferFree");
+ netGetDCNameProc = (NETGETDCNAMEPROC *)
+ GetProcAddress(netapiInst, "NetGetDCName");
+ netUserGetInfoProc = (NETUSERGETINFOPROC *)
+ GetProcAddress(netapiInst, "NetUserGetInfo");
+ if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL)
+ && (netApiBufferFreeProc != NULL)) {
+ USER_INFO_1 *uiPtr;
+ Tcl_DString ds;
+ int nameLen, badDomain;
+ char *domain;
+ WCHAR *wName, *wHomeDir, *wDomain;
+ WCHAR buf[MAX_PATH];
+
+ badDomain = 0;
+ nameLen = -1;
+ wDomain = NULL;
+ domain = strchr(name, '@');
+ if (domain != NULL) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
+ badDomain = (*netGetDCNameProc)(NULL, wName,
+ (LPBYTE *) &wDomain);
+ Tcl_DStringFree(&ds);
+ nameLen = domain - name;
+ }
+ if (badDomain == 0) {
+ Tcl_DStringInit(&ds);
+ wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
+ if ((*netUserGetInfoProc)(wDomain, wName, 1,
+ (LPBYTE *) &uiPtr) == 0) {
+ wHomeDir = uiPtr->usri1_home_dir;
+ if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
+ Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
+ bufferPtr);
+ } else {
+ /*
+ * User exists but has no home dir. Return
+ * "{Windows Drive}:/users/default".
+ */
+
+ GetWindowsDirectoryW(buf, MAX_PATH);
+ Tcl_UniCharToUtfDString(buf, 2, bufferPtr);
+ Tcl_DStringAppend(bufferPtr, "/users/default", -1);
+ }
+ result = Tcl_DStringValue(bufferPtr);
+ (*netApiBufferFreeProc)((void *) uiPtr);
+ }
+ Tcl_DStringFree(&ds);
+ }
+ if (wDomain != NULL) {
+ (*netApiBufferFreeProc)((void *) wDomain);
+ }
+ }
+ FreeLibrary(netapiInst);
}
- if (!SetCurrentDirectory(dirName)) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
+ 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 TCL_ERROR;
}
- return TCL_OK;
+
+ return result;
}
/*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*
- * TclGetCwd --
+ * TclpAccess --
*
- * Return the path name of the current working directory.
+ * This function replaces the library version of access(), fixing the
+ * following bugs:
+ *
+ * 1. access() returns that all files have execute permission.
*
* Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it
- * out. If an error occurs and interp isn't NULL, an error
- * message is left in interp->result.
+ * See access documentation.
*
* Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
+ * See access documentation.
*
- *----------------------------------------------------------------------
+ *---------------------------------------------------------------------------
*/
-char *
-TclGetCwd(interp)
- Tcl_Interp *interp; /* If non NULL, used for error reporting. */
+int
+TclpAccess(
+ CONST char *path, /* Path of file to access (UTF-8). */
+ int mode) /* Permission setting. */
{
- static char buffer[MAXPATHLEN+1];
- char *bufPtr, *p;
-
- if (currentDir == NULL) {
- if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
- TclWinConvertError(GetLastError());
- if (interp != NULL) {
- if (errno == ERANGE) {
- Tcl_SetResult(interp,
- "working directory name is too long",
- TCL_STATIC);
- } else {
- Tcl_AppendResult(interp,
- "error getting working directory name: ",
- Tcl_PosixError(interp), (char *) NULL);
- }
- }
- return NULL;
- }
+ Tcl_DString ds;
+ TCHAR *nativePath;
+ DWORD attr;
+
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ Tcl_DStringFree(&ds);
+
+ if (attr == 0xffffffff) {
/*
- * Watch for the wierd Windows '95 c:\\UNC syntax.
+ * File doesn't exist.
*/
- if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
- && buffer[3] == '\\') {
- bufPtr = &buffer[2];
- } else {
- bufPtr = buffer;
- }
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) {
/*
- * Convert to forward slashes for easier use in scripts.
+ * File is not writable.
*/
- for (p = bufPtr; *p != '\0'; p++) {
- if (*p == '\\') {
- *p = '/';
+ Tcl_SetErrno(EACCES);
+ return -1;
+ }
+
+ if (mode & X_OK) {
+ CONST char *p;
+
+ if (attr & FILE_ATTRIBUTE_DIRECTORY) {
+ /*
+ * Directories are always executable.
+ */
+
+ return 0;
+ }
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ p++;
+ if ((stricmp(p, "exe") == 0)
+ || (stricmp(p, "com") == 0)
+ || (stricmp(p, "bat") == 0)) {
+ /*
+ * File that ends with .exe, .com, or .bat is executable.
+ */
+
+ return 0;
}
}
+ Tcl_SetErrno(EACCES);
+ return -1;
}
- return bufPtr;
+
+ return 0;
}
-#if 0
/*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
- * TclWinResolveShortcut --
+ * TclpChdir --
*
- * Resolve a potential Windows shortcut to get the actual file or
- * directory in question.
+ * This function replaces the library version of chdir().
*
* Results:
- * Returns 1 if the shortcut could be resolved, or 0 if there was
- * an error or if the filename was not a shortcut.
- * If bufferPtr did hold the name of a shortcut, it is modified to
- * hold the resolved target of the shortcut instead.
+ * See chdir() documentation.
*
* Side effects:
- * Loads and unloads OLE package to determine if filename refers to
- * a shortcut.
+ * See chdir() documentation.
*
- *-------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
-TclWinResolveShortcut(bufferPtr)
- Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
- * return, holds resolved file name. */
+TclpChdir(path)
+ CONST char *path; /* Path to new working directory (UTF-8). */
{
- HRESULT hres;
- IShellLink *psl;
- IPersistFile *ppf;
- WIN32_FIND_DATA wfd;
- WCHAR wpath[MAX_PATH];
- char *path, *ext;
- char realFileName[MAX_PATH];
+ int result;
+ Tcl_DString ds;
+ TCHAR *nativePath;
+
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath);
+ Tcl_DStringFree(&ds);
+
+ if (result == 0) {
+ TclWinConvertError(GetLastError());
+ return -1;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetCwd(interp, bufferPtr)
+ Tcl_Interp *interp; /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr; /* Uninitialized or free DString filled
+ * with name of current directory. */
+{
+ WCHAR buffer[MAX_PATH];
+ char *p;
+
+ if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) {
+ TclWinConvertError(GetLastError());
+ if (interp != NULL) {
+ Tcl_AppendResult(interp,
+ "error getting working directory name: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ }
+ return NULL;
+ }
/*
- * Windows system calls do not automatically resolve
- * shortcuts like UNIX automatically will with symbolic links.
+ * Watch for the wierd Windows c:\\UNC syntax.
*/
- path = Tcl_DStringValue(bufferPtr);
- ext = strrchr(path, '.');
- if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
- return 0;
- }
+ if (tclWinProcs->useWide) {
+ WCHAR *native;
- CoInitialize(NULL);
- path = Tcl_DStringValue(bufferPtr);
- realFileName[0] = '\0';
- hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
- &IID_IShellLink, &psl);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
- if (SUCCEEDED(hres)) {
- MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
- hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->Resolve(psl, NULL,
- SLR_ANY_MATCH | SLR_NO_UI);
- if (SUCCEEDED(hres)) {
- hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
- &wfd, 0);
- }
- }
- ppf->lpVtbl->Release(ppf);
- }
- psl->lpVtbl->Release(psl);
- }
- CoUninitialize();
+ native = (WCHAR *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
+ } else {
+ char *native;
- if (realFileName[0] != '\0') {
- Tcl_DStringSetLength(bufferPtr, 0);
- Tcl_DStringAppend(bufferPtr, realFileName, -1);
- return 1;
+ native = (char *) buffer;
+ if ((native[0] != '\0') && (native[1] == ':')
+ && (native[2] == '\\') && (native[3] == '\\')) {
+ native += 2;
+ }
+ Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr);
}
- return 0;
+
+ /*
+ * Convert to forward slashes for easier use in scripts.
+ */
+
+ for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) {
+ if (*p == '\\') {
+ *p = '/';
+ }
+ }
+ return Tcl_DStringValue(bufferPtr);
}
-#endif
/*
*----------------------------------------------------------------------
*
- * TclpStat, TclpLstat --
+ * TclpStat --
*
- * These functions replace the library versions of stat and lstat.
+ * This function replaces the library version of stat(), fixing
+ * the following bugs:
*
- * The stat and lstat functions provided by some Windows compilers
- * are incomplete. Ideally, a complete rewrite of stat would go
- * here; now, the only fix is that stat("c:") used to return an
- * error instead infor for current dir on specified drive.
+ * 1. stat("c:") returns an error.
+ * 2. Borland stat() return time in GMT instead of localtime.
+ * 3. stat("\\server\mount") would return error.
+ * 4. Accepts slashes or backslashes.
+ * 5. st_dev and st_rdev were wrong for UNC paths.
*
* Results:
* See stat documentation.
@@ -541,25 +695,164 @@ TclWinResolveShortcut(bufferPtr)
*/
int
-TclpStat(path, buf)
- CONST char *path; /* Path of file to stat (in current CP). */
- struct stat *buf; /* Filled with results of stat call. */
+TclpStat(path, statPtr)
+ CONST char *path; /* Path of file to stat (UTF-8). */
+ struct stat *statPtr; /* Filled with results of stat call. */
{
- char name[4];
- int result;
+ Tcl_DString ds;
+ TCHAR *nativePath;
+ WIN32_FIND_DATAT data;
+ HANDLE handle;
+ DWORD attr;
+ WCHAR nativeFullPath[MAX_PATH];
+ TCHAR *nativePart;
+ char *p, *fullPath;
+ int dev, mode;
- if ((strlen(path) == 2) && (path[1] == ':')) {
- strcpy(name, path);
- name[2] = '.';
- name[3] = '\0';
- path = name;
+ /*
+ * Eliminate file names containing wildcard characters, or subsequent
+ * call to FindFirstFile() will expand them, matching some other file.
+ */
+
+ if (strpbrk(path, "?*") != NULL) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
}
-#undef stat
+ nativePath = Tcl_WinUtfToTChar(path, -1, &ds);
+ handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data);
+ if (handle == INVALID_HANDLE_VALUE) {
+ /*
+ * FindFirstFile() doesn't work on root directories, so call
+ * GetFileAttributes() to see if the specified file exists.
+ */
- result = stat(path, buf);
+ attr = (*tclWinProcs->getFileAttributesProc)(nativePath);
+ if (attr == 0xffffffff) {
+ Tcl_DStringFree(&ds);
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+
+ /*
+ * Make up some fake information for this file. It has the
+ * correct file attributes and a time of 0.
+ */
-#ifndef _MSC_VER
+ memset(&data, 0, sizeof(data));
+ data.a.dwFileAttributes = attr;
+ } else {
+ FindClose(handle);
+ }
+
+ (*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath,
+ &nativePart);
+
+ Tcl_DStringFree(&ds);
+ fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds);
+
+ dev = -1;
+ if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) {
+ char *p;
+ DWORD dw;
+ TCHAR *nativeVol;
+ Tcl_DString volString;
+
+ p = strchr(fullPath + 2, '\\');
+ p = strchr(p + 1, '\\');
+ if (p == NULL) {
+ /*
+ * Add terminating backslash to fullpath or
+ * GetVolumeInformation() won't work.
+ */
+
+ fullPath = Tcl_DStringAppend(&ds, "\\", 1);
+ p = fullPath + Tcl_DStringLength(&ds);
+ } else {
+ p++;
+ }
+ nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString);
+ dw = (DWORD) -1;
+ (*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw,
+ NULL, NULL, NULL, 0);
+ /*
+ * GetFullPathName() turns special devices like "NUL" into "\\.\NUL",
+ * but GetVolumeInformation() returns failure for "\\.\NUL". This
+ * will cause "NUL" to get a drive number of -1, which makes about
+ * as much sense as anything since the special devices don't live on
+ * any drive.
+ */
+
+ dev = dw;
+ Tcl_DStringFree(&volString);
+ } else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) {
+ dev = Tcl_UniCharToLower(fullPath[0]) - 'a';
+ }
+ Tcl_DStringFree(&ds);
+
+ attr = data.a.dwFileAttributes;
+ mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG;
+ mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE;
+ p = strrchr(path, '.');
+ if (p != NULL) {
+ if ((lstrcmpiA(p, ".exe") == 0)
+ || (lstrcmpiA(p, ".com") == 0)
+ || (lstrcmpiA(p, ".bat") == 0)
+ || (lstrcmpiA(p, ".pif") == 0)) {
+ mode |= S_IEXEC;
+ }
+ }
+
+ /*
+ * Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and
+ * other positions.
+ */
+
+ mode |= (mode & 0x0700) >> 3;
+ mode |= (mode & 0x0700) >> 6;
+
+ statPtr->st_dev = (dev_t) dev;
+ statPtr->st_ino = 0;
+ statPtr->st_mode = (unsigned short) mode;
+ statPtr->st_nlink = 1;
+ statPtr->st_uid = 0;
+ statPtr->st_gid = 0;
+ statPtr->st_rdev = (dev_t) dev;
+ statPtr->st_size = data.a.nFileSizeLow;
+ statPtr->st_atime = ToCTime(data.a.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.a.ftCreationTime);
+ return 0;
+}
+
+static time_t
+ToCTime(
+ FILETIME fileTime) /* UTC Time to convert to local time_t. */
+{
+ FILETIME localFileTime;
+ SYSTEMTIME systemTime;
+ struct tm tm;
+
+ if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) {
+ return 0;
+ }
+ if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) {
+ return 0;
+ }
+ tm.tm_sec = systemTime.wSecond;
+ tm.tm_min = systemTime.wMinute;
+ tm.tm_hour = systemTime.wHour;
+ tm.tm_mday = systemTime.wDay;
+ tm.tm_mon = systemTime.wMonth - 1;
+ tm.tm_year = systemTime.wYear - 1900;
+ tm.tm_wday = 0;
+ tm.tm_yday = 0;
+ tm.tm_isdst = -1;
+
+ return mktime(&tm);
+}
+
+#if 0
/*
* Borland's stat doesn't take into account localtime.
@@ -582,92 +875,82 @@ TclpStat(path, buf)
#endif
- return result;
-}
-
+
+#if 0
/*
- *---------------------------------------------------------------------------
- *
- * TclpAccess --
+ *-------------------------------------------------------------------------
*
- * This function replaces the library version of access.
+ * TclWinResolveShortcut --
*
- * The library version of access returns that all files have execute
- * permission.
+ * Resolve a potential Windows shortcut to get the actual file or
+ * directory in question.
*
* Results:
- * See access documentation.
+ * Returns 1 if the shortcut could be resolved, or 0 if there was
+ * an error or if the filename was not a shortcut.
+ * If bufferPtr did hold the name of a shortcut, it is modified to
+ * hold the resolved target of the shortcut instead.
*
* Side effects:
- * See access documentation.
+ * Loads and unloads OLE package to determine if filename refers to
+ * a shortcut.
*
- *---------------------------------------------------------------------------
+ *-------------------------------------------------------------------------
*/
int
-TclpAccess(
- CONST char *path, /* Path of file to access (in current CP). */
- int mode) /* Permission setting. */
+TclWinResolveShortcut(bufferPtr)
+ Tcl_DString *bufferPtr; /* Holds name of file to resolve. On
+ * return, holds resolved file name. */
{
- int result;
- CONST char *p;
+ HRESULT hres;
+ IShellLink *psl;
+ IPersistFile *ppf;
+ WIN32_FIND_DATA wfd;
+ WCHAR wpath[MAX_PATH];
+ char *path, *ext;
+ char realFileName[MAX_PATH];
-#undef access
+ /*
+ * Windows system calls do not automatically resolve
+ * shortcuts like UNIX automatically will with symbolic links.
+ */
- result = access(path, mode);
+ path = Tcl_DStringValue(bufferPtr);
+ ext = strrchr(path, '.');
+ if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) {
+ return 0;
+ }
- if (result == 0) {
- if (mode & 1) {
- if (GetFileAttributes(path) & FILE_ATTRIBUTE_DIRECTORY) {
- /*
- * Directories are always executable.
- */
+ CoInitialize(NULL);
+ path = Tcl_DStringValue(bufferPtr);
+ realFileName[0] = '\0';
+ hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER,
+ &IID_IShellLink, &psl);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf);
+ if (SUCCEEDED(hres)) {
+ MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath));
+ hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->Resolve(psl, NULL,
+ SLR_ANY_MATCH | SLR_NO_UI);
+ if (SUCCEEDED(hres)) {
+ hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH,
+ &wfd, 0);
+ }
+ }
+ ppf->lpVtbl->Release(ppf);
+ }
+ psl->lpVtbl->Release(psl);
+ }
+ CoUninitialize();
- return 0;
- }
- p = strrchr(path, '.');
- if (p != NULL) {
- p++;
- if ((stricmp(p, "exe") == 0)
- || (stricmp(p, "com") == 0)
- || (stricmp(p, "bat") == 0)) {
- /*
- * File that ends with .exe, .com, or .bat is executable.
- */
-
- return 0;
- }
- }
- errno = EACCES;
- return -1;
- }
+ if (realFileName[0] != '\0') {
+ Tcl_DStringSetLength(bufferPtr, 0);
+ Tcl_DStringAppend(bufferPtr, realFileName, -1);
+ return 1;
}
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetUserHome --
- *
- * This function takes the passed in user name and finds the
- * corresponding home directory specified in the password file.
- *
- * Results:
- * On Windows we always return a NULL.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetUserHome(
- char *name, /* User name to use to find home directory. */
- Tcl_DString *bufferPtr) /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
-{
- return NULL;
+ return 0;
}
+#endif
generated by cgit v0.12 at 2024-07-19 21:35:52 (GMT)