765 lines
19 KiB
C
765 lines
19 KiB
C
/*
|
||
* 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;
|
||
}
|