archie/tcl7.6/win/tclWinFile.c

765 lines
19 KiB
C
Raw Normal View History

2024-05-27 16:40:40 +02:00
/*
* 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-1996 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.37 96/09/18 15:10:45
*/
#include <sys/stat.h>
#include "tclWinInt.h"
/*
* 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 char *currentDir = NULL;
/*
*----------------------------------------------------------------------
*
* TclCreateTempFile --
*
* This function opens a unique file with the property that it
* will be deleted when its file handle is closed. The temporary
* file is created in the system temporary directory.
*
* Results:
* Returns a valid C file descriptor, or -1 on failure.
*
* Side effects:
* Creates a new temporary file.
*
*----------------------------------------------------------------------
*/
Tcl_File
TclCreateTempFile(contents, namePtr)
char *contents; /* String to write into temp file, or NULL. */
Tcl_DString *namePtr; /* If non-NULL, pointer to initialized
* DString that is filled with the name of
* the temp file that was created. */
{
char name[MAX_PATH];
HANDLE handle;
if (!GetTempPath(MAX_PATH, name)
|| !GetTempFileName(name, "TCL", 0, name)) {
return NULL;
}
handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, NULL,
CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE,
NULL);
/*
* Under Win32s a file created with FILE_FLAG_DELETE_ON_CLOSE won't
* actually be deleted when it is closed. This was causing tcl to leak
* temp files. The DeleteFile() call will delete the file now under
* Win32s. Under 95 and NT, the call will fail because the file is
* locked (because it was just opened), but it will get deleted when
* it is closed, due to the FILE_FLAG_DELETE_ON_CLOSE.
*/
DeleteFile(name);
if (handle == INVALID_HANDLE_VALUE) {
goto error;
}
/*
* Write the file out, doing line translations on the way.
*/
if (contents != NULL) {
DWORD result, length;
char *p;
for (p = contents; *p != '\0'; p++) {
if (*p == '\n') {
length = p - contents;
if (length > 0) {
if (!WriteFile(handle, contents, length, &result, NULL)) {
goto error;
}
}
if (!WriteFile(handle, "\r\n", 2, &result, NULL)) {
goto error;
}
contents = p+1;
}
}
length = p - contents;
if (length > 0) {
if (!WriteFile(handle, contents, length, &result, NULL)) {
goto error;
}
}
}
if (SetFilePointer(handle, 0, NULL, FILE_BEGIN) == 0xFFFFFFFF) {
goto error;
}
Tcl_DStringAppend(namePtr, name, -1);
return Tcl_GetFile((ClientData) handle, TCL_WIN_FILE);
error:
TclWinConvertError(GetLastError());
CloseHandle(handle);
DeleteFile(name);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* TclOpenFile --
*
* This function wraps the normal system open() to ensure that
* files are opened with the _O_NOINHERIT flag set.
*
* Results:
* Same as open().
*
* Side effects:
* Same as open().
*
*----------------------------------------------------------------------
*/
Tcl_File
TclOpenFile(path, mode)
char *path;
int mode;
{
HANDLE handle;
DWORD accessMode;
DWORD createMode;
DWORD shareMode;
DWORD flags;
SECURITY_ATTRIBUTES sec;
/*
* Map the access bits to the NT access mode.
*/
switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
case O_RDONLY:
accessMode = GENERIC_READ;
break;
case O_WRONLY:
accessMode = GENERIC_WRITE;
break;
case O_RDWR:
accessMode = (GENERIC_READ | GENERIC_WRITE);
break;
default:
TclWinConvertError(ERROR_INVALID_FUNCTION);
return NULL;
}
/*
* Map the creation flags to the NT create mode.
*/
switch (mode & (O_CREAT | O_EXCL | O_TRUNC)) {
case (O_CREAT | O_EXCL):
case (O_CREAT | O_EXCL | O_TRUNC):
createMode = CREATE_NEW;
break;
case (O_CREAT | O_TRUNC):
createMode = CREATE_ALWAYS;
break;
case O_CREAT:
createMode = OPEN_ALWAYS;
break;
case O_TRUNC:
case (O_TRUNC | O_EXCL):
createMode = TRUNCATE_EXISTING;
break;
default:
createMode = OPEN_EXISTING;
break;
}
/*
* If the file is not being created, use the existing file attributes.
*/
flags = 0;
if (!(mode & O_CREAT)) {
flags = GetFileAttributes(path);
if (flags == 0xFFFFFFFF) {
flags = 0;
}
}
/*
* Set up the security attributes so this file is not inherited by
* child processes.
*/
sec.nLength = sizeof(sec);
sec.lpSecurityDescriptor = NULL;
sec.bInheritHandle = 0;
/*
* Set up the file sharing mode. We want to allow simultaneous access.
*/
shareMode = FILE_SHARE_READ | FILE_SHARE_WRITE;
/*
* Now we get to create the file.
*/
handle = CreateFile(path, accessMode, shareMode, &sec, createMode, flags,
(HANDLE) NULL);
if (handle == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
}
TclWinConvertError(err);
return NULL;
}
return Tcl_GetFile((ClientData) handle, TCL_WIN_FILE);
}
/*
*----------------------------------------------------------------------
*
* TclCloseFile --
*
* Closes a file on Windows.
*
* Results:
* 0 on success, -1 on failure.
*
* Side effects:
* The file is closed.
*
*----------------------------------------------------------------------
*/
int
TclCloseFile(file)
Tcl_File file; /* The file to close. */
{
HANDLE handle;
int type;
ClientData clientData;
TclWinPipe *pipePtr;
clientData = Tcl_GetFileInfo(file, &type);
if (type == TCL_WIN_FILE) {
handle = (HANDLE) clientData;
if (CloseHandle(handle) == FALSE) {
TclWinConvertError(GetLastError());
return -1;
}
} else if (type == TCL_WIN32S_PIPE) {
pipePtr = (TclWinPipe *) clientData;
if (pipePtr->otherPtr != NULL) {
pipePtr->otherPtr->otherPtr = NULL;
} else {
if (pipePtr->fileHandle != INVALID_HANDLE_VALUE) {
CloseHandle(pipePtr->fileHandle);
}
DeleteFile(pipePtr->fileName);
ckfree((char *) pipePtr->fileName);
}
ckfree((char *) pipePtr);
} else {
panic("Tcl_CloseFile: unexpected file type");
}
Tcl_FreeFile(file);
return 0;
}
/*
*----------------------------------------------------------------------
*
* TclSeekFile --
*
* Sets the file pointer on a file indicated by the file.
*
* Results:
* The new position at which the file pointer is after it was
* moved, or -1 on failure.
*
* Side effects:
* May move the position at which subsequent operations on the
* file access it.
*
*----------------------------------------------------------------------
*/
int
TclSeekFile(file, offset, whence)
Tcl_File file; /* File to seek on. */
int offset; /* How much to move. */
int whence; /* Relative to where? */
{
DWORD moveMethod;
DWORD newPos;
HANDLE handle;
int type;
handle = (HANDLE) Tcl_GetFileInfo(file, &type);
if (type != TCL_WIN_FILE) {
panic("Tcl_SeekFile: unexpected file type");
}
if (whence == SEEK_SET) {
moveMethod = FILE_BEGIN;
} else if (whence == SEEK_CUR) {
moveMethod = FILE_CURRENT;
} else {
moveMethod = FILE_END;
}
newPos = SetFilePointer(handle, offset, NULL, moveMethod);
if (newPos == 0xFFFFFFFF) {
TclWinConvertError(GetLastError());
return -1;
}
return newPos;
}
/*
*----------------------------------------------------------------------
*
* Tcl_FindExecutable --
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value.
*
* Results:
* None.
*
* Side effects:
* The variable tclExecutableName gets filled in with the file
* name for the application, if we figured it out. If we couldn't
* figure it out, Tcl_FindExecutable is set to NULL.
*
*----------------------------------------------------------------------
*/
void
Tcl_FindExecutable(argv0)
char *argv0; /* The value of the application's argv[0]. */
{
Tcl_DString buffer;
int length;
Tcl_DStringInit(&buffer);
if (tclExecutableName != NULL) {
ckfree(tclExecutableName);
tclExecutableName = NULL;
}
/*
* Under Windows we ignore argv0, and return the path for the file used to
* 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);
}
/*
*----------------------------------------------------------------------
*
* TclMatchFiles --
*
* 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
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
*
* Side effects:
* None.
*
*---------------------------------------------------------------------- */
int
TclMatchFiles(interp, separators, dirPtr, pattern, tail)
Tcl_Interp *interp; /* Interpreter to receive results. */
char *separators; /* Directory separators to pass to TclDoGlob. */
Tcl_DString *dirPtr; /* Contains path to directory to search. */
char *pattern; /* Pattern to match against. */
char *tail; /* Pointer to end of pattern. Tail must
* point to a location in pattern. */
{
char drivePattern[4] = "?:\\";
char *newPattern, *p, *dir, *root, c;
int length, matchDotFiles;
int result = TCL_OK;
int baseLength = Tcl_DStringLength(dirPtr);
Tcl_DString buffer;
DWORD atts, volFlags;
HANDLE handle;
WIN32_FIND_DATA data;
BOOL found;
/*
* Convert the path to normalized form since some interfaces only
* accept backslashes. Also, ensure that the directory ends with a
* separator character.
*/
Tcl_DStringInit(&buffer);
if (baseLength == 0) {
Tcl_DStringAppend(&buffer, ".", 1);
} else {
Tcl_DStringAppend(&buffer, Tcl_DStringValue(dirPtr),
Tcl_DStringLength(dirPtr));
}
for (p = Tcl_DStringValue(&buffer); *p != '\0'; p++) {
if (*p == '/') {
*p = '\\';
}
}
p--;
if (*p != '\\' && *p != ':') {
Tcl_DStringAppend(&buffer, "\\", 1);
}
dir = Tcl_DStringValue(&buffer);
/*
* First verify that the specified path is actually a directory.
*/
atts = GetFileAttributes(dir);
if ((atts == 0xFFFFFFFF) || ((atts & FILE_ATTRIBUTE_DIRECTORY) == 0)) {
Tcl_DStringFree(&buffer);
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 = GetVolumeInformation(NULL, NULL, 0, NULL,
NULL, &volFlags, NULL, 0);
break;
case TCL_PATH_VOLUME_RELATIVE:
if (*dir == '\\') {
root = NULL;
} else {
root = drivePattern;
*root = *dir;
}
found = GetVolumeInformation(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);
} else if (dir[1] == '\\') {
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;
}
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 the volume is not case sensitive, then we need to convert the pattern
* to lower case.
*/
length = tail - pattern;
newPattern = ckalloc(length+1);
if (volFlags & FS_CASE_SENSITIVE) {
strncpy(newPattern, pattern, length);
newPattern[length] = '\0';
} else {
char *src, *dest;
for (src = pattern, dest = newPattern; src < tail; src++, dest++) {
*dest = (char) tolower(*src);
}
*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);
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;
}
/*
* 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.
*/
Tcl_DStringInit(&buffer);
for (found = 1; found; found = FindNextFile(handle, &data)) {
char *matchResult;
/*
* Ignore hidden files.
*/
if ((data.dwFileAttributes & FILE_ATTRIBUTE_HIDDEN)
|| (!matchDotFiles && (data.cFileName[0] == '.'))) {
continue;
}
/*
* Check to see if the file matches the pattern. If the volume is not
* case sensitive, we need to convert the file name to lower case. If
* the volume also doesn't preserve case, then we return the lower case
* form of the name, otherwise we return the system form.
*/
matchResult = NULL;
if (!(volFlags & FS_CASE_SENSITIVE)) {
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;
}
}
} else {
if (Tcl_StringMatch(data.cFileName, newPattern)) {
matchResult = data.cFileName;
}
}
if (matchResult == 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.
*/
Tcl_DStringSetLength(dirPtr, baseLength);
Tcl_DStringAppend(dirPtr, matchResult, -1);
if (tail == NULL) {
Tcl_AppendElement(interp, dirPtr->string);
} else {
atts = GetFileAttributes(dirPtr->string);
if (atts & FILE_ATTRIBUTE_DIRECTORY) {
Tcl_DStringAppend(dirPtr, "/", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
break;
}
}
}
}
Tcl_DStringFree(&buffer);
FindClose(handle);
ckfree(newPattern);
return result;
}
/*
*----------------------------------------------------------------------
*
* TclChdir --
*
* Change the current working directory.
*
* 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.
*
* Side effects:
* The working directory for this application is changed. Also
* the cache maintained used by TclGetCwd is deallocated and
* set to NULL.
*
*----------------------------------------------------------------------
*/
int
TclChdir(interp, dirName)
Tcl_Interp *interp; /* If non NULL, used for error reporting. */
char *dirName; /* Path to new working directory. */
{
if (currentDir != NULL) {
ckfree(currentDir);
currentDir = NULL;
}
if (!SetCurrentDirectory(dirName)) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
Tcl_AppendResult(interp, "couldn't change working directory to \"",
dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
}
return TCL_ERROR;
}
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* TclGetCwd --
*
* Return the path name of the current working directory.
*
* 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.
*
* 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.
*
*----------------------------------------------------------------------
*/
char *
TclGetCwd(interp)
Tcl_Interp *interp; /* If non NULL, used for error reporting. */
{
char buffer[MAXPATHLEN+1], *bufPtr;
if (currentDir == NULL) {
if (GetCurrentDirectory(MAXPATHLEN+1, buffer) == 0) {
TclWinConvertError(GetLastError());
if (interp != NULL) {
if (errno == ERANGE) {
interp->result = "working directory name is too long";
} else {
Tcl_AppendResult(interp,
"error getting working directory name: ",
Tcl_PosixError(interp), (char *) NULL);
}
}
return NULL;
}
/*
* Watch for the wierd Windows '95 c:\\UNC syntax.
*/
if (buffer[0] != '\0' && buffer[1] == ':' && buffer[2] == '\\'
&& buffer[3] == '\\') {
bufPtr = &buffer[2];
} else {
bufPtr = buffer;
}
currentDir = (char *) ckalloc((unsigned) (strlen(bufPtr) + 1));
strcpy(currentDir, bufPtr);
/*
* Convert to forward slashes for easier use in scripts.
*/
for (bufPtr = currentDir; *bufPtr != '\0'; bufPtr++) {
if (*bufPtr == '\\') {
*bufPtr = '/';
}
}
}
return currentDir;
}