|
/* $Header$ */ |
|
|
|
|
|
/* |
|
|
* tclWinFile.c -- |
|
|
* |
|
|
* This file contains temporary wrappers around UNIX file handling |
|
|
* functions. These wrappers map the UNIX functions to Win32 HANDLE-style |
|
|
* files, which can be manipulated through the Win32 console redirection |
|
|
* interfaces. |
|
|
* |
|
|
* 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.1.1.1 2001/06/13 04:49:10 dtashley Exp $ |
|
|
*/ |
|
|
|
|
|
#include "tclWinInt.h" |
|
|
#include <sys/stat.h> |
|
|
#include <shlobj.h> |
|
|
#include <lmaccess.h> /* For TclpGetUserHome(). */ |
|
|
|
|
|
static time_t ToCTime(FILETIME fileTime); |
|
|
|
|
|
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC |
|
|
(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); |
|
|
|
|
|
typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC |
|
|
(LPVOID Buffer); |
|
|
|
|
|
typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC |
|
|
(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); |
|
|
|
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpFindExecutable -- |
|
|
* |
|
|
* This procedure computes the absolute path name of the current |
|
|
* application, given its argv[0] value. |
|
|
* |
|
|
* Results: |
|
|
* 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 tclNativeExecutableName gets filled in with the file |
|
|
* name for the application, if we figured it out. If we couldn't |
|
|
* figure it out, tclNativeExecutableName is set to NULL. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
char * |
|
|
TclpFindExecutable(argv0) |
|
|
CONST char *argv0; /* The value of the application's argv[0] |
|
|
* (native). */ |
|
|
{ |
|
|
Tcl_DString ds; |
|
|
WCHAR wName[MAX_PATH]; |
|
|
|
|
|
if (argv0 == NULL) { |
|
|
return NULL; |
|
|
} |
|
|
if (tclNativeExecutableName != NULL) { |
|
|
return tclNativeExecutableName; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Under Windows we ignore argv0, and return the path for the file used to |
|
|
* create this process. |
|
|
*/ |
|
|
|
|
|
(*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; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpMatchFilesTypes -- |
|
|
* |
|
|
* 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 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. |
|
|
* |
|
|
* Side effects: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- */ |
|
|
|
|
|
int |
|
|
TclpMatchFilesTypes( |
|
|
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 and must |
|
|
* not be static.*/ |
|
|
GlobTypeData *types) /* Object containing list of acceptable types. |
|
|
* May be NULL. */ |
|
|
{ |
|
|
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_DATAT data; |
|
|
BOOL found; |
|
|
Tcl_DString ds; |
|
|
TCHAR *nativeName; |
|
|
Tcl_Obj *resultPtr; |
|
|
|
|
|
/* |
|
|
* Convert the path to normalized form since some interfaces only |
|
|
* accept backslashes. Also, ensure that the directory ends with a |
|
|
* separator character. |
|
|
*/ |
|
|
|
|
|
dirLength = Tcl_DStringLength(dirPtr); |
|
|
Tcl_DStringInit(&dirString); |
|
|
if (dirLength == 0) { |
|
|
Tcl_DStringAppend(&dirString, ".\\", 2); |
|
|
} else { |
|
|
char *p; |
|
|
|
|
|
Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr), |
|
|
Tcl_DStringLength(dirPtr)); |
|
|
for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { |
|
|
if (*p == '/') { |
|
|
*p = '\\'; |
|
|
} |
|
|
} |
|
|
p--; |
|
|
if ((*p != '\\') && (*p != ':')) { |
|
|
Tcl_DStringAppend(&dirString, "\\", 1); |
|
|
} |
|
|
} |
|
|
dir = Tcl_DStringValue(&dirString); |
|
|
|
|
|
/* |
|
|
* First verify that the specified path is actually a directory. |
|
|
*/ |
|
|
|
|
|
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; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Next check the volume information for the directory to see whether |
|
|
* comparisons should be case sensitive or not. If the root is null, then |
|
|
* we use the root of the current directory. If the root is just a drive |
|
|
* specifier, we use the root directory of the given drive. |
|
|
*/ |
|
|
|
|
|
switch (Tcl_GetPathType(dir)) { |
|
|
case TCL_PATH_RELATIVE: |
|
|
found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL, |
|
|
&volFlags, NULL, 0); |
|
|
break; |
|
|
case TCL_PATH_VOLUME_RELATIVE: |
|
|
if (dir[0] == '\\') { |
|
|
root = NULL; |
|
|
} else { |
|
|
root = drivePat; |
|
|
*root = dir[0]; |
|
|
} |
|
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
|
|
&volFlags, NULL, 0); |
|
|
break; |
|
|
case TCL_PATH_ABSOLUTE: |
|
|
if (dir[1] == ':') { |
|
|
root = drivePat; |
|
|
*root = dir[0]; |
|
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
|
|
&volFlags, NULL, 0); |
|
|
} else if (dir[1] == '\\') { |
|
|
char *p; |
|
|
|
|
|
p = strchr(dir + 2, '\\'); |
|
|
p = strchr(p + 1, '\\'); |
|
|
p++; |
|
|
nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds); |
|
|
found = (*tclWinProcs->getVolumeInformationProc)(nativeName, |
|
|
NULL, 0, NULL, NULL, &volFlags, NULL, 0); |
|
|
Tcl_DStringFree(&ds); |
|
|
} |
|
|
break; |
|
|
} |
|
|
|
|
|
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. |
|
|
*/ |
|
|
|
|
|
Tcl_DStringInit(&patternString); |
|
|
newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern); |
|
|
Tcl_UtfToLower(newPattern); |
|
|
|
|
|
/* |
|
|
* We need to check all files in the directory, so append a *.* |
|
|
* to the path. |
|
|
*/ |
|
|
|
|
|
dir = Tcl_DStringAppend(&dirString, "*.*", 3); |
|
|
nativeName = Tcl_WinUtfToTChar(dir, -1, &ds); |
|
|
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); |
|
|
Tcl_DStringFree(&ds); |
|
|
|
|
|
if (handle == INVALID_HANDLE_VALUE) { |
|
|
message = "couldn't read directory \""; |
|
|
goto error; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Clean up the tail pointer. Leave the tail pointing to the |
|
|
* first character after the path separator or NULL. |
|
|
*/ |
|
|
|
|
|
if (*tail == '\\') { |
|
|
tail++; |
|
|
} |
|
|
if (*tail == '\0') { |
|
|
tail = NULL; |
|
|
} else { |
|
|
tail++; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Check to see if the pattern needs to compare with dot files. |
|
|
*/ |
|
|
|
|
|
if ((newPattern[0] == '.') |
|
|
|| ((pattern[0] == '\\') && (pattern[1] == '.'))) { |
|
|
matchDotFiles = 1; |
|
|
} else { |
|
|
matchDotFiles = 0; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Now iterate over all of the files in the directory. |
|
|
*/ |
|
|
|
|
|
resultPtr = Tcl_GetObjResult(interp); |
|
|
for (found = 1; found != 0; |
|
|
found = (*tclWinProcs->findNextFileProc)(handle, &data)) { |
|
|
TCHAR *nativeMatchResult; |
|
|
char *name, *fname; |
|
|
|
|
|
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 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. |
|
|
*/ |
|
|
|
|
|
Tcl_UtfToLower(name); |
|
|
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; |
|
|
} |
|
|
|
|
|
/* |
|
|
* If the file matches, then we need to process the remainder of the |
|
|
* path. If there are more characters to process, then ensure matching |
|
|
* files are directories and call TclDoGlob. Otherwise, just add the |
|
|
* file to the result. |
|
|
*/ |
|
|
|
|
|
name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds); |
|
|
Tcl_DStringAppend(dirPtr, name, -1); |
|
|
Tcl_DStringFree(&ds); |
|
|
|
|
|
fname = Tcl_DStringValue(dirPtr); |
|
|
nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
|
|
Tcl_DStringFree(&ds); |
|
|
|
|
|
if (tail == NULL) { |
|
|
int typeOk = 1; |
|
|
if (types != NULL) { |
|
|
if (types->perm != 0) { |
|
|
if ( |
|
|
((types->perm & TCL_GLOB_PERM_RONLY) && |
|
|
!(attr & FILE_ATTRIBUTE_READONLY)) || |
|
|
((types->perm & TCL_GLOB_PERM_HIDDEN) && |
|
|
!(attr & FILE_ATTRIBUTE_HIDDEN)) || |
|
|
((types->perm & TCL_GLOB_PERM_R) && |
|
|
(TclpAccess(fname, R_OK) != 0)) || |
|
|
((types->perm & TCL_GLOB_PERM_W) && |
|
|
(TclpAccess(fname, W_OK) != 0)) || |
|
|
((types->perm & TCL_GLOB_PERM_X) && |
|
|
(TclpAccess(fname, X_OK) != 0)) |
|
|
) { |
|
|
typeOk = 0; |
|
|
} |
|
|
} |
|
|
if (typeOk && types->type != 0) { |
|
|
struct stat buf; |
|
|
/* |
|
|
* We must match at least one flag to be listed |
|
|
*/ |
|
|
typeOk = 0; |
|
|
if (TclpLstat(fname, &buf) >= 0) { |
|
|
/* |
|
|
* In order bcdpfls as in 'find -t' |
|
|
*/ |
|
|
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_ISLNK |
|
|
|| ((types->type & TCL_GLOB_TYPE_LINK) && |
|
|
S_ISLNK(buf.st_mode)) |
|
|
#endif |
|
|
#ifdef S_ISSOCK |
|
|
|| ((types->type & TCL_GLOB_TYPE_SOCK) && |
|
|
S_ISSOCK(buf.st_mode)) |
|
|
#endif |
|
|
) { |
|
|
typeOk = 1; |
|
|
} |
|
|
} else { |
|
|
/* Posix error occurred */ |
|
|
} |
|
|
} |
|
|
} |
|
|
if (typeOk) { |
|
|
Tcl_ListObjAppendElement(interp, resultPtr, |
|
|
Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); |
|
|
} |
|
|
} else if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
|
|
Tcl_DStringAppend(dirPtr, "/", 1); |
|
|
result = TclDoGlob(interp, separators, dirPtr, tail, types); |
|
|
if (result != TCL_OK) { |
|
|
break; |
|
|
} |
|
|
} |
|
|
Tcl_DStringSetLength(dirPtr, dirLength); |
|
|
} |
|
|
|
|
|
FindClose(handle); |
|
|
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; |
|
|
} |
|
|
|
|
|
/* |
|
|
* TclpMatchFiles -- |
|
|
* |
|
|
* This function is now obsolete. Call the above function |
|
|
* 'TclpMatchFilesTypes' instead. |
|
|
*/ |
|
|
int |
|
|
TclpMatchFiles( |
|
|
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 and must |
|
|
* not be static.*/ |
|
|
{ |
|
|
return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpGetUserHome -- |
|
|
* |
|
|
* This function takes the passed in user name and finds the |
|
|
* corresponding home directory specified in the password file. |
|
|
* |
|
|
* Results: |
|
|
* 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: |
|
|
* None. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
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. */ |
|
|
{ |
|
|
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 (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; |
|
|
} |
|
|
|
|
|
/* |
|
|
*--------------------------------------------------------------------------- |
|
|
* |
|
|
* TclpAccess -- |
|
|
* |
|
|
* This function replaces the library version of access(), fixing the |
|
|
* following bugs: |
|
|
* |
|
|
* 1. access() returns that all files have execute permission. |
|
|
* |
|
|
* Results: |
|
|
* See access documentation. |
|
|
* |
|
|
* Side effects: |
|
|
* See access documentation. |
|
|
* |
|
|
*--------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclpAccess( |
|
|
CONST char *path, /* Path of file to access (UTF-8). */ |
|
|
int mode) /* Permission setting. */ |
|
|
{ |
|
|
Tcl_DString ds; |
|
|
TCHAR *nativePath; |
|
|
DWORD attr; |
|
|
|
|
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
|
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
|
|
Tcl_DStringFree(&ds); |
|
|
|
|
|
if (attr == 0xffffffff) { |
|
|
/* |
|
|
* File doesn't exist. |
|
|
*/ |
|
|
|
|
|
TclWinConvertError(GetLastError()); |
|
|
return -1; |
|
|
} |
|
|
|
|
|
if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { |
|
|
/* |
|
|
* File is not writable. |
|
|
*/ |
|
|
|
|
|
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 0; |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpChdir -- |
|
|
* |
|
|
* This function replaces the library version of chdir(). |
|
|
* |
|
|
* Results: |
|
|
* See chdir() documentation. |
|
|
* |
|
|
* Side effects: |
|
|
* See chdir() documentation. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclpChdir(path) |
|
|
CONST char *path; /* Path to new working directory (UTF-8). */ |
|
|
{ |
|
|
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; |
|
|
} |
|
|
|
|
|
/* |
|
|
* Watch for the wierd Windows c:\\UNC syntax. |
|
|
*/ |
|
|
|
|
|
if (tclWinProcs->useWide) { |
|
|
WCHAR *native; |
|
|
|
|
|
native = (WCHAR *) buffer; |
|
|
if ((native[0] != '\0') && (native[1] == ':') |
|
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
|
|
native += 2; |
|
|
} |
|
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
|
|
} else { |
|
|
char *native; |
|
|
|
|
|
native = (char *) buffer; |
|
|
if ((native[0] != '\0') && (native[1] == ':') |
|
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
|
|
native += 2; |
|
|
} |
|
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
|
|
} |
|
|
|
|
|
/* |
|
|
* Convert to forward slashes for easier use in scripts. |
|
|
*/ |
|
|
|
|
|
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { |
|
|
if (*p == '\\') { |
|
|
*p = '/'; |
|
|
} |
|
|
} |
|
|
return Tcl_DStringValue(bufferPtr); |
|
|
} |
|
|
|
|
|
/* |
|
|
*---------------------------------------------------------------------- |
|
|
* |
|
|
* TclpStat -- |
|
|
* |
|
|
* This function replaces the library version of stat(), fixing |
|
|
* the following bugs: |
|
|
* |
|
|
* 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. |
|
|
* |
|
|
* Side effects: |
|
|
* See stat documentation. |
|
|
* |
|
|
*---------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclpStat(path, statPtr) |
|
|
CONST char *path; /* Path of file to stat (UTF-8). */ |
|
|
struct stat *statPtr; /* Filled with results of stat call. */ |
|
|
{ |
|
|
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; |
|
|
|
|
|
/* |
|
|
* 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; |
|
|
} |
|
|
|
|
|
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. |
|
|
*/ |
|
|
|
|
|
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; |
|
|
|
|
|
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. |
|
|
*/ |
|
|
|
|
|
if ((result == 0) && (buf->st_mtime != 0)) { |
|
|
TIME_ZONE_INFORMATION tz; |
|
|
int time, bias; |
|
|
|
|
|
time = GetTimeZoneInformation(&tz); |
|
|
bias = tz.Bias; |
|
|
if (time == TIME_ZONE_ID_DAYLIGHT) { |
|
|
bias += tz.DaylightBias; |
|
|
} |
|
|
bias *= 60; |
|
|
buf->st_atime -= bias; |
|
|
buf->st_ctime -= bias; |
|
|
buf->st_mtime -= bias; |
|
|
} |
|
|
|
|
|
#endif |
|
|
|
|
|
|
|
|
#if 0 |
|
|
/* |
|
|
*------------------------------------------------------------------------- |
|
|
* |
|
|
* TclWinResolveShortcut -- |
|
|
* |
|
|
* Resolve a potential Windows shortcut to get the actual file or |
|
|
* directory in question. |
|
|
* |
|
|
* 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. |
|
|
* |
|
|
* Side effects: |
|
|
* Loads and unloads OLE package to determine if filename refers to |
|
|
* a shortcut. |
|
|
* |
|
|
*------------------------------------------------------------------------- |
|
|
*/ |
|
|
|
|
|
int |
|
|
TclWinResolveShortcut(bufferPtr) |
|
|
Tcl_DString *bufferPtr; /* Holds name of file to resolve. On |
|
|
* return, holds resolved file name. */ |
|
|
{ |
|
|
HRESULT hres; |
|
|
IShellLink *psl; |
|
|
IPersistFile *ppf; |
|
|
WIN32_FIND_DATA wfd; |
|
|
WCHAR wpath[MAX_PATH]; |
|
|
char *path, *ext; |
|
|
char realFileName[MAX_PATH]; |
|
|
|
|
|
/* |
|
|
* Windows system calls do not automatically resolve |
|
|
* shortcuts like UNIX automatically will with symbolic links. |
|
|
*/ |
|
|
|
|
|
path = Tcl_DStringValue(bufferPtr); |
|
|
ext = strrchr(path, '.'); |
|
|
if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { |
|
|
return 0; |
|
|
} |
|
|
|
|
|
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(); |
|
|
|
|
|
if (realFileName[0] != '\0') { |
|
|
Tcl_DStringSetLength(bufferPtr, 0); |
|
|
Tcl_DStringAppend(bufferPtr, realFileName, -1); |
|
|
return 1; |
|
|
} |
|
|
return 0; |
|
|
} |
|
|
#endif |
|
|
|
|
|
|
|
|
/* $History: tclwinfile.c $ |
|
|
* |
|
|
* ***************** Version 1 ***************** |
|
|
* User: Dtashley Date: 1/02/01 Time: 12:39a |
|
|
* Created in $/IjuScripter, IjuConsole/Source/Tcl Base |
|
|
* Initial check-in. |
|
|
*/ |
|
|
|
|
|
/* End of TCLWINFILE.C */ |
|
1 |
|
/* $Header$ */ |
2 |
|
/* |
3 |
|
* tclWinFile.c -- |
4 |
|
* |
5 |
|
* This file contains temporary wrappers around UNIX file handling |
6 |
|
* functions. These wrappers map the UNIX functions to Win32 HANDLE-style |
7 |
|
* files, which can be manipulated through the Win32 console redirection |
8 |
|
* interfaces. |
9 |
|
* |
10 |
|
* Copyright (c) 1995-1998 Sun Microsystems, Inc. |
11 |
|
* |
12 |
|
* See the file "license.terms" for information on usage and redistribution |
13 |
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
14 |
|
* |
15 |
|
* RCS: @(#) $Id: tclwinfile.c,v 1.1.1.1 2001/06/13 04:49:10 dtashley Exp $ |
16 |
|
*/ |
17 |
|
|
18 |
|
#include "tclWinInt.h" |
19 |
|
#include <sys/stat.h> |
20 |
|
#include <shlobj.h> |
21 |
|
#include <lmaccess.h> /* For TclpGetUserHome(). */ |
22 |
|
|
23 |
|
static time_t ToCTime(FILETIME fileTime); |
24 |
|
|
25 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETUSERGETINFOPROC |
26 |
|
(LPWSTR servername, LPWSTR username, DWORD level, LPBYTE *bufptr); |
27 |
|
|
28 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETAPIBUFFERFREEPROC |
29 |
|
(LPVOID Buffer); |
30 |
|
|
31 |
|
typedef NET_API_STATUS NET_API_FUNCTION NETGETDCNAMEPROC |
32 |
|
(LPWSTR servername, LPWSTR domainname, LPBYTE *bufptr); |
33 |
|
|
34 |
|
|
35 |
|
/* |
36 |
|
*--------------------------------------------------------------------------- |
37 |
|
* |
38 |
|
* TclpFindExecutable -- |
39 |
|
* |
40 |
|
* This procedure computes the absolute path name of the current |
41 |
|
* application, given its argv[0] value. |
42 |
|
* |
43 |
|
* Results: |
44 |
|
* A dirty UTF string that is the path to the executable. At this |
45 |
|
* point we may not know the system encoding. Convert the native |
46 |
|
* string value to UTF using the default encoding. The assumption |
47 |
|
* is that we will still be able to parse the path given the path |
48 |
|
* name contains ASCII string and '/' chars do not conflict with |
49 |
|
* other UTF chars. |
50 |
|
* |
51 |
|
* Side effects: |
52 |
|
* The variable tclNativeExecutableName gets filled in with the file |
53 |
|
* name for the application, if we figured it out. If we couldn't |
54 |
|
* figure it out, tclNativeExecutableName is set to NULL. |
55 |
|
* |
56 |
|
*--------------------------------------------------------------------------- |
57 |
|
*/ |
58 |
|
|
59 |
|
char * |
60 |
|
TclpFindExecutable(argv0) |
61 |
|
CONST char *argv0; /* The value of the application's argv[0] |
62 |
|
* (native). */ |
63 |
|
{ |
64 |
|
Tcl_DString ds; |
65 |
|
WCHAR wName[MAX_PATH]; |
66 |
|
|
67 |
|
if (argv0 == NULL) { |
68 |
|
return NULL; |
69 |
|
} |
70 |
|
if (tclNativeExecutableName != NULL) { |
71 |
|
return tclNativeExecutableName; |
72 |
|
} |
73 |
|
|
74 |
|
/* |
75 |
|
* Under Windows we ignore argv0, and return the path for the file used to |
76 |
|
* create this process. |
77 |
|
*/ |
78 |
|
|
79 |
|
(*tclWinProcs->getModuleFileNameProc)(NULL, wName, MAX_PATH); |
80 |
|
Tcl_WinTCharToUtf((TCHAR *) wName, -1, &ds); |
81 |
|
|
82 |
|
tclNativeExecutableName = ckalloc((unsigned) (Tcl_DStringLength(&ds) + 1)); |
83 |
|
strcpy(tclNativeExecutableName, Tcl_DStringValue(&ds)); |
84 |
|
Tcl_DStringFree(&ds); |
85 |
|
|
86 |
|
TclWinNoBackslash(tclNativeExecutableName); |
87 |
|
return tclNativeExecutableName; |
88 |
|
} |
89 |
|
|
90 |
|
/* |
91 |
|
*---------------------------------------------------------------------- |
92 |
|
* |
93 |
|
* TclpMatchFilesTypes -- |
94 |
|
* |
95 |
|
* This routine is used by the globbing code to search a |
96 |
|
* directory for all files which match a given pattern. |
97 |
|
* |
98 |
|
* Results: |
99 |
|
* If the tail argument is NULL, then the matching files are |
100 |
|
* added to the the interp's result. Otherwise, TclDoGlob is called |
101 |
|
* recursively for each matching subdirectory. The return value |
102 |
|
* is a standard Tcl result indicating whether an error occurred |
103 |
|
* in globbing. |
104 |
|
* |
105 |
|
* Side effects: |
106 |
|
* None. |
107 |
|
* |
108 |
|
*---------------------------------------------------------------------- */ |
109 |
|
|
110 |
|
int |
111 |
|
TclpMatchFilesTypes( |
112 |
|
Tcl_Interp *interp, /* Interpreter to receive results. */ |
113 |
|
char *separators, /* Directory separators to pass to TclDoGlob. */ |
114 |
|
Tcl_DString *dirPtr, /* Contains path to directory to search. */ |
115 |
|
char *pattern, /* Pattern to match against. */ |
116 |
|
char *tail, /* Pointer to end of pattern. Tail must |
117 |
|
* point to a location in pattern and must |
118 |
|
* not be static.*/ |
119 |
|
GlobTypeData *types) /* Object containing list of acceptable types. |
120 |
|
* May be NULL. */ |
121 |
|
{ |
122 |
|
char drivePat[] = "?:\\"; |
123 |
|
const char *message; |
124 |
|
char *dir, *newPattern, *root; |
125 |
|
int matchDotFiles; |
126 |
|
int dirLength, result = TCL_OK; |
127 |
|
Tcl_DString dirString, patternString; |
128 |
|
DWORD attr, volFlags; |
129 |
|
HANDLE handle; |
130 |
|
WIN32_FIND_DATAT data; |
131 |
|
BOOL found; |
132 |
|
Tcl_DString ds; |
133 |
|
TCHAR *nativeName; |
134 |
|
Tcl_Obj *resultPtr; |
135 |
|
|
136 |
|
/* |
137 |
|
* Convert the path to normalized form since some interfaces only |
138 |
|
* accept backslashes. Also, ensure that the directory ends with a |
139 |
|
* separator character. |
140 |
|
*/ |
141 |
|
|
142 |
|
dirLength = Tcl_DStringLength(dirPtr); |
143 |
|
Tcl_DStringInit(&dirString); |
144 |
|
if (dirLength == 0) { |
145 |
|
Tcl_DStringAppend(&dirString, ".\\", 2); |
146 |
|
} else { |
147 |
|
char *p; |
148 |
|
|
149 |
|
Tcl_DStringAppend(&dirString, Tcl_DStringValue(dirPtr), |
150 |
|
Tcl_DStringLength(dirPtr)); |
151 |
|
for (p = Tcl_DStringValue(&dirString); *p != '\0'; p++) { |
152 |
|
if (*p == '/') { |
153 |
|
*p = '\\'; |
154 |
|
} |
155 |
|
} |
156 |
|
p--; |
157 |
|
if ((*p != '\\') && (*p != ':')) { |
158 |
|
Tcl_DStringAppend(&dirString, "\\", 1); |
159 |
|
} |
160 |
|
} |
161 |
|
dir = Tcl_DStringValue(&dirString); |
162 |
|
|
163 |
|
/* |
164 |
|
* First verify that the specified path is actually a directory. |
165 |
|
*/ |
166 |
|
|
167 |
|
nativeName = Tcl_WinUtfToTChar(dir, Tcl_DStringLength(&dirString), &ds); |
168 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
169 |
|
Tcl_DStringFree(&ds); |
170 |
|
|
171 |
|
if ((attr == 0xffffffff) || ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0)) { |
172 |
|
Tcl_DStringFree(&dirString); |
173 |
|
return TCL_OK; |
174 |
|
} |
175 |
|
|
176 |
|
/* |
177 |
|
* Next check the volume information for the directory to see whether |
178 |
|
* comparisons should be case sensitive or not. If the root is null, then |
179 |
|
* we use the root of the current directory. If the root is just a drive |
180 |
|
* specifier, we use the root directory of the given drive. |
181 |
|
*/ |
182 |
|
|
183 |
|
switch (Tcl_GetPathType(dir)) { |
184 |
|
case TCL_PATH_RELATIVE: |
185 |
|
found = GetVolumeInformationA(NULL, NULL, 0, NULL, NULL, |
186 |
|
&volFlags, NULL, 0); |
187 |
|
break; |
188 |
|
case TCL_PATH_VOLUME_RELATIVE: |
189 |
|
if (dir[0] == '\\') { |
190 |
|
root = NULL; |
191 |
|
} else { |
192 |
|
root = drivePat; |
193 |
|
*root = dir[0]; |
194 |
|
} |
195 |
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
196 |
|
&volFlags, NULL, 0); |
197 |
|
break; |
198 |
|
case TCL_PATH_ABSOLUTE: |
199 |
|
if (dir[1] == ':') { |
200 |
|
root = drivePat; |
201 |
|
*root = dir[0]; |
202 |
|
found = GetVolumeInformationA(root, NULL, 0, NULL, NULL, |
203 |
|
&volFlags, NULL, 0); |
204 |
|
} else if (dir[1] == '\\') { |
205 |
|
char *p; |
206 |
|
|
207 |
|
p = strchr(dir + 2, '\\'); |
208 |
|
p = strchr(p + 1, '\\'); |
209 |
|
p++; |
210 |
|
nativeName = Tcl_WinUtfToTChar(dir, p - dir, &ds); |
211 |
|
found = (*tclWinProcs->getVolumeInformationProc)(nativeName, |
212 |
|
NULL, 0, NULL, NULL, &volFlags, NULL, 0); |
213 |
|
Tcl_DStringFree(&ds); |
214 |
|
} |
215 |
|
break; |
216 |
|
} |
217 |
|
|
218 |
|
if (found == 0) { |
219 |
|
message = "couldn't read volume information for \""; |
220 |
|
goto error; |
221 |
|
} |
222 |
|
|
223 |
|
/* |
224 |
|
* In Windows, although some volumes may support case sensitivity, Windows |
225 |
|
* doesn't honor case. So in globbing we need to ignore the case |
226 |
|
* of file names. |
227 |
|
*/ |
228 |
|
|
229 |
|
Tcl_DStringInit(&patternString); |
230 |
|
newPattern = Tcl_DStringAppend(&patternString, pattern, tail - pattern); |
231 |
|
Tcl_UtfToLower(newPattern); |
232 |
|
|
233 |
|
/* |
234 |
|
* We need to check all files in the directory, so append a *.* |
235 |
|
* to the path. |
236 |
|
*/ |
237 |
|
|
238 |
|
dir = Tcl_DStringAppend(&dirString, "*.*", 3); |
239 |
|
nativeName = Tcl_WinUtfToTChar(dir, -1, &ds); |
240 |
|
handle = (*tclWinProcs->findFirstFileProc)(nativeName, &data); |
241 |
|
Tcl_DStringFree(&ds); |
242 |
|
|
243 |
|
if (handle == INVALID_HANDLE_VALUE) { |
244 |
|
message = "couldn't read directory \""; |
245 |
|
goto error; |
246 |
|
} |
247 |
|
|
248 |
|
/* |
249 |
|
* Clean up the tail pointer. Leave the tail pointing to the |
250 |
|
* first character after the path separator or NULL. |
251 |
|
*/ |
252 |
|
|
253 |
|
if (*tail == '\\') { |
254 |
|
tail++; |
255 |
|
} |
256 |
|
if (*tail == '\0') { |
257 |
|
tail = NULL; |
258 |
|
} else { |
259 |
|
tail++; |
260 |
|
} |
261 |
|
|
262 |
|
/* |
263 |
|
* Check to see if the pattern needs to compare with dot files. |
264 |
|
*/ |
265 |
|
|
266 |
|
if ((newPattern[0] == '.') |
267 |
|
|| ((pattern[0] == '\\') && (pattern[1] == '.'))) { |
268 |
|
matchDotFiles = 1; |
269 |
|
} else { |
270 |
|
matchDotFiles = 0; |
271 |
|
} |
272 |
|
|
273 |
|
/* |
274 |
|
* Now iterate over all of the files in the directory. |
275 |
|
*/ |
276 |
|
|
277 |
|
resultPtr = Tcl_GetObjResult(interp); |
278 |
|
for (found = 1; found != 0; |
279 |
|
found = (*tclWinProcs->findNextFileProc)(handle, &data)) { |
280 |
|
TCHAR *nativeMatchResult; |
281 |
|
char *name, *fname; |
282 |
|
|
283 |
|
if (tclWinProcs->useWide) { |
284 |
|
nativeName = (TCHAR *) data.w.cFileName; |
285 |
|
} else { |
286 |
|
nativeName = (TCHAR *) data.a.cFileName; |
287 |
|
} |
288 |
|
name = Tcl_WinTCharToUtf(nativeName, -1, &ds); |
289 |
|
|
290 |
|
/* |
291 |
|
* Check to see if the file matches the pattern. We need to convert |
292 |
|
* the file name to lower case for comparison purposes. Note that we |
293 |
|
* are ignoring the case sensitivity flag because Windows doesn't honor |
294 |
|
* case even if the volume is case sensitive. If the volume also |
295 |
|
* doesn't preserve case, then we previously returned the lower case |
296 |
|
* form of the name. This didn't seem quite right since there are |
297 |
|
* non-case-preserving volumes that actually return mixed case. So now |
298 |
|
* we are returning exactly what we get from the system. |
299 |
|
*/ |
300 |
|
|
301 |
|
Tcl_UtfToLower(name); |
302 |
|
nativeMatchResult = NULL; |
303 |
|
|
304 |
|
if ((matchDotFiles == 0) && (name[0] == '.')) { |
305 |
|
/* |
306 |
|
* Ignore hidden files. |
307 |
|
*/ |
308 |
|
} else if (Tcl_StringMatch(name, newPattern) != 0) { |
309 |
|
nativeMatchResult = nativeName; |
310 |
|
} |
311 |
|
Tcl_DStringFree(&ds); |
312 |
|
|
313 |
|
if (nativeMatchResult == NULL) { |
314 |
|
continue; |
315 |
|
} |
316 |
|
|
317 |
|
/* |
318 |
|
* If the file matches, then we need to process the remainder of the |
319 |
|
* path. If there are more characters to process, then ensure matching |
320 |
|
* files are directories and call TclDoGlob. Otherwise, just add the |
321 |
|
* file to the result. |
322 |
|
*/ |
323 |
|
|
324 |
|
name = Tcl_WinTCharToUtf(nativeMatchResult, -1, &ds); |
325 |
|
Tcl_DStringAppend(dirPtr, name, -1); |
326 |
|
Tcl_DStringFree(&ds); |
327 |
|
|
328 |
|
fname = Tcl_DStringValue(dirPtr); |
329 |
|
nativeName = Tcl_WinUtfToTChar(fname, Tcl_DStringLength(dirPtr), &ds); |
330 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativeName); |
331 |
|
Tcl_DStringFree(&ds); |
332 |
|
|
333 |
|
if (tail == NULL) { |
334 |
|
int typeOk = 1; |
335 |
|
if (types != NULL) { |
336 |
|
if (types->perm != 0) { |
337 |
|
if ( |
338 |
|
((types->perm & TCL_GLOB_PERM_RONLY) && |
339 |
|
!(attr & FILE_ATTRIBUTE_READONLY)) || |
340 |
|
((types->perm & TCL_GLOB_PERM_HIDDEN) && |
341 |
|
!(attr & FILE_ATTRIBUTE_HIDDEN)) || |
342 |
|
((types->perm & TCL_GLOB_PERM_R) && |
343 |
|
(TclpAccess(fname, R_OK) != 0)) || |
344 |
|
((types->perm & TCL_GLOB_PERM_W) && |
345 |
|
(TclpAccess(fname, W_OK) != 0)) || |
346 |
|
((types->perm & TCL_GLOB_PERM_X) && |
347 |
|
(TclpAccess(fname, X_OK) != 0)) |
348 |
|
) { |
349 |
|
typeOk = 0; |
350 |
|
} |
351 |
|
} |
352 |
|
if (typeOk && types->type != 0) { |
353 |
|
struct stat buf; |
354 |
|
/* |
355 |
|
* We must match at least one flag to be listed |
356 |
|
*/ |
357 |
|
typeOk = 0; |
358 |
|
if (TclpLstat(fname, &buf) >= 0) { |
359 |
|
/* |
360 |
|
* In order bcdpfls as in 'find -t' |
361 |
|
*/ |
362 |
|
if ( |
363 |
|
((types->type & TCL_GLOB_TYPE_BLOCK) && |
364 |
|
S_ISBLK(buf.st_mode)) || |
365 |
|
((types->type & TCL_GLOB_TYPE_CHAR) && |
366 |
|
S_ISCHR(buf.st_mode)) || |
367 |
|
((types->type & TCL_GLOB_TYPE_DIR) && |
368 |
|
S_ISDIR(buf.st_mode)) || |
369 |
|
((types->type & TCL_GLOB_TYPE_PIPE) && |
370 |
|
S_ISFIFO(buf.st_mode)) || |
371 |
|
((types->type & TCL_GLOB_TYPE_FILE) && |
372 |
|
S_ISREG(buf.st_mode)) |
373 |
|
#ifdef S_ISLNK |
374 |
|
|| ((types->type & TCL_GLOB_TYPE_LINK) && |
375 |
|
S_ISLNK(buf.st_mode)) |
376 |
|
#endif |
377 |
|
#ifdef S_ISSOCK |
378 |
|
|| ((types->type & TCL_GLOB_TYPE_SOCK) && |
379 |
|
S_ISSOCK(buf.st_mode)) |
380 |
|
#endif |
381 |
|
) { |
382 |
|
typeOk = 1; |
383 |
|
} |
384 |
|
} else { |
385 |
|
/* Posix error occurred */ |
386 |
|
} |
387 |
|
} |
388 |
|
} |
389 |
|
if (typeOk) { |
390 |
|
Tcl_ListObjAppendElement(interp, resultPtr, |
391 |
|
Tcl_NewStringObj(fname, Tcl_DStringLength(dirPtr))); |
392 |
|
} |
393 |
|
} else if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
394 |
|
Tcl_DStringAppend(dirPtr, "/", 1); |
395 |
|
result = TclDoGlob(interp, separators, dirPtr, tail, types); |
396 |
|
if (result != TCL_OK) { |
397 |
|
break; |
398 |
|
} |
399 |
|
} |
400 |
|
Tcl_DStringSetLength(dirPtr, dirLength); |
401 |
|
} |
402 |
|
|
403 |
|
FindClose(handle); |
404 |
|
Tcl_DStringFree(&dirString); |
405 |
|
Tcl_DStringFree(&patternString); |
406 |
|
|
407 |
|
return result; |
408 |
|
|
409 |
|
error: |
410 |
|
Tcl_DStringFree(&dirString); |
411 |
|
TclWinConvertError(GetLastError()); |
412 |
|
Tcl_ResetResult(interp); |
413 |
|
Tcl_AppendResult(interp, message, Tcl_DStringValue(dirPtr), "\": ", |
414 |
|
Tcl_PosixError(interp), (char *) NULL); |
415 |
|
return TCL_ERROR; |
416 |
|
} |
417 |
|
|
418 |
|
/* |
419 |
|
* TclpMatchFiles -- |
420 |
|
* |
421 |
|
* This function is now obsolete. Call the above function |
422 |
|
* 'TclpMatchFilesTypes' instead. |
423 |
|
*/ |
424 |
|
int |
425 |
|
TclpMatchFiles( |
426 |
|
Tcl_Interp *interp, /* Interpreter to receive results. */ |
427 |
|
char *separators, /* Directory separators to pass to TclDoGlob. */ |
428 |
|
Tcl_DString *dirPtr, /* Contains path to directory to search. */ |
429 |
|
char *pattern, /* Pattern to match against. */ |
430 |
|
char *tail) /* Pointer to end of pattern. Tail must |
431 |
|
* point to a location in pattern and must |
432 |
|
* not be static.*/ |
433 |
|
{ |
434 |
|
return TclpMatchFilesTypes(interp,separators,dirPtr,pattern,tail,NULL); |
435 |
|
} |
436 |
|
|
437 |
|
/* |
438 |
|
*---------------------------------------------------------------------- |
439 |
|
* |
440 |
|
* TclpGetUserHome -- |
441 |
|
* |
442 |
|
* This function takes the passed in user name and finds the |
443 |
|
* corresponding home directory specified in the password file. |
444 |
|
* |
445 |
|
* Results: |
446 |
|
* The result is a pointer to a string specifying the user's home |
447 |
|
* directory, or NULL if the user's home directory could not be |
448 |
|
* determined. Storage for the result string is allocated in |
449 |
|
* bufferPtr; the caller must call Tcl_DStringFree() when the result |
450 |
|
* is no longer needed. |
451 |
|
* |
452 |
|
* Side effects: |
453 |
|
* None. |
454 |
|
* |
455 |
|
*---------------------------------------------------------------------- |
456 |
|
*/ |
457 |
|
|
458 |
|
char * |
459 |
|
TclpGetUserHome(name, bufferPtr) |
460 |
|
CONST char *name; /* User name for desired home directory. */ |
461 |
|
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled |
462 |
|
* with name of user's home directory. */ |
463 |
|
{ |
464 |
|
char *result; |
465 |
|
HINSTANCE netapiInst; |
466 |
|
|
467 |
|
result = NULL; |
468 |
|
|
469 |
|
Tcl_DStringInit(bufferPtr); |
470 |
|
|
471 |
|
netapiInst = LoadLibraryA("netapi32.dll"); |
472 |
|
if (netapiInst != NULL) { |
473 |
|
NETAPIBUFFERFREEPROC *netApiBufferFreeProc; |
474 |
|
NETGETDCNAMEPROC *netGetDCNameProc; |
475 |
|
NETUSERGETINFOPROC *netUserGetInfoProc; |
476 |
|
|
477 |
|
netApiBufferFreeProc = (NETAPIBUFFERFREEPROC *) |
478 |
|
GetProcAddress(netapiInst, "NetApiBufferFree"); |
479 |
|
netGetDCNameProc = (NETGETDCNAMEPROC *) |
480 |
|
GetProcAddress(netapiInst, "NetGetDCName"); |
481 |
|
netUserGetInfoProc = (NETUSERGETINFOPROC *) |
482 |
|
GetProcAddress(netapiInst, "NetUserGetInfo"); |
483 |
|
if ((netUserGetInfoProc != NULL) && (netGetDCNameProc != NULL) |
484 |
|
&& (netApiBufferFreeProc != NULL)) { |
485 |
|
USER_INFO_1 *uiPtr; |
486 |
|
Tcl_DString ds; |
487 |
|
int nameLen, badDomain; |
488 |
|
char *domain; |
489 |
|
WCHAR *wName, *wHomeDir, *wDomain; |
490 |
|
WCHAR buf[MAX_PATH]; |
491 |
|
|
492 |
|
badDomain = 0; |
493 |
|
nameLen = -1; |
494 |
|
wDomain = NULL; |
495 |
|
domain = strchr(name, '@'); |
496 |
|
if (domain != NULL) { |
497 |
|
Tcl_DStringInit(&ds); |
498 |
|
wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds); |
499 |
|
badDomain = (*netGetDCNameProc)(NULL, wName, |
500 |
|
(LPBYTE *) &wDomain); |
501 |
|
Tcl_DStringFree(&ds); |
502 |
|
nameLen = domain - name; |
503 |
|
} |
504 |
|
if (badDomain == 0) { |
505 |
|
Tcl_DStringInit(&ds); |
506 |
|
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds); |
507 |
|
if ((*netUserGetInfoProc)(wDomain, wName, 1, |
508 |
|
(LPBYTE *) &uiPtr) == 0) { |
509 |
|
wHomeDir = uiPtr->usri1_home_dir; |
510 |
|
if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) { |
511 |
|
Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir), |
512 |
|
bufferPtr); |
513 |
|
} else { |
514 |
|
/* |
515 |
|
* User exists but has no home dir. Return |
516 |
|
* "{Windows Drive}:/users/default". |
517 |
|
*/ |
518 |
|
|
519 |
|
GetWindowsDirectoryW(buf, MAX_PATH); |
520 |
|
Tcl_UniCharToUtfDString(buf, 2, bufferPtr); |
521 |
|
Tcl_DStringAppend(bufferPtr, "/users/default", -1); |
522 |
|
} |
523 |
|
result = Tcl_DStringValue(bufferPtr); |
524 |
|
(*netApiBufferFreeProc)((void *) uiPtr); |
525 |
|
} |
526 |
|
Tcl_DStringFree(&ds); |
527 |
|
} |
528 |
|
if (wDomain != NULL) { |
529 |
|
(*netApiBufferFreeProc)((void *) wDomain); |
530 |
|
} |
531 |
|
} |
532 |
|
FreeLibrary(netapiInst); |
533 |
|
} |
534 |
|
if (result == NULL) { |
535 |
|
/* |
536 |
|
* Look in the "Password Lists" section of system.ini for the |
537 |
|
* local user. There are also entries in that section that begin |
538 |
|
* with a "*" character that are used by Windows for other |
539 |
|
* purposes; ignore user names beginning with a "*". |
540 |
|
*/ |
541 |
|
|
542 |
|
char buf[MAX_PATH]; |
543 |
|
|
544 |
|
if (name[0] != '*') { |
545 |
|
if (GetPrivateProfileStringA("Password Lists", name, "", buf, |
546 |
|
MAX_PATH, "system.ini") > 0) { |
547 |
|
/* |
548 |
|
* User exists, but there is no such thing as a home |
549 |
|
* directory in system.ini. Return "{Windows drive}:/". |
550 |
|
*/ |
551 |
|
|
552 |
|
GetWindowsDirectoryA(buf, MAX_PATH); |
553 |
|
Tcl_DStringAppend(bufferPtr, buf, 3); |
554 |
|
result = Tcl_DStringValue(bufferPtr); |
555 |
|
} |
556 |
|
} |
557 |
|
} |
558 |
|
|
559 |
|
return result; |
560 |
|
} |
561 |
|
|
562 |
|
/* |
563 |
|
*--------------------------------------------------------------------------- |
564 |
|
* |
565 |
|
* TclpAccess -- |
566 |
|
* |
567 |
|
* This function replaces the library version of access(), fixing the |
568 |
|
* following bugs: |
569 |
|
* |
570 |
|
* 1. access() returns that all files have execute permission. |
571 |
|
* |
572 |
|
* Results: |
573 |
|
* See access documentation. |
574 |
|
* |
575 |
|
* Side effects: |
576 |
|
* See access documentation. |
577 |
|
* |
578 |
|
*--------------------------------------------------------------------------- |
579 |
|
*/ |
580 |
|
|
581 |
|
int |
582 |
|
TclpAccess( |
583 |
|
CONST char *path, /* Path of file to access (UTF-8). */ |
584 |
|
int mode) /* Permission setting. */ |
585 |
|
{ |
586 |
|
Tcl_DString ds; |
587 |
|
TCHAR *nativePath; |
588 |
|
DWORD attr; |
589 |
|
|
590 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
591 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
592 |
|
Tcl_DStringFree(&ds); |
593 |
|
|
594 |
|
if (attr == 0xffffffff) { |
595 |
|
/* |
596 |
|
* File doesn't exist. |
597 |
|
*/ |
598 |
|
|
599 |
|
TclWinConvertError(GetLastError()); |
600 |
|
return -1; |
601 |
|
} |
602 |
|
|
603 |
|
if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { |
604 |
|
/* |
605 |
|
* File is not writable. |
606 |
|
*/ |
607 |
|
|
608 |
|
Tcl_SetErrno(EACCES); |
609 |
|
return -1; |
610 |
|
} |
611 |
|
|
612 |
|
if (mode & X_OK) { |
613 |
|
CONST char *p; |
614 |
|
|
615 |
|
if (attr & FILE_ATTRIBUTE_DIRECTORY) { |
616 |
|
/* |
617 |
|
* Directories are always executable. |
618 |
|
*/ |
619 |
|
|
620 |
|
return 0; |
621 |
|
} |
622 |
|
p = strrchr(path, '.'); |
623 |
|
if (p != NULL) { |
624 |
|
p++; |
625 |
|
if ((stricmp(p, "exe") == 0) |
626 |
|
|| (stricmp(p, "com") == 0) |
627 |
|
|| (stricmp(p, "bat") == 0)) { |
628 |
|
/* |
629 |
|
* File that ends with .exe, .com, or .bat is executable. |
630 |
|
*/ |
631 |
|
|
632 |
|
return 0; |
633 |
|
} |
634 |
|
} |
635 |
|
Tcl_SetErrno(EACCES); |
636 |
|
return -1; |
637 |
|
} |
638 |
|
|
639 |
|
return 0; |
640 |
|
} |
641 |
|
|
642 |
|
/* |
643 |
|
*---------------------------------------------------------------------- |
644 |
|
* |
645 |
|
* TclpChdir -- |
646 |
|
* |
647 |
|
* This function replaces the library version of chdir(). |
648 |
|
* |
649 |
|
* Results: |
650 |
|
* See chdir() documentation. |
651 |
|
* |
652 |
|
* Side effects: |
653 |
|
* See chdir() documentation. |
654 |
|
* |
655 |
|
*---------------------------------------------------------------------- |
656 |
|
*/ |
657 |
|
|
658 |
|
int |
659 |
|
TclpChdir(path) |
660 |
|
CONST char *path; /* Path to new working directory (UTF-8). */ |
661 |
|
{ |
662 |
|
int result; |
663 |
|
Tcl_DString ds; |
664 |
|
TCHAR *nativePath; |
665 |
|
|
666 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
667 |
|
result = (*tclWinProcs->setCurrentDirectoryProc)(nativePath); |
668 |
|
Tcl_DStringFree(&ds); |
669 |
|
|
670 |
|
if (result == 0) { |
671 |
|
TclWinConvertError(GetLastError()); |
672 |
|
return -1; |
673 |
|
} |
674 |
|
return 0; |
675 |
|
} |
676 |
|
|
677 |
|
/* |
678 |
|
*---------------------------------------------------------------------- |
679 |
|
* |
680 |
|
* TclpGetCwd -- |
681 |
|
* |
682 |
|
* This function replaces the library version of getcwd(). |
683 |
|
* |
684 |
|
* Results: |
685 |
|
* The result is a pointer to a string specifying the current |
686 |
|
* directory, or NULL if the current directory could not be |
687 |
|
* determined. If NULL is returned, an error message is left in the |
688 |
|
* interp's result. Storage for the result string is allocated in |
689 |
|
* bufferPtr; the caller must call Tcl_DStringFree() when the result |
690 |
|
* is no longer needed. |
691 |
|
* |
692 |
|
* Side effects: |
693 |
|
* None. |
694 |
|
* |
695 |
|
*---------------------------------------------------------------------- |
696 |
|
*/ |
697 |
|
|
698 |
|
char * |
699 |
|
TclpGetCwd(interp, bufferPtr) |
700 |
|
Tcl_Interp *interp; /* If non-NULL, used for error reporting. */ |
701 |
|
Tcl_DString *bufferPtr; /* Uninitialized or free DString filled |
702 |
|
* with name of current directory. */ |
703 |
|
{ |
704 |
|
WCHAR buffer[MAX_PATH]; |
705 |
|
char *p; |
706 |
|
|
707 |
|
if ((*tclWinProcs->getCurrentDirectoryProc)(MAX_PATH, buffer) == 0) { |
708 |
|
TclWinConvertError(GetLastError()); |
709 |
|
if (interp != NULL) { |
710 |
|
Tcl_AppendResult(interp, |
711 |
|
"error getting working directory name: ", |
712 |
|
Tcl_PosixError(interp), (char *) NULL); |
713 |
|
} |
714 |
|
return NULL; |
715 |
|
} |
716 |
|
|
717 |
|
/* |
718 |
|
* Watch for the wierd Windows c:\\UNC syntax. |
719 |
|
*/ |
720 |
|
|
721 |
|
if (tclWinProcs->useWide) { |
722 |
|
WCHAR *native; |
723 |
|
|
724 |
|
native = (WCHAR *) buffer; |
725 |
|
if ((native[0] != '\0') && (native[1] == ':') |
726 |
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
727 |
|
native += 2; |
728 |
|
} |
729 |
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
730 |
|
} else { |
731 |
|
char *native; |
732 |
|
|
733 |
|
native = (char *) buffer; |
734 |
|
if ((native[0] != '\0') && (native[1] == ':') |
735 |
|
&& (native[2] == '\\') && (native[3] == '\\')) { |
736 |
|
native += 2; |
737 |
|
} |
738 |
|
Tcl_WinTCharToUtf((TCHAR *) native, -1, bufferPtr); |
739 |
|
} |
740 |
|
|
741 |
|
/* |
742 |
|
* Convert to forward slashes for easier use in scripts. |
743 |
|
*/ |
744 |
|
|
745 |
|
for (p = Tcl_DStringValue(bufferPtr); *p != '\0'; p++) { |
746 |
|
if (*p == '\\') { |
747 |
|
*p = '/'; |
748 |
|
} |
749 |
|
} |
750 |
|
return Tcl_DStringValue(bufferPtr); |
751 |
|
} |
752 |
|
|
753 |
|
/* |
754 |
|
*---------------------------------------------------------------------- |
755 |
|
* |
756 |
|
* TclpStat -- |
757 |
|
* |
758 |
|
* This function replaces the library version of stat(), fixing |
759 |
|
* the following bugs: |
760 |
|
* |
761 |
|
* 1. stat("c:") returns an error. |
762 |
|
* 2. Borland stat() return time in GMT instead of localtime. |
763 |
|
* 3. stat("\\server\mount") would return error. |
764 |
|
* 4. Accepts slashes or backslashes. |
765 |
|
* 5. st_dev and st_rdev were wrong for UNC paths. |
766 |
|
* |
767 |
|
* Results: |
768 |
|
* See stat documentation. |
769 |
|
* |
770 |
|
* Side effects: |
771 |
|
* See stat documentation. |
772 |
|
* |
773 |
|
*---------------------------------------------------------------------- |
774 |
|
*/ |
775 |
|
|
776 |
|
int |
777 |
|
TclpStat(path, statPtr) |
778 |
|
CONST char *path; /* Path of file to stat (UTF-8). */ |
779 |
|
struct stat *statPtr; /* Filled with results of stat call. */ |
780 |
|
{ |
781 |
|
Tcl_DString ds; |
782 |
|
TCHAR *nativePath; |
783 |
|
WIN32_FIND_DATAT data; |
784 |
|
HANDLE handle; |
785 |
|
DWORD attr; |
786 |
|
WCHAR nativeFullPath[MAX_PATH]; |
787 |
|
TCHAR *nativePart; |
788 |
|
char *p, *fullPath; |
789 |
|
int dev, mode; |
790 |
|
|
791 |
|
/* |
792 |
|
* Eliminate file names containing wildcard characters, or subsequent |
793 |
|
* call to FindFirstFile() will expand them, matching some other file. |
794 |
|
*/ |
795 |
|
|
796 |
|
if (strpbrk(path, "?*") != NULL) { |
797 |
|
Tcl_SetErrno(ENOENT); |
798 |
|
return -1; |
799 |
|
} |
800 |
|
|
801 |
|
nativePath = Tcl_WinUtfToTChar(path, -1, &ds); |
802 |
|
handle = (*tclWinProcs->findFirstFileProc)(nativePath, &data); |
803 |
|
if (handle == INVALID_HANDLE_VALUE) { |
804 |
|
/* |
805 |
|
* FindFirstFile() doesn't work on root directories, so call |
806 |
|
* GetFileAttributes() to see if the specified file exists. |
807 |
|
*/ |
808 |
|
|
809 |
|
attr = (*tclWinProcs->getFileAttributesProc)(nativePath); |
810 |
|
if (attr == 0xffffffff) { |
811 |
|
Tcl_DStringFree(&ds); |
812 |
|
Tcl_SetErrno(ENOENT); |
813 |
|
return -1; |
814 |
|
} |
815 |
|
|
816 |
|
/* |
817 |
|
* Make up some fake information for this file. It has the |
818 |
|
* correct file attributes and a time of 0. |
819 |
|
*/ |
820 |
|
|
821 |
|
memset(&data, 0, sizeof(data)); |
822 |
|
data.a.dwFileAttributes = attr; |
823 |
|
} else { |
824 |
|
FindClose(handle); |
825 |
|
} |
826 |
|
|
827 |
|
(*tclWinProcs->getFullPathNameProc)(nativePath, MAX_PATH, nativeFullPath, |
828 |
|
&nativePart); |
829 |
|
|
830 |
|
Tcl_DStringFree(&ds); |
831 |
|
fullPath = Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds); |
832 |
|
|
833 |
|
dev = -1; |
834 |
|
if ((fullPath[0] == '\\') && (fullPath[1] == '\\')) { |
835 |
|
char *p; |
836 |
|
DWORD dw; |
837 |
|
TCHAR *nativeVol; |
838 |
|
Tcl_DString volString; |
839 |
|
|
840 |
|
p = strchr(fullPath + 2, '\\'); |
841 |
|
p = strchr(p + 1, '\\'); |
842 |
|
if (p == NULL) { |
843 |
|
/* |
844 |
|
* Add terminating backslash to fullpath or |
845 |
|
* GetVolumeInformation() won't work. |
846 |
|
*/ |
847 |
|
|
848 |
|
fullPath = Tcl_DStringAppend(&ds, "\\", 1); |
849 |
|
p = fullPath + Tcl_DStringLength(&ds); |
850 |
|
} else { |
851 |
|
p++; |
852 |
|
} |
853 |
|
nativeVol = Tcl_WinUtfToTChar(fullPath, p - fullPath, &volString); |
854 |
|
dw = (DWORD) -1; |
855 |
|
(*tclWinProcs->getVolumeInformationProc)(nativeVol, NULL, 0, &dw, |
856 |
|
NULL, NULL, NULL, 0); |
857 |
|
/* |
858 |
|
* GetFullPathName() turns special devices like "NUL" into "\\.\NUL", |
859 |
|
* but GetVolumeInformation() returns failure for "\\.\NUL". This |
860 |
|
* will cause "NUL" to get a drive number of -1, which makes about |
861 |
|
* as much sense as anything since the special devices don't live on |
862 |
|
* any drive. |
863 |
|
*/ |
864 |
|
|
865 |
|
dev = dw; |
866 |
|
Tcl_DStringFree(&volString); |
867 |
|
} else if ((fullPath[0] != '\0') && (fullPath[1] == ':')) { |
868 |
|
dev = Tcl_UniCharToLower(fullPath[0]) - 'a'; |
869 |
|
} |
870 |
|
Tcl_DStringFree(&ds); |
871 |
|
|
872 |
|
attr = data.a.dwFileAttributes; |
873 |
|
mode = (attr & FILE_ATTRIBUTE_DIRECTORY) ? S_IFDIR | S_IEXEC : S_IFREG; |
874 |
|
mode |= (attr & FILE_ATTRIBUTE_READONLY) ? S_IREAD : S_IREAD | S_IWRITE; |
875 |
|
p = strrchr(path, '.'); |
876 |
|
if (p != NULL) { |
877 |
|
if ((lstrcmpiA(p, ".exe") == 0) |
878 |
|
|| (lstrcmpiA(p, ".com") == 0) |
879 |
|
|| (lstrcmpiA(p, ".bat") == 0) |
880 |
|
|| (lstrcmpiA(p, ".pif") == 0)) { |
881 |
|
mode |= S_IEXEC; |
882 |
|
} |
883 |
|
} |
884 |
|
|
885 |
|
/* |
886 |
|
* Propagate the S_IREAD, S_IWRITE, S_IEXEC bits to the group and |
887 |
|
* other positions. |
888 |
|
*/ |
889 |
|
|
890 |
|
mode |= (mode & 0x0700) >> 3; |
891 |
|
mode |= (mode & 0x0700) >> 6; |
892 |
|
|
893 |
|
statPtr->st_dev = (dev_t) dev; |
894 |
|
statPtr->st_ino = 0; |
895 |
|
statPtr->st_mode = (unsigned short) mode; |
896 |
|
statPtr->st_nlink = 1; |
897 |
|
statPtr->st_uid = 0; |
898 |
|
statPtr->st_gid = 0; |
899 |
|
statPtr->st_rdev = (dev_t) dev; |
900 |
|
statPtr->st_size = data.a.nFileSizeLow; |
901 |
|
statPtr->st_atime = ToCTime(data.a.ftLastAccessTime); |
902 |
|
statPtr->st_mtime = ToCTime(data.a.ftLastWriteTime); |
903 |
|
statPtr->st_ctime = ToCTime(data.a.ftCreationTime); |
904 |
|
return 0; |
905 |
|
} |
906 |
|
|
907 |
|
static time_t |
908 |
|
ToCTime( |
909 |
|
FILETIME fileTime) /* UTC Time to convert to local time_t. */ |
910 |
|
{ |
911 |
|
FILETIME localFileTime; |
912 |
|
SYSTEMTIME systemTime; |
913 |
|
struct tm tm; |
914 |
|
|
915 |
|
if (FileTimeToLocalFileTime(&fileTime, &localFileTime) == 0) { |
916 |
|
return 0; |
917 |
|
} |
918 |
|
if (FileTimeToSystemTime(&localFileTime, &systemTime) == 0) { |
919 |
|
return 0; |
920 |
|
} |
921 |
|
tm.tm_sec = systemTime.wSecond; |
922 |
|
tm.tm_min = systemTime.wMinute; |
923 |
|
tm.tm_hour = systemTime.wHour; |
924 |
|
tm.tm_mday = systemTime.wDay; |
925 |
|
tm.tm_mon = systemTime.wMonth - 1; |
926 |
|
tm.tm_year = systemTime.wYear - 1900; |
927 |
|
tm.tm_wday = 0; |
928 |
|
tm.tm_yday = 0; |
929 |
|
tm.tm_isdst = -1; |
930 |
|
|
931 |
|
return mktime(&tm); |
932 |
|
} |
933 |
|
|
934 |
|
#if 0 |
935 |
|
|
936 |
|
/* |
937 |
|
* Borland's stat doesn't take into account localtime. |
938 |
|
*/ |
939 |
|
|
940 |
|
if ((result == 0) && (buf->st_mtime != 0)) { |
941 |
|
TIME_ZONE_INFORMATION tz; |
942 |
|
int time, bias; |
943 |
|
|
944 |
|
time = GetTimeZoneInformation(&tz); |
945 |
|
bias = tz.Bias; |
946 |
|
if (time == TIME_ZONE_ID_DAYLIGHT) { |
947 |
|
bias += tz.DaylightBias; |
948 |
|
} |
949 |
|
bias *= 60; |
950 |
|
buf->st_atime -= bias; |
951 |
|
buf->st_ctime -= bias; |
952 |
|
buf->st_mtime -= bias; |
953 |
|
} |
954 |
|
|
955 |
|
#endif |
956 |
|
|
957 |
|
|
958 |
|
#if 0 |
959 |
|
/* |
960 |
|
*------------------------------------------------------------------------- |
961 |
|
* |
962 |
|
* TclWinResolveShortcut -- |
963 |
|
* |
964 |
|
* Resolve a potential Windows shortcut to get the actual file or |
965 |
|
* directory in question. |
966 |
|
* |
967 |
|
* Results: |
968 |
|
* Returns 1 if the shortcut could be resolved, or 0 if there was |
969 |
|
* an error or if the filename was not a shortcut. |
970 |
|
* If bufferPtr did hold the name of a shortcut, it is modified to |
971 |
|
* hold the resolved target of the shortcut instead. |
972 |
|
* |
973 |
|
* Side effects: |
974 |
|
* Loads and unloads OLE package to determine if filename refers to |
975 |
|
* a shortcut. |
976 |
|
* |
977 |
|
*------------------------------------------------------------------------- |
978 |
|
*/ |
979 |
|
|
980 |
|
int |
981 |
|
TclWinResolveShortcut(bufferPtr) |
982 |
|
Tcl_DString *bufferPtr; /* Holds name of file to resolve. On |
983 |
|
* return, holds resolved file name. */ |
984 |
|
{ |
985 |
|
HRESULT hres; |
986 |
|
IShellLink *psl; |
987 |
|
IPersistFile *ppf; |
988 |
|
WIN32_FIND_DATA wfd; |
989 |
|
WCHAR wpath[MAX_PATH]; |
990 |
|
char *path, *ext; |
991 |
|
char realFileName[MAX_PATH]; |
992 |
|
|
993 |
|
/* |
994 |
|
* Windows system calls do not automatically resolve |
995 |
|
* shortcuts like UNIX automatically will with symbolic links. |
996 |
|
*/ |
997 |
|
|
998 |
|
path = Tcl_DStringValue(bufferPtr); |
999 |
|
ext = strrchr(path, '.'); |
1000 |
|
if ((ext == NULL) || (stricmp(ext, ".lnk") != 0)) { |
1001 |
|
return 0; |
1002 |
|
} |
1003 |
|
|
1004 |
|
CoInitialize(NULL); |
1005 |
|
path = Tcl_DStringValue(bufferPtr); |
1006 |
|
realFileName[0] = '\0'; |
1007 |
|
hres = CoCreateInstance(&CLSID_ShellLink, NULL, CLSCTX_INPROC_SERVER, |
1008 |
|
&IID_IShellLink, &psl); |
1009 |
|
if (SUCCEEDED(hres)) { |
1010 |
|
hres = psl->lpVtbl->QueryInterface(psl, &IID_IPersistFile, &ppf); |
1011 |
|
if (SUCCEEDED(hres)) { |
1012 |
|
MultiByteToWideChar(CP_ACP, 0, path, -1, wpath, sizeof(wpath)); |
1013 |
|
hres = ppf->lpVtbl->Load(ppf, wpath, STGM_READ); |
1014 |
|
if (SUCCEEDED(hres)) { |
1015 |
|
hres = psl->lpVtbl->Resolve(psl, NULL, |
1016 |
|
SLR_ANY_MATCH | SLR_NO_UI); |
1017 |
|
if (SUCCEEDED(hres)) { |
1018 |
|
hres = psl->lpVtbl->GetPath(psl, realFileName, MAX_PATH, |
1019 |
|
&wfd, 0); |
1020 |
|
} |
1021 |
|
} |
1022 |
|
ppf->lpVtbl->Release(ppf); |
1023 |
|
} |
1024 |
|
psl->lpVtbl->Release(psl); |
1025 |
|
} |
1026 |
|
CoUninitialize(); |
1027 |
|
|
1028 |
|
if (realFileName[0] != '\0') { |
1029 |
|
Tcl_DStringSetLength(bufferPtr, 0); |
1030 |
|
Tcl_DStringAppend(bufferPtr, realFileName, -1); |
1031 |
|
return 1; |
1032 |
|
} |
1033 |
|
return 0; |
1034 |
|
} |
1035 |
|
#endif |
1036 |
|
|
1037 |
|
/* End of tclwinfile.c */ |