diff options
Diffstat (limited to 'unix/tclUnixFile.c')
| -rw-r--r-- | unix/tclUnixFile.c | 598 |
1 files changed, 0 insertions, 598 deletions
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c deleted file mode 100644 index 248079d..0000000 --- a/unix/tclUnixFile.c +++ /dev/null @@ -1,598 +0,0 @@ -/* - * 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.6 1999/04/16 00:48:05 stanton Exp $ - */ - -#include "tclInt.h" -#include "tclPort.h" - - -/* - *--------------------------------------------------------------------------- - * - * 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). */ -{ - CONST char *name, *p; - struct stat statBuf; - int length; - Tcl_DString buffer, nameString; - - if (argv0 == NULL) { - return NULL; - } - if (tclNativeExecutableName != NULL) { - return tclNativeExecutableName; - } - - 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); - tclNativeExecutableName = (char *) - ckalloc((unsigned) (Tcl_DStringLength(&nameString) + 1)); - strcpy(tclNativeExecutableName, 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; - tclNativeExecutableName = (char *) ckalloc((unsigned) length); - strcpy(tclNativeExecutableName, Tcl_DStringValue(&buffer)); - tclNativeExecutableName[Tcl_DStringLength(&buffer)] = '/'; - strcpy(tclNativeExecutableName + Tcl_DStringLength(&buffer) + 1, - Tcl_DStringValue(&nameString)); - Tcl_DStringFree(&nameString); - - done: - Tcl_DStringFree(&buffer); - return tclNativeExecutableName; -} - -/* - *---------------------------------------------------------------------- - * - * 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. Must not - * refer to a static string. */ -{ - 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; -} - |