libtksh/tcl/tclUnixFile.c

/*
 * 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.
 *
 * SCCS: @(#) tclUnixFile.c 1.41 96/12/05 14:59:20
 */

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

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitPid --
 *
 *  Implements the waitpid system call on Unix systems.
 *
 * Results:
 *  Result of calling waitpid.
 *
 * Side effects:
 *  Waits for a process to terminate.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitPid(pid, statPtr, options)
    int pid;
    int *statPtr;
    int options;
{
    int result;
    pid_t real_pid;

    real_pid = (pid_t) pid;
    while (1) {
    result = (int) waitpid(real_pid, statPtr, options);
    if ((result != -1) || (errno != EINTR)) {
        return result;
    }
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * 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);
        }
    if (getcwd(buffer, MAXPATHLEN+1) == NULL) {
        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;
    }
    currentDir = (char *) ckalloc((unsigned) (strlen(buffer) + 1));
    strcpy(currentDir, buffer);
    }
    return currentDir;
}

/*
 *----------------------------------------------------------------------
 *
 * TclOpenFile --
 *
 *  Implements a mechanism to open files on Unix systems.
 *
 * Results:
 *  The opened file.
 *
 * Side effects:
 *  May cause a file to be created on the file system.
 *
 *----------------------------------------------------------------------
 */

Tcl_File
TclOpenFile(fname, mode)
    char *fname;            /* The name of the file to open. */
    int mode;               /* In what mode to open the file? */
{
    int fd;

    fd = open(fname, mode, S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH);
    if (fd != -1) {
        fcntl(fd, F_SETFD, FD_CLOEXEC);
        return Tcl_GetFile((ClientData)fd, TCL_UNIX_FD);
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCloseFile --
 *
 *  Implements a mechanism to close a UNIX file.
 *
 * Results:
 *  Returns 0 on success, or -1 on error, setting errno.
 *
 * Side effects:
 *  The file is closed.
 *
 *----------------------------------------------------------------------
 */

int
TclCloseFile(file)
    Tcl_File file;  /* The file to close. */
{
    int type;
    int fd;
    int result;

    fd = (int) Tcl_GetFileInfo(file, &type);
    if (type != TCL_UNIX_FD) {
    panic("Tcl_CloseFile: unexpected file type");
    }

    /*
     * Refuse to close the fds for stdin, stdout and stderr.
     */

    if ((fd == 0) || (fd == 1) || (fd == 2)) {
        return 0;
    }

    result = close(fd);
    Tcl_DeleteFileHandler(file);
    Tcl_FreeFile(file);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclReadFile --
 *
 *  Implements a mechanism to read from files on Unix systems. Also
 *  simulates blocking behavior on non-blocking files when asked to.
 *
 * Results:
 *  The number of characters read from the specified file.
 *
 * Side effects:
 *  May consume characters from the file.
 *
 *----------------------------------------------------------------------
 */
    /* ARGSUSED */
int
TclReadFile(file, shouldBlock, buf, toRead)
    Tcl_File file;  /* The file to read from. */
    int shouldBlock;        /* Not used. */
    char *buf;          /* The buffer to store input in. */
    int toRead;         /* Number of characters to read. */
{
    int type, fd;

    fd = (int) Tcl_GetFileInfo(file, &type);
    if (type != TCL_UNIX_FD) {
    panic("Tcl_ReadFile: unexpected file type");
    }

    return read(fd, buf, (size_t) toRead);
}

/*
 *----------------------------------------------------------------------
 *
 * TclWriteFile --
 *
 *  Implements a mechanism to write to files on Unix systems.
 *
 * Results:
 *  The number of characters written to the specified file.
 *
 * Side effects:
 *  May produce characters on the file.
 *
 *----------------------------------------------------------------------
 */

    /* ARGSUSED */
int
TclWriteFile(file, shouldBlock, buf, toWrite)
    Tcl_File file;  /* The file to write to. */
    int shouldBlock;        /* Not used. */
    char *buf;          /* Where output is stored. */
    int toWrite;        /* Number of characters to write. */
{
    int type, fd;

    fd = (int) Tcl_GetFileInfo(file, &type);
    if (type != TCL_UNIX_FD) {
    panic("Tcl_WriteFile: unexpected file type");
    }
    return write(fd, buf, (size_t) toWrite);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSeekFile --
 *
 *  Sets the file pointer on the indicated UNIX file.
 *
 * Results:
 *  The new position at which the file will be accessed, or -1 on
 *  failure.
 *
 * Side effects:
 *  May change the position at which subsequent operations access the
 *  file designated by the file.
 *
 *----------------------------------------------------------------------
 */

int
TclSeekFile(file, offset, whence)
    Tcl_File file;  /* The file to seek on. */
    int offset;         /* How far to seek? */
    int whence;         /* And from where to seek? */
{
    int type, fd;

    fd = (int) Tcl_GetFileInfo(file, &type);
    if (type != TCL_UNIX_FD) {
    panic("Tcl_SeekFile: unexpected file type");
    }

    return lseek(fd, offset, whence);
}

/*
 *----------------------------------------------------------------------
 *
 * TclCreateTempFile --
 *
 *  This function creates a temporary file initialized with an
 *  optional string, and returns a file handle with the file pointer
 *  at the beginning of the file.
 *
 * Results:
 *  A handle to a file.
 *
 * Side effects:
 *  None.
 *
 *----------------------------------------------------------------------
 */

Tcl_File
#ifdef TKSH_V5
TclCreateTempFile(contents)
#else
TclCreateTempFile(contents, namePtr)
#endif
    char *contents;     /* String to write into temp file, or NULL. */
#ifndef TKSH_V5
    Tcl_DString *namePtr;   /* If non-NULL, pointer to initialized
                 * DString that is filled with the name of
                 * the temp file that was created. */
#endif
{
    char fileName[L_tmpnam];
    Tcl_File file;
    size_t length = (contents == NULL) ? 0 : strlen(contents);

    tmpnam(fileName);
    file = TclOpenFile(fileName, O_RDWR|O_CREAT|O_TRUNC);
    unlink(fileName);

    if ((file != NULL) && (length > 0)) {
    int fd = (int)Tcl_GetFileInfo(file, NULL);
    while (1) {
        if (write(fd, contents, length) != -1) {
        break;
        } else if (errno != EINTR) {
        close(fd);
        Tcl_FreeFile(file);
        return NULL;
        }
    }
    lseek(fd, 0, SEEK_SET);
    }
#ifndef TKSH_V5
    if (namePtr != NULL) {
    Tcl_DStringAppend(namePtr, fileName, -1);
    }
#endif
    return file;
}

/*
 *----------------------------------------------------------------------
 *
 * 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;

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

    /*
     * 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 (access(Tcl_DStringValue(&buffer), X_OK) == 0) {
        name = Tcl_DStringValue(&buffer);
        goto gotName;
    }
    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;
}

#if 0
/*
 *----------------------------------------------------------------------
 *
 * 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 ((stat(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 ((stat(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;
}
#endif