diff options
author | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
commit | 494c2de3a748b449c69ce322a1a741f5a31fd4d5 (patch) | |
tree | c3ece48c0ae3f4ba54787e0e8e729b65752ef3f9 /win/tclWinFile.c | |
parent | 7a698c0488d99c0af42022714638ae1ba2afaa49 (diff) | |
download | tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.zip tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.gz tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.bz2 |
Added contents of Tcl 8.1a2
Diffstat (limited to 'win/tclWinFile.c')
-rw-r--r-- | win/tclWinFile.c | 934 |
1 files changed, 621 insertions, 313 deletions
diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 9d97b02..889994c1 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -6,25 +6,29 @@ * 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. * - * SCCS: @(#) tclWinFile.c 1.45 97/10/29 19:08:35 + * SCCS: @(#) tclWinFile.c 1.59 98/02/02 22:07:09 */ #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); /* @@ -48,15 +52,18 @@ static char *currentDir = NULL; void Tcl_FindExecutable(argv0) - char *argv0; /* The value of the application's argv[0]. */ + CONST char *argv0; /* The value of the application's argv[0]. */ { - Tcl_DString buffer; - int length; + Tcl_DString ds; + WCHAR wName[MAX_PATH]; - Tcl_DStringInit(&buffer); + TclInitSubsystems(argv0); + if (argv0 == NULL) { + return; + } if (tclExecutableName != NULL) { - ckfree(tclExecutableName); + ckfree((char *) tclExecutableName); tclExecutableName = NULL; } @@ -65,26 +72,26 @@ 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); + + tclExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); + strcpy(tclExecutableName, Tcl_DStringValue(&ds)); + TclWinNoBackslash(tclExecutableName); + Tcl_DStringFree(&ds); } /* *---------------------------------------------------------------------- * - * 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,7 +102,7 @@ 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. */ @@ -103,17 +110,18 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail) char *tail; /* Pointer to end of pattern. Tail must * point to a location in pattern. */ { - 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 +129,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 +172,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,17 +266,17 @@ 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 @@ -286,21 +287,21 @@ TclMatchFiles(interp, separators, dirPtr, pattern, tail) * name, otherwise we return the system form. */ - 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; - } + if ((volFlags & FS_CASE_SENSITIVE) == 0) { + Tcl_UtfToLower(name); } - if (matchResult == NULL) { + nativeMatchResult = 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 +312,22 @@ 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); + if ((volFlags & FS_CASE_IS_PRESERVED) == 0) { + Tcl_UtfToLower(name); + } + 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 +335,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 = TclUtfToUniCharDString(domain + 1, -1, &ds); + badDomain = (*netGetDCNameProc)(NULL, wName, + (LPBYTE *) &wDomain); + Tcl_DStringFree(&ds); + nameLen = domain - name; + } + if (badDomain == 0) { + Tcl_DStringInit(&ds); + wName = TclUtfToUniCharDString(name, nameLen, &ds); + if ((*netUserGetInfoProc)(wDomain, wName, 1, + (LPBYTE *) &uiPtr) == 0) { + wHomeDir = uiPtr->usri1_home_dir; + if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { + TclUniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), + bufferPtr); + } else { + /* + * User exists but has no home dir. Return + * "{Windows Drive}:/users/default". + */ + + GetWindowsDirectoryW(buf, MAX_PATH); + TclUniCharToUtfDString(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 /* *---------------------------------------------------------------------- * - * TclWinStat, TclWinLstat -- + * 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 +693,164 @@ TclWinResolveShortcut(bufferPtr) */ int -TclWinStat(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. + */ + + 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; -#ifndef _MSC_VER + 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,66 +873,83 @@ TclWinStat(path, buf) #endif - return result; -} - + +#if 0 /* - *--------------------------------------------------------------------------- - * - * TclWinAccess -- + *------------------------------------------------------------------------- * - * 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 -TclWinAccess( - 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; + return 0; } - +#endif + |