Subversion Repositories or1k

/*

 * tclUnixFile.c --

 *

 *      This file contains wrappers around UNIX file handling functions.

 *      These wrappers mask differences between Windows and UNIX.

 *

 * Copyright (c) 1995 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.1.1 2002-01-16 10:25:37 markom Exp $

 */

#include "tclInt.h"

#include "tclPort.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;

static int currentDirExitHandlerSet = 0;

/*

 * The variable below is set if the exit routine for deleting the string

 * containing the executable name has been registered.

 */

static int executableNameExitHandlerSet = 0;

extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));

/*

 * Static routines for this file:

 */

static void     FreeCurrentDir _ANSI_ARGS_((ClientData clientData));

static void     FreeExecutableName _ANSI_ARGS_((ClientData clientData));

/*

 *----------------------------------------------------------------------

 *

 * FreeCurrentDir --

 *

 *      Frees the string stored in the currentDir variable. This routine

 *      is registered as an exit handler and will be called during shutdown.

 *

 * Results:

 *      None.

 *

 * Side effects:

 *      Frees the memory occuppied by the currentDir value.

 *

 *----------------------------------------------------------------------

 */

        /* ARGSUSED */

static void

FreeCurrentDir(clientData)

    ClientData clientData;      /* Not used. */

{

    if (currentDir != (char *) NULL) {

        ckfree(currentDir);

        currentDir = (char *) NULL;

        currentDirExitHandlerSet = 0;

    }

}

/*

 *----------------------------------------------------------------------

 *

 * FreeExecutableName --

 *

 *      Frees the string stored in the tclExecutableName variable. This

 *      routine is registered as an exit handler and will be called

 *      during shutdown.

 *

 * Results:

 *      None.

 *

 * Side effects:

 *      Frees the memory occuppied by the tclExecutableName value.

 *

 *----------------------------------------------------------------------

 */

        /* ARGSUSED */

static void

FreeExecutableName(clientData)

    ClientData clientData;      /* Not used. */

{

    if (tclExecutableName != (char *) NULL) {

        ckfree(tclExecutableName);

        tclExecutableName = (char *) NULL;

    }

}

/*

 *----------------------------------------------------------------------

 *

 * 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 (chdir(dirName) != 0) {

        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.

 *      The returned string is owned by the TclGetCwd routine and must

 *      not be freed by the caller.  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];

    if (currentDir == NULL) {

        if (!currentDirExitHandlerSet) {

            currentDirExitHandlerSet = 1;

            Tcl_CreateExitHandler(FreeCurrentDir, (ClientData) NULL);

        }

#ifdef USEGETWD

        if ((int)getwd(buffer) == (int)NULL) {

            if (interp != NULL) {

                Tcl_AppendResult(interp,

                        "error getting working directory name: ",

                        buffer, (char *)NULL);

            }

            return NULL;

        }

#else

        if (getcwd(buffer, MAXPATHLEN+1) == NULL) {

            if (interp != NULL) {

                if (errno == ERANGE) {

                    Tcl_SetResult(interp,

                            "working directory name is too long",

                            TCL_STATIC);

                } else {

                    Tcl_AppendResult(interp,

                            "error getting working directory name: ",

                            Tcl_PosixError(interp), (char *) NULL);

                }

            }

            return NULL;

        }

#endif

        currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));

        strcpy(currentDir, buffer);

    }

    return currentDir;

}

/*

 *----------------------------------------------------------------------

 *

 * 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]. */

{

    char *name, *p, *cwd;

    Tcl_DString buffer;

    int length;

    struct stat statBuf;

    Tcl_DStringInit(&buffer);

    if (tclExecutableName != NULL) {

        ckfree(tclExecutableName);

        tclExecutableName = NULL;

    }

    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");

    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 (*p != 0) {

        while (isspace(UCHAR(*p))) {

            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);

            }

        }

        Tcl_DStringAppend(&buffer, argv0, -1);

        if ((TclAccess(Tcl_DStringValue(&buffer), X_OK) == 0)

                && (TclStat(Tcl_DStringValue(&buffer), &statBuf) == 0)

                && S_ISREG(statBuf.st_mode)) {

            name = Tcl_DStringValue(&buffer);

            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] == '/')  {

        tclExecutableName = (char *) ckalloc((unsigned) (strlen(name) + 1));

        strcpy(tclExecutableName, name);

        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;

    }

    cwd = TclGetCwd((Tcl_Interp *) NULL);

    if (cwd == NULL) {

        tclExecutableName = NULL;

        goto done;

    }

    length = strlen(cwd);

    tclExecutableName = (char *) ckalloc((unsigned)

            (length + strlen(name) + 2));

    strcpy(tclExecutableName, cwd);

    tclExecutableName[length] = '/';

    strcpy(tclExecutableName + length + 1, name);

    done:

    Tcl_DStringFree(&buffer);

    if (!executableNameExitHandlerSet) {

        executableNameExitHandlerSet = 1;

        Tcl_CreateExitHandler(FreeExecutableName, (ClientData) NULL);

    }

}

/*

 *----------------------------------------------------------------------

 *

 * TclGetUserHome --

 *

 *      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 static string containing

 *      the new name.  If there was an error in processing the

 *      user name then the return value is NULL.  Otherwise the

 *      result is stored in bufferPtr, and the caller must call

 *      Tcl_DStringFree(bufferPtr) to free the result.

 *

 * Side effects:

 *      Information may be left in bufferPtr.

 *

 *----------------------------------------------------------------------

 */

char *

TclGetUserHome(name, bufferPtr)

    char *name;                 /* User name to use to find home directory. */

    Tcl_DString *bufferPtr;     /* May be used to hold result.  Must not hold

                                 * anything at the time of the call, and need

                                 * not even be initialized. */

{

    struct passwd *pwPtr;

    pwPtr = getpwnam(name);

    if (pwPtr == NULL) {

        endpwent();

        return NULL;

    }

    Tcl_DStringInit(bufferPtr);

    Tcl_DStringAppend(bufferPtr, pwPtr->pw_dir, -1);

    endpwent();

    return bufferPtr->string;

}

/*

 *----------------------------------------------------------------------

 *

 * 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;           /* 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 *dirName, *patternEnd = tail;

    char savedChar = 0;          /* Initialization needed only to prevent

                                 * compiler warning from gcc. */

    DIR *d;

    struct stat statBuf;

    struct dirent *entryPtr;

    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 (dirPtr->string[0] == '\0') {

        dirName = ".";

    } else {

        dirName = dirPtr->string;

    }

    if ((TclStat(dirName, &statBuf) != 0) || !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.

     */

    d = opendir(dirName);

    if (d == NULL) {

        Tcl_ResetResult(interp);

        /*

         * Strip off a trailing '/' if necessary, before reporting the error.

         */

        if (baseLength > 0) {

            savedChar = dirPtr->string[baseLength-1];

            if (savedChar == '/') {

                dirPtr->string[baseLength-1] = '\0';

            }

        }

        Tcl_AppendResult(interp, "couldn't read directory \"",

                dirPtr->string, "\": ", Tcl_PosixError(interp), (char *) NULL);

        if (baseLength > 0) {

            dirPtr->string[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) {

        entryPtr = readdir(d);

        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.

         */

        if (Tcl_StringMatch(entryPtr->d_name, pattern)) {

            Tcl_DStringSetLength(dirPtr, baseLength);

            Tcl_DStringAppend(dirPtr, entryPtr->d_name, -1);

            if (tail == NULL) {

                Tcl_AppendElement(interp, dirPtr->string);

            } else if ((TclStat(dirPtr->string, &statBuf) == 0)

                    && S_ISDIR(statBuf.st_mode)) {

                Tcl_DStringAppend(dirPtr, "/", 1);

                result = TclDoGlob(interp, separators, dirPtr, tail);

                if (result != TCL_OK) {

                    break;

                }

            }

        }

    }

    *patternEnd = savedChar;

    closedir(d);

    return result;

}