/*
* tclUnixFile.c --
*
* This file contains wrappers around UNIX file handling functions.
* These wrappers mask differences between Windows and UNIX.
*
* 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: tclUnixFile.c,v 1.1.2.4 1998/09/30 23:01:11 stanton Exp $
*/
#include "tclInt.h"
#include "tclPort.h"
/*
*---------------------------------------------------------------------------
*
* 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, tclExecutableName is set to NULL.
*
*---------------------------------------------------------------------------
*/
void
Tcl_FindExecutable(argv0)
CONST char *argv0; /* The value of the application's argv[0]
* (native). */
{
CONST char *name, *p;
int length;
struct stat statBuf;
Tcl_DString buffer, nameString;
TclInitSubsystems(argv0);
if (argv0 == NULL) {
return;
}
if (tclExecutableName != NULL) {
ckfree(tclExecutableName);
tclExecutableName = NULL;
}
Tcl_DStringInit(&buffer);
name = argv0;
for (p = name; *p != '\0'; p++) {
if (*p == '/') {
/*
* The name contains a slash, so use the name directly
* without doing a path search.
*/
goto gotName;
}
}
p = getenv("PATH"); /* INTL: Native. */
if (p == NULL) {
/*
* There's no PATH environment variable; use the default that
* is used by sh.
*/
p = ":/bin:/usr/bin";
} else if (*p == '\0') {
/*
* An empty path is equivalent to ".".
*/
p = "./";
}
/*
* Search through all the directories named in the PATH variable
* to see if argv[0] is in one of them. If so, use that file
* name.
*/
while (1) {
while (isspace(UCHAR(*p))) { /* INTL: BUG */
p++;
}
name = p;
while ((*p != ':') && (*p != 0)) {
p++;
}
Tcl_DStringSetLength(&buffer, 0);
if (p != name) {
Tcl_DStringAppend(&buffer, name, p - name);
if (p[-1] != '/') {
Tcl_DStringAppend(&buffer, "/", 1);
}
}
name = Tcl_DStringAppend(&buffer, argv0, -1);
/*
* INTL: The following calls to access() and stat() should not be
* converted to Tclp routines because they need to operate on native
* strings directly.
*/
if ((access(name, X_OK) == 0) /* INTL: Native. */
&& (stat(name, &statBuf) == 0) /* INTL: Native. */
&& S_ISREG(statBuf.st_mode)) {
goto gotName;
}
if (*p == '\0') {
break;
} else if (*(p+1) == 0) {
p = "./";
} else {
p++;
}
}
goto done;
/*
* If the name starts with "/" then just copy it to tclExecutableName.
*/
gotName:
if (name[0] == '/') {
Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
tclExecutableName = (char *)
ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1));
strcpy(tclExecutableName, Tcl_DStringValue(&nameString));
Tcl_DStringFree(&nameString);
goto done;
}
/*
* The name is relative to the current working directory. First
* strip off a leading "./", if any, then add the full path name of
* the current working directory.
*/
if ((name[0] == '.') && (name[1] == '/')) {
name += 2;
}
Tcl_ExternalToUtfDString(NULL, name, -1, &nameString);
Tcl_DStringFree(&buffer);
TclpGetCwd(NULL, &buffer);
length = Tcl_DStringLength(&buffer) + Tcl_DStringLength(&nameString) + 2;
tclExecutableName = (char *) ckalloc((unsigned) length);
strcpy(tclExecutableName, Tcl_DStringValue(&buffer));
tclExecutableName[Tcl_DStringLength(&buffer)] = '/';
strcpy(tclExecutableName + Tcl_DStringLength(&buffer) + 1,
Tcl_DStringValue(&nameString));
Tcl_DStringFree(&nameString);
done:
Tcl_DStringFree(&buffer);
}
/*
*----------------------------------------------------------------------
*
* TclpMatchFiles --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
* added to the 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
TclpMatchFiles(interp, separators, dirPtr, pattern, tail)
Tcl_Interp *interp; /* Interpreter to receive results. */
char *separators; /* Path 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. */
{
char *native, *dirName, *patternEnd = tail;
char savedChar = 0; /* lint. */
DIR *d;
Tcl_DString ds;
struct stat statBuf;
int matchHidden;
int result = TCL_OK;
int baseLength = Tcl_DStringLength(dirPtr);
/*
* Make sure that the directory part of the name really is a
* directory. If the directory name is "", use the name "."
* instead, because some UNIX systems don't treat "" like "."
* automatically. Keep the "" for use in generating file names,
* otherwise "glob foo.c" would return "./foo.c".
*/
if (Tcl_DStringLength(dirPtr) == 0) {
dirName = ".";
} else {
dirName = Tcl_DStringValue(dirPtr);
}
if ((TclpStat(dirName, &statBuf) != 0) /* INTL: UTF-8. */
|| !S_ISDIR(statBuf.st_mode)) {
return TCL_OK;
}
/*
* Check to see if the pattern needs to compare with hidden files.
*/
if ((pattern[0] == '.')
|| ((pattern[0] == '\\') && (pattern[1] == '.'))) {
matchHidden = 1;
} else {
matchHidden = 0;
}
/*
* Now open the directory for reading and iterate over the contents.
*/
native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
d = opendir(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (d == NULL) {
Tcl_ResetResult(interp);
/*
* Strip off a trailing '/' if necessary, before reporting the error.
*/
if (baseLength > 0) {
savedChar = (Tcl_DStringValue(dirPtr))[baseLength-1];
if (savedChar == '/') {
(Tcl_DStringValue(dirPtr))[baseLength-1] = '\0';
}
}
Tcl_AppendResult(interp, "couldn't read directory \"",
Tcl_DStringValue(dirPtr), "\": ",
Tcl_PosixError(interp), (char *) NULL);
if (baseLength > 0) {
(Tcl_DStringValue(dirPtr))[baseLength-1] = savedChar;
}
return TCL_ERROR;
}
/*
* Clean up the end of the pattern and the tail pointer. Leave
* the tail pointing to the first character after the path separator
* following the pattern, or NULL. Also, ensure that the pattern
* is null-terminated.
*/
if (*tail == '\\') {
tail++;
}
if (*tail == '\0') {
tail = NULL;
} else {
tail++;
}
savedChar = *patternEnd;
*patternEnd = '\0';
while (1) {
char *utf;
struct dirent *entryPtr;
entryPtr = readdir(d); /* INTL: Native. */
if (entryPtr == NULL) {
break;
}
/*
* Don't match names starting with "." unless the "." is
* present in the pattern.
*/
if (!matchHidden && (*entryPtr->d_name == '.')) {
continue;
}
/*
* Now check to see if the file matches. If there are more
* characters to be processed, then ensure matching files are
* directories before calling TclDoGlob. Otherwise, just add
* the file to the result.
*/
utf = Tcl_ExternalToUtfDString(NULL, entryPtr->d_name, -1, &ds);
if (Tcl_StringMatch(utf, pattern) != 0) {
Tcl_DStringSetLength(dirPtr, baseLength);
Tcl_DStringAppend(dirPtr, utf, -1);
if (tail == NULL) {
Tcl_AppendElement(interp, Tcl_DStringValue(dirPtr));
} else if ((TclpStat(Tcl_DStringValue(dirPtr), &statBuf) == 0)
&& S_ISDIR(statBuf.st_mode)) {
Tcl_DStringAppend(dirPtr, "/", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
Tcl_DStringFree(&ds);
break;
}
}
}
Tcl_DStringFree(&ds);
}
*patternEnd = savedChar;
closedir(d);
return result;
}
/*
*---------------------------------------------------------------------------
*
* TclpGetUserHome --
*
* This function takes the specified user name and finds their
* home directory.
*
* 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. */
{
struct passwd *pwPtr;
Tcl_DString ds;
char *native;
native = Tcl_UtfToExternalDString(NULL, name, -1, &ds);
pwPtr = getpwnam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (pwPtr == NULL) {
endpwent();
return NULL;
}
Tcl_ExternalToUtfDString(NULL, pwPtr->pw_dir, -1, bufferPtr);
endpwent();
return Tcl_DStringValue(bufferPtr);
}
/*
*---------------------------------------------------------------------------
*
* TclpAccess --
*
* This function replaces the library version of access().
*
* Results:
* See access() documentation.
*
* Side effects:
* See access() documentation.
*
*---------------------------------------------------------------------------
*/
int
TclpAccess(path, mode)
CONST char *path; /* Path of file to access (UTF-8). */
int mode; /* Permission setting. */
{
int result;
Tcl_DString ds;
char *native;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
result = access(native, mode); /* INTL: Native. */
Tcl_DStringFree(&ds);
return result;
}
/*
*---------------------------------------------------------------------------
*
* TclpChdir --
*
* This function replaces the library version of chdir().
*
* Results:
* See chdir() documentation.
*
* Side effects:
* See chdir() documentation.
*
*---------------------------------------------------------------------------
*/
int
TclpChdir(dirName)
CONST char *dirName; /* Path to new working directory (UTF-8). */
{
int result;
Tcl_DString ds;
char *native;
native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
result = chdir(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
return result;
}
/*
*----------------------------------------------------------------------
*
* TclpLstat --
*
* This function replaces the library version of lstat().
*
* Results:
* See lstat() documentation.
*
* Side effects:
* See lstat() documentation.
*
*----------------------------------------------------------------------
*/
int
TclpLstat(path, bufPtr)
CONST char *path; /* Path of file to stat (UTF-8). */
struct stat *bufPtr; /* Filled with results of stat call. */
{
int result;
Tcl_DString ds;
char *native;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
result = lstat(native, bufPtr); /* INTL: Native. */
Tcl_DStringFree(&ds);
return result;
}
/*
*---------------------------------------------------------------------------
*
* 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. */
{
char buffer[MAXPATHLEN+1];
#ifdef USEGETWD
if (getwd(buffer) == NULL) { /* INTL: Native. */
#else
if (getcwd(buffer, MAXPATHLEN + 1) == NULL) { /* INTL: Native. */
#endif
if (interp != NULL) {
Tcl_AppendResult(interp,
"error getting working directory name: ",
Tcl_PosixError(interp), (char *) NULL);
}
return NULL;
}
return Tcl_ExternalToUtfDString(NULL, buffer, -1, bufferPtr);
}
/*
*---------------------------------------------------------------------------
*
* TclpReadlink --
*
* This function replaces the library version of readlink().
*
* Results:
* The result is a pointer to a string specifying the contents
* of the symbolic link given by 'path', or NULL if the symbolic
* link could not be read. Storage for the result string is
* allocated in bufferPtr; the caller must call Tcl_DStringFree()
* when the result is no longer needed.
*
* Side effects:
* See readlink() documentation.
*
*---------------------------------------------------------------------------
*/
char *
TclpReadlink(path, linkPtr)
CONST char *path; /* Path of file to readlink (UTF-8). */
Tcl_DString *linkPtr; /* Uninitialized or free DString filled
* with contents of link (UTF-8). */
{
char link[MAXPATHLEN];
int length;
char *native;
Tcl_DString ds;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
length = readlink(native, link, sizeof(link)); /* INTL: Native. */
Tcl_DStringFree(&ds);
if (length < 0) {
return NULL;
}
Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
return Tcl_DStringValue(linkPtr);
}
/*
*----------------------------------------------------------------------
*
* TclpStat --
*
* This function replaces the library version of stat().
*
* Results:
* See stat() documentation.
*
* Side effects:
* See stat() documentation.
*
*----------------------------------------------------------------------
*/
int
TclpStat(path, bufPtr)
CONST char *path; /* Path of file to stat (in UTF-8). */
struct stat *bufPtr; /* Filled with results of stat call. */
{
int result;
Tcl_DString ds;
char *native;
native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
result = stat(native, bufPtr); /* INTL: Native. */
Tcl_DStringFree(&ds);
return result;
}