URL https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [tclUnixFCmd.c] - Blame information for rev 578

Go to most recent revision | Details | Compare with Previous | View Log

/*
 * tclUnixFCmd.c
 *
 *      This file implements the unix specific portion of file manipulation
 *      subcommands of the "file" command.  All filename arguments should
 *      already be translated to native format.
 *
 * Copyright (c) 1996-1997 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: tclUnixFCmd.c,v 1.1.1.1 2002-01-16 10:25:37 markom Exp $
 *
 * Portions of this code were derived from NetBSD source code which has
 * the following copyright notice:
 *
 * Copyright (c) 1988, 1993, 1994
 *      The Regents of the University of California.  All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgement:
 *      This product includes software developed by the University of
 *      California, Berkeley and its contributors.
 * 4. Neither the name of the University nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */
 
#include "tclInt.h"
#include "tclPort.h"
#include <utime.h>
#include <grp.h>
 
/*
 * The following constants specify the type of callback when
 * TraverseUnixTree() calls the traverseProc()
 */
 
#define DOTREE_PRED   1     /* pre-order directory  */
#define DOTREE_POSTD  2     /* post-order directory */
#define DOTREE_F      3     /* regular file */
 
/*
 * Callbacks for file attributes code.
 */
 
static int              GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
                            int objIndex, char *fileName,
                            Tcl_Obj **attributePtrPtr));
static int              GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
                            int objIndex, char *fileName,
                            Tcl_Obj **attributePtrPtr));
static int              GetPermissionsAttribute _ANSI_ARGS_((
                            Tcl_Interp *interp, int objIndex, char *fileName,
                            Tcl_Obj **attributePtrPtr));
static int              SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
                            int objIndex, char *fileName,
                            Tcl_Obj *attributePtr));
static int              SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
                            int objIndex, char *fileName,
                            Tcl_Obj *attributePtr));
static int              SetPermissionsAttribute _ANSI_ARGS_((
                            Tcl_Interp *interp, int objIndex, char *fileName,
                            Tcl_Obj *attributePtr));
 
/*
 * Prototype for the TraverseUnixTree callback function.
 */
 
typedef int (TraversalProc) _ANSI_ARGS_((char *src, char *dst,
        struct stat *sb, int type, Tcl_DString *errorPtr));
 
/*
 * Constants and variables necessary for file attributes subcommand.
 */
 
enum {
    UNIX_GROUP_ATTRIBUTE,
    UNIX_OWNER_ATTRIBUTE,
    UNIX_PERMISSIONS_ATTRIBUTE
};
 
char *tclpFileAttrStrings[] = {"-group", "-owner", "-permissions",
        (char *) NULL};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
        {GetGroupAttribute, SetGroupAttribute},
        {GetOwnerAttribute, SetOwnerAttribute},
        {GetPermissionsAttribute, SetPermissionsAttribute}};
 
/*
 * Declarations for local procedures defined in this file:
 */
 
static int              CopyFile _ANSI_ARGS_((char *src, char *dst,
                            struct stat *srcStatBufPtr));
static int              CopyFileAtts _ANSI_ARGS_((char *src, char *dst,
                            struct stat *srcStatBufPtr));
static int              TraversalCopy _ANSI_ARGS_((char *src, char *dst,
                            struct stat *sbPtr, int type,
                            Tcl_DString *errorPtr));
static int              TraversalDelete _ANSI_ARGS_((char *src, char *dst,
                            struct stat *sbPtr, int type,
                            Tcl_DString *errorPtr));
static int              TraverseUnixTree _ANSI_ARGS_((
                            TraversalProc *traversalProc,
                            Tcl_DString *sourcePath, Tcl_DString *destPath,
                            Tcl_DString *errorPtr));
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpRenameFile --
 *
 *      Changes the name of an existing file or directory, from src to dst.
 *      If src and dst refer to the same file or directory, does nothing
 *      and returns success.  Otherwise if dst already exists, it will be
 *      deleted and replaced by src subject to the following conditions:
 *          If src is a directory, dst may be an empty directory.
 *          If src is a file, dst may be a file.
 *      In any other situation where dst already exists, the rename will
 *      fail.
 *
 * Results:
 *      If the directory was successfully created, returns TCL_OK.
 *      Otherwise the return value is TCL_ERROR and errno is set to
 *      indicate the error.  Some possible values for errno are:
 *
 *      EACCES:     src or dst parent directory can't be read and/or written.
 *      EEXIST:     dst is a non-empty directory.
 *      EINVAL:     src is a root directory or dst is a subdirectory of src.
 *      EISDIR:     dst is a directory, but src is not.
 *      ENOENT:     src doesn't exist, or src or dst is "".
 *      ENOTDIR:    src is a directory, but dst is not.
 *      EXDEV:      src and dst are on different filesystems.
 *
 * Side effects:
 *      The implementation of rename may allow cross-filesystem renames,
 *      but the caller should be prepared to emulate it with copy and
 *      delete if errno is EXDEV.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpRenameFile(src, dst)
    char *src;                  /* Pathname of file or dir to be renamed. */
    char *dst;                  /* New pathname of file or directory. */
{
    if (rename(src, dst) == 0) {
        return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
        errno = EEXIST;
    }
 
#ifdef sparc
    /*
     * SunOS 4.1.4 reports overwriting a non-empty directory with a
     * directory as EINVAL instead of EEXIST (first rule out the correct
     * EINVAL result code for moving a directory into itself).  Must be
     * conditionally compiled because realpath() is only defined on SunOS.
     */
 
    if (errno == EINVAL) {
        char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
        DIR *dirPtr;
        struct dirent *dirEntPtr;
 
        if ((realpath(src, srcPath) != NULL)
                && (realpath(dst, dstPath) != NULL)
                && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
            dirPtr = opendir(dst);
            if (dirPtr != NULL) {
                while ((dirEntPtr = readdir(dirPtr)) != NULL) {
                    if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
                            (strcmp(dirEntPtr->d_name, "..") != 0)) {
                        errno = EEXIST;
                        closedir(dirPtr);
                        return TCL_ERROR;
                    }
                }
                closedir(dirPtr);
            }
        }
        errno = EINVAL;
    }
#endif  /* sparc */
 
    if (strcmp(src, "/") == 0) {
        /*
         * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
         * instead of EINVAL.
         */
 
        errno = EINVAL;
    }
 
    /*
     * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a
     * file across filesystems and the parent directory of that file is
     * not writable.  Most other systems return EXDEV.  Does nothing to
     * correct this behavior.
     */
 
    return TCL_ERROR;
}
 
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpCopyFile --
 *
 *      Copy a single file (not a directory).  If dst already exists and
 *      is not a directory, it is removed.
 *
 * Results:
 *      If the file was successfully copied, returns TCL_OK.  Otherwise
 *      the return value is TCL_ERROR and errno is set to indicate the
 *      error.  Some possible values for errno are:
 *
 *      EACCES:     src or dst parent directory can't be read and/or written.
 *      EISDIR:     src or dst is a directory.
 *      ENOENT:     src doesn't exist.  src or dst is "".
 *
 * Side effects:
 *      This procedure will also copy symbolic links, block, and
 *      character devices, and fifos.  For symbolic links, the links
 *      themselves will be copied and not what they point to.  For the
 *      other special file types, the directory entry will be copied and
 *      not the contents of the device that it refers to.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpCopyFile(src, dst)
    char *src;                  /* Pathname of file to be copied. */
    char *dst;                  /* Pathname of file to copy to. */
{
    struct stat srcStatBuf, dstStatBuf;
    char link[MAXPATHLEN];
    int length;
 
    /*
     * Have to do a stat() to determine the filetype.
     */
 
    if (lstat(src, &srcStatBuf) != 0) {
        return TCL_ERROR;
    }
    if (S_ISDIR(srcStatBuf.st_mode)) {
        errno = EISDIR;
        return TCL_ERROR;
    }
 
    /*
     * symlink, and some of the other calls will fail if the target
     * exists, so we remove it first
     */
 
    if (lstat(dst, &dstStatBuf) == 0) {
        if (S_ISDIR(dstStatBuf.st_mode)) {
            errno = EISDIR;
            return TCL_ERROR;
        }
    }
    if (unlink(dst) != 0) {
        if (errno != ENOENT) {
            return TCL_ERROR;
        }
    }
 
    switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
        case S_IFLNK:
            length = readlink(src, link, sizeof(link));
            if (length == -1) {
                return TCL_ERROR;
            }
            link[length] = '\0';
            if (symlink(link, dst) < 0) {
                return TCL_ERROR;
            }
            break;
 
        case S_IFBLK:
        case S_IFCHR:
            if (mknod(dst, srcStatBuf.st_mode, srcStatBuf.st_rdev) < 0) {
                return TCL_ERROR;
            }
            return CopyFileAtts(src, dst, &srcStatBuf);
 
#ifndef __CYGWIN__
        case S_IFIFO:
            if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
                return TCL_ERROR;
            }
            return CopyFileAtts(src, dst, &srcStatBuf);
#endif
 
        default:
            return CopyFile(src, dst, &srcStatBuf);
    }
 
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * CopyFile -
 *
 *      Helper function for TclpCopyFile.  Copies one regular file,
 *      using read() and write().
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      A file is copied.  Dst will be overwritten if it exists.
 *
 *----------------------------------------------------------------------
 */
 
static int
CopyFile(src, dst, srcStatBufPtr)
    char *src;                   /* Pathname of file to copy. */
    char *dst;                   /* Pathname of file to create/overwrite. */
    struct stat *srcStatBufPtr;  /* Used to determine mode and blocksize */
{
    int srcFd;
    int dstFd;
    u_int blockSize;   /* Optimal I/O blocksize for filesystem */
    char *buffer;      /* Data buffer for copy */
    size_t nread;
 
    if ((srcFd = open(src, O_RDONLY, 0)) < 0) {
        return TCL_ERROR;
    }
 
    dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, srcStatBufPtr->st_mode);
    if (dstFd < 0) {
        close(srcFd);
        return TCL_ERROR;
    }
 
#if HAVE_ST_BLKSIZE
    blockSize = srcStatBufPtr->st_blksize;
#else
    blockSize = 4096;
#endif
 
    buffer = ckalloc(blockSize);
    while (1) {
        nread = read(srcFd, buffer, blockSize);
        if ((nread == -1) || (nread == 0)) {
            break;
        }
        if (write(dstFd, buffer, nread) != nread) {
            nread = (size_t) -1;
            break;
        }
    }
 
    ckfree(buffer);
    close(srcFd);
    if ((close(dstFd) != 0) || (nread == -1)) {
        unlink(dst);
        return TCL_ERROR;
    }
    if (CopyFileAtts(src, dst, srcStatBufPtr) == TCL_ERROR) {
        /*
         * The copy succeeded, but setting the permissions failed, so be in
         * a consistent state, we remove the file that was created by the
         * copy.
         */
 
        unlink(dst);
        return TCL_ERROR;
    }
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpDeleteFile --
 *
 *      Removes a single file (not a directory).
 *
 * Results:
 *      If the file was successfully deleted, returns TCL_OK.  Otherwise
 *      the return value is TCL_ERROR and errno is set to indicate the
 *      error.  Some possible values for errno are:
 *
 *      EACCES:     a parent directory can't be read and/or written.
 *      EISDIR:     path is a directory.
 *      ENOENT:     path doesn't exist or is "".
 *
 * Side effects:
 *      The file is deleted, even if it is read-only.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpDeleteFile(path)
    char *path;                 /* Pathname of file to be removed. */
{
    if (unlink(path) != 0) {
        return TCL_ERROR;
    }
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpCreateDirectory --
 *
 *      Creates the specified directory.  All parent directories of the
 *      specified directory must already exist.  The directory is
 *      automatically created with permissions so that user can access
 *      the new directory and create new files or subdirectories in it.
 *
 * Results:
 *      If the directory was successfully created, returns TCL_OK.
 *      Otherwise the return value is TCL_ERROR and errno is set to
 *      indicate the error.  Some possible values for errno are:
 *
 *      EACCES:     a parent directory can't be read and/or written.
 *      EEXIST:     path already exists.
 *      ENOENT:     a parent directory doesn't exist.
 *
 * Side effects:
 *      A directory is created with the current umask, except that
 *      permission for u+rwx will always be added.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpCreateDirectory(path)
    char *path;                 /* Pathname of directory to create. */
{
    mode_t mode;
 
    mode = umask(0);
    umask(mode);
 
    /*
     * umask return value is actually the inverse of the permissions.
     */
 
    mode = (0777 & ~mode);
 
    if (mkdir(path, mode | S_IRUSR | S_IWUSR | S_IXUSR) != 0) {
        return TCL_ERROR;
    }
    return TCL_OK;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpCopyDirectory --
 *
 *      Recursively copies a directory.  The target directory dst must
 *      not already exist.  Note that this function does not merge two
 *      directory hierarchies, even if the target directory is an an
 *      empty directory.
 *
 * Results:
 *      If the directory was successfully copied, returns TCL_OK.
 *      Otherwise the return value is TCL_ERROR, errno is set to indicate
 *      the error, and the pathname of the file that caused the error
 *      is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
 *      for a description of possible values for errno.
 *
 * Side effects:
 *      An exact copy of the directory hierarchy src will be created
 *      with the name dst.  If an error occurs, the error will
 *      be returned immediately, and remaining files will not be
 *      processed.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpCopyDirectory(src, dst, errorPtr)
    char *src;                  /* Pathname of directory to be copied.  */
    char *dst;                  /* Pathname of target directory. */
    Tcl_DString *errorPtr;      /* If non-NULL, initialized DString for
                                 * error reporting. */
{
    int result;
    Tcl_DString srcBuffer;
    Tcl_DString dstBuffer;
 
    Tcl_DStringInit(&srcBuffer);
    Tcl_DStringInit(&dstBuffer);
    Tcl_DStringAppend(&srcBuffer, src, -1);
    Tcl_DStringAppend(&dstBuffer, dst, -1);
    result = TraverseUnixTree(TraversalCopy, &srcBuffer, &dstBuffer,
            errorPtr);
    Tcl_DStringFree(&srcBuffer);
    Tcl_DStringFree(&dstBuffer);
    return result;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpRemoveDirectory --
 *
 *      Removes directory (and its contents, if the recursive flag is set).
 *
 * Results:
 *      If the directory was successfully removed, returns TCL_OK.
 *      Otherwise the return value is TCL_ERROR, errno is set to indicate
 *      the error, and the pathname of the file that caused the error
 *      is stored in errorPtr.  Some possible values for errno are:
 *
 *      EACCES:     path directory can't be read and/or written.
 *      EEXIST:     path is a non-empty directory.
 *      EINVAL:     path is a root directory.
 *      ENOENT:     path doesn't exist or is "".
 *      ENOTDIR:    path is not a directory.
 *
 * Side effects:
 *      Directory removed.  If an error occurs, the error will be returned
 *      immediately, and remaining files will not be deleted.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpRemoveDirectory(path, recursive, errorPtr)
    char *path;                 /* Pathname of directory to be removed. */
    int recursive;              /* If non-zero, removes directories that
                                 * are nonempty.  Otherwise, will only remove
                                 * empty directories. */
    Tcl_DString *errorPtr;      /* If non-NULL, initialized DString for
                                 * error reporting. */
{
    int result;
    Tcl_DString buffer;
 
    if (rmdir(path) == 0) {
        return TCL_OK;
    }
    if (errno == ENOTEMPTY) {
        errno = EEXIST;
    }
    if ((errno != EEXIST) || (recursive == 0)) {
        if (errorPtr != NULL) {
            Tcl_DStringAppend(errorPtr, path, -1);
        }
        return TCL_ERROR;
    }
 
    /*
     * The directory is nonempty, but the recursive flag has been
     * specified, so we recursively remove all the files in the directory.
     */
 
    Tcl_DStringInit(&buffer);
    Tcl_DStringAppend(&buffer, path, -1);
    result = TraverseUnixTree(TraversalDelete, &buffer, NULL, errorPtr);
    Tcl_DStringFree(&buffer);
    return result;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TraverseUnixTree --
 *
 *      Traverse directory tree specified by sourcePtr, calling the function
 *      traverseProc for each file and directory encountered.  If destPtr
 *      is non-null, each of name in the sourcePtr directory is appended to
 *      the directory specified by destPtr and passed as the second argument
 *      to traverseProc() .
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      None caused by TraverseUnixTree, however the user specified
 *      traverseProc() may change state.  If an error occurs, the error will
 *      be returned immediately, and remaining files will not be processed.
 *
 *---------------------------------------------------------------------------
 */
 
static int
TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
    TraversalProc *traverseProc;/* Function to call for every file and
                                 * directory in source hierarchy. */
    Tcl_DString *sourcePtr;     /* Pathname of source directory to be
                                 * traversed. */
    Tcl_DString *targetPtr;     /* Pathname of directory to traverse in
                                 * parallel with source directory. */
    Tcl_DString *errorPtr;      /* If non-NULL, an initialized DString for
                                 * error reporting. */
{
    struct stat statbuf;
    char *source, *target, *errfile;
    int result, sourceLen;
    int targetLen = 0;           /* Initialization needed only to prevent
                                 * warning in gcc. */
    struct dirent *dirp;
    DIR *dp;
 
    result = TCL_OK;
    source = Tcl_DStringValue(sourcePtr);
    if (targetPtr != NULL) {
        target = Tcl_DStringValue(targetPtr);
    } else {
        target = NULL;
    }
 
    errfile = NULL;
    if (lstat(source, &statbuf) != 0) {
        errfile = source;
        goto end;
    }
    if (!S_ISDIR(statbuf.st_mode)) {
        /*
         * Process the regular file
         */
 
        return (*traverseProc)(source, target, &statbuf, DOTREE_F, errorPtr);
    }
 
    dp = opendir(source);
    if (dp == NULL) {
        /*
         * Can't read directory
         */
 
        errfile = source;
        goto end;
    }
    result = (*traverseProc)(source, target, &statbuf, DOTREE_PRED, errorPtr);
    if (result != TCL_OK) {
        closedir(dp);
        return result;
    }
 
    Tcl_DStringAppend(sourcePtr, "/", 1);
    source = Tcl_DStringValue(sourcePtr);
    sourceLen = Tcl_DStringLength(sourcePtr);
 
    if (targetPtr != NULL) {
        Tcl_DStringAppend(targetPtr, "/", 1);
        target = Tcl_DStringValue(targetPtr);
        targetLen = Tcl_DStringLength(targetPtr);
    }
 
    while ((dirp = readdir(dp)) != NULL) {
        if ((strcmp(dirp->d_name, ".") == 0)
                || (strcmp(dirp->d_name, "..") == 0)) {
            continue;
        }
 
        /*
         * Append name after slash, and recurse on the file.
         */
 
        Tcl_DStringAppend(sourcePtr, dirp->d_name, -1);
        if (targetPtr != NULL) {
            Tcl_DStringAppend(targetPtr, dirp->d_name, -1);
        }
        result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
                errorPtr);
        if (result != TCL_OK) {
            break;
        }
 
        /*
         * Remove name after slash.
         */
 
        Tcl_DStringSetLength(sourcePtr, sourceLen);
        if (targetPtr != NULL) {
            Tcl_DStringSetLength(targetPtr, targetLen);
        }
    }
    closedir(dp);
 
    /*
     * Strip off the trailing slash we added
     */
 
    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
    source = Tcl_DStringValue(sourcePtr);
    if (targetPtr != NULL) {
        Tcl_DStringSetLength(targetPtr, targetLen - 1);
        target = Tcl_DStringValue(targetPtr);
    }
 
    if (result == TCL_OK) {
        /*
         * Call traverseProc() on a directory after visiting all the
         * files in that directory.
         */
 
        result = (*traverseProc)(source, target, &statbuf, DOTREE_POSTD,
                errorPtr);
    }
    end:
    if (errfile != NULL) {
        if (errorPtr != NULL) {
            Tcl_DStringAppend(errorPtr, errfile, -1);
        }
        result = TCL_ERROR;
    }
 
    return result;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TraversalCopy
 *
 *      Called from TraverseUnixTree in order to execute a recursive copy of a
 *      directory.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      The file or directory src may be copied to dst, depending on
 *      the value of type.
 *
 *----------------------------------------------------------------------
 */
 
static int
TraversalCopy(src, dst, sbPtr, type, errorPtr)
    char *src;                  /* Source pathname to copy. */
    char *dst;                  /* Destination pathname of copy. */
    struct stat *sbPtr;         /* Stat info for file specified by src. */
    int type;                   /* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr;      /* If non-NULL, initialized DString for
                                 * error return. */
{
    switch (type) {
        case DOTREE_F:
            if (TclpCopyFile(src, dst) == TCL_OK) {
                return TCL_OK;
            }
            break;
 
        case DOTREE_PRED:
            if (TclpCreateDirectory(dst) == TCL_OK) {
                return TCL_OK;
            }
            break;
 
        case DOTREE_POSTD:
            if (CopyFileAtts(src, dst, sbPtr) == TCL_OK) {
                return TCL_OK;
            }
            break;
 
    }
 
    /*
     * There shouldn't be a problem with src, because we already
     * checked it to get here.
     */
 
    if (errorPtr != NULL) {
        Tcl_DStringAppend(errorPtr, dst, -1);
    }
    return TCL_ERROR;
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TraversalDelete --
 *
 *      Called by procedure TraverseUnixTree for every file and directory
 *      that it encounters in a directory hierarchy. This procedure unlinks
 *      files, and removes directories after all the containing files
 *      have been processed.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      Files or directory specified by src will be deleted.
 *
 *----------------------------------------------------------------------
 */
 
static int
TraversalDelete(src, ignore, sbPtr, type, errorPtr)
    char *src;                  /* Source pathname. */
    char *ignore;               /* Destination pathname (not used). */
    struct stat *sbPtr;         /* Stat info for file specified by src. */
    int type;                   /* Reason for call - see TraverseUnixTree(). */
    Tcl_DString *errorPtr;      /* If non-NULL, initialized DString for
                                 * error return. */
{
    switch (type) {
        case DOTREE_F:
            if (unlink(src) == 0) {
                return TCL_OK;
            }
            break;
 
        case DOTREE_PRED:
            return TCL_OK;
 
        case DOTREE_POSTD:
            if (rmdir(src) == 0) {
                return TCL_OK;
            }
            break;
 
    }
 
    if (errorPtr != NULL) {
        Tcl_DStringAppend(errorPtr, src, -1);
    }
    return TCL_ERROR;
}
 
/*
 *----------------------------------------------------------------------
 *
 * CopyFileAtts
 *
 *      Copy the file attributes such as owner, group, permissions, and
 *      modification date from one file to another.
 *
 * Results:
 *      Standard Tcl result.
 *
 * Side effects:
 *      user id, group id, permission bits, last modification time, and
 *      last access time are updated in the new file to reflect the old
 *      file.
 *
 *----------------------------------------------------------------------
 */
 
static int
CopyFileAtts(src, dst, statBufPtr)
    char *src;                 /* Path name of source file */
    char *dst;                 /* Path name of target file */
    struct stat *statBufPtr;   /* ptr to stat info for source file */
{
    struct utimbuf tval;
    mode_t newMode;
 
    newMode = statBufPtr->st_mode
            & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
 
    /*
     * Note that if you copy a setuid file that is owned by someone
     * else, and you are not root, then the copy will be setuid to you.
     * The most correct implementation would probably be to have the
     * copy not setuid to anyone if the original file was owned by
     * someone else, but this corner case isn't currently handled.
     * It would require another lstat(), or getuid().
     */
 
    if (chmod(dst, newMode)) {
        newMode &= ~(S_ISUID | S_ISGID);
        if (chmod(dst, newMode)) {
            return TCL_ERROR;
        }
    }
 
    tval.actime = statBufPtr->st_atime;
    tval.modtime = statBufPtr->st_mtime;
 
    if (utime(dst, &tval)) {
        return TCL_ERROR;
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * GetGroupAttribute
 *
 *      Gets the group attribute of a file.
 *
 * Results:
 *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
 *      if there is no error.
 *
 * Side effects:
 *      A new object is allocated.
 *
 *----------------------------------------------------------------------
 */
 
static int
GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr)
    Tcl_Interp *interp;         /* The interp we are using for errors. */
    int objIndex;               /* The index of the attribute. */
    char *fileName;             /* The name of the file. */
    Tcl_Obj **attributePtrPtr;  /* A pointer to return the object with. */
{
    struct stat statBuf;
    struct group *groupPtr;
 
    if (TclStat(fileName, &statBuf) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not stat file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
 
    groupPtr = getgrgid(statBuf.st_gid);
    if (groupPtr == NULL) {
        *attributePtrPtr = Tcl_NewIntObj(statBuf.st_gid);
    } else {
        *attributePtrPtr = Tcl_NewStringObj(groupPtr->gr_name, -1);
    }
    endgrent();
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * GetOwnerAttribute
 *
 *      Gets the owner attribute of a file.
 *
 * Results:
 *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
 *      if there is no error.
 *
 * Side effects:
 *      A new object is allocated.
 *
 *----------------------------------------------------------------------
 */
 
static int
GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr)
    Tcl_Interp *interp;         /* The interp we are using for errors. */
    int objIndex;               /* The index of the attribute. */
    char *fileName;             /* The name of the file. */
    Tcl_Obj **attributePtrPtr;  /* A pointer to return the object with. */
{
    struct stat statBuf;
    struct passwd *pwPtr;
 
    if (TclStat(fileName, &statBuf) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not stat file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
 
    pwPtr = getpwuid(statBuf.st_uid);
    if (pwPtr == NULL) {
        *attributePtrPtr = Tcl_NewIntObj(statBuf.st_uid);
    } else {
        *attributePtrPtr = Tcl_NewStringObj(pwPtr->pw_name, -1);
    }
    endpwent();
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * GetPermissionsAttribute
 *
 *      Gets the group attribute of a file.
 *
 * Results:
 *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
 *      if there is no error. The object will have ref count 0.
 *
 * Side effects:
 *      A new object is allocated.
 *
 *----------------------------------------------------------------------
 */
 
static int
GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
    Tcl_Interp *interp;             /* The interp we are using for errors. */
    int objIndex;                   /* The index of the attribute. */
    char *fileName;                 /* The name of the file. */
    Tcl_Obj **attributePtrPtr;      /* A pointer to return the object with. */
{
    struct stat statBuf;
    char returnString[6];
 
    if (TclStat(fileName, &statBuf) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not stat file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
 
    sprintf(returnString, "%0#5lo", (statBuf.st_mode & 0x00007FFF));
 
    *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
 
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetGroupAttribute
 *
 *      Sets the file to the given group.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      The group of the file is changed.
 *
 *----------------------------------------------------------------------
 */
 
static int
SetGroupAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;             /* The interp we are using for errors. */
    int objIndex;                   /* The index of the attribute. */
    char *fileName;                 /* The name of the file. */
    Tcl_Obj *attributePtr;          /* The attribute to set. */
{
    gid_t groupNumber;
    long placeHolder;
 
    if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
        struct group *groupPtr;
        char *groupString = Tcl_GetStringFromObj(attributePtr, NULL);
 
        Tcl_ResetResult(interp);
        groupPtr = getgrnam(groupString);
        if (groupPtr == NULL) {
            endgrent();
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "could not set group for file \"", fileName,
                    "\": group \"", groupString, "\" does not exist",
                    (char *) NULL);
            return TCL_ERROR;
        }
        groupNumber = groupPtr->gr_gid;
    } else {
        groupNumber = (gid_t) placeHolder;
    }
 
    if (chown(fileName, -1, groupNumber) != 0) {
        endgrent();
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not set group for file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
    endgrent();
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetOwnerAttribute
 *
 *      Sets the file to the given owner.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      The group of the file is changed.
 *
 *----------------------------------------------------------------------
 */
 
static int
SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;             /* The interp we are using for errors. */
    int objIndex;                   /* The index of the attribute. */
    char *fileName;                 /* The name of the file. */
    Tcl_Obj *attributePtr;          /* The attribute to set. */
{
    uid_t userNumber;
    long placeHolder;
 
    if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
        struct passwd *pwPtr;
        char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL);
 
        Tcl_ResetResult(interp);
        pwPtr = getpwnam(ownerString);
        if (pwPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "could not set owner for file \"", fileName,
                    "\": user \"", ownerString, "\" does not exist",
                    (char *) NULL);
            return TCL_ERROR;
        }
        userNumber = pwPtr->pw_uid;
    } else {
        userNumber = (uid_t) placeHolder;
    }
 
    if (chown(fileName, userNumber, -1) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not set owner for file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
 
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * SetPermissionsAttribute
 *
 *      Sets the file to the given group.
 *
 * Results:
 *      Standard TCL result.
 *
 * Side effects:
 *      The group of the file is changed.
 *
 *----------------------------------------------------------------------
 */
 
static int
SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
    Tcl_Interp *interp;             /* The interp we are using for errors. */
    int objIndex;                   /* The index of the attribute. */
    char *fileName;                 /* The name of the file. */
    Tcl_Obj *attributePtr;          /* The attribute to set. */
{
    long modeInt;
    mode_t newMode;
 
    /*
     * mode_t is a long under SPARC; an int under SunOS. Since we do not
     * know how big it really is, we get the long and then cast it
     * down to a mode_t.
     */
 
    if (Tcl_GetLongFromObj(interp, attributePtr, &modeInt)
            != TCL_OK) {
        return TCL_ERROR;
    }
 
    newMode = (mode_t) modeInt;
 
    if (chmod(fileName, newMode) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                "could not set permissions for file \"", fileName, "\": ",
                Tcl_PosixError(interp), (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}
/*
 *---------------------------------------------------------------------------
 *
 * TclpListVolumes --
 *
 *      Lists the currently mounted volumes, which on UNIX is just /.
 *
 * Results:
 *      A standard Tcl result.  Will always be TCL_OK, since there is no way
 *      that this command can fail.  Also, the interpreter's result is set to
 *      the list of volumes.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */
 
int
TclpListVolumes(interp)
    Tcl_Interp *interp;                 /* Interpreter to which to pass
                                         * the volume list. */
{
    Tcl_Obj *resultPtr;
 
    resultPtr = Tcl_GetObjResult(interp);
    Tcl_SetStringObj(resultPtr, "/", 1);
    return TCL_OK;
}
 
Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [unix/] [tclUnixFCmd.c] - Blame information for rev 578

Line No.	Rev	Author	Line
1	578	markom	`/*`
2			`* tclUnixFCmd.c`
3			`*`
4			`* This file implements the unix specific portion of file manipulation`
5			`* subcommands of the "file" command. All filename arguments should`
6			`* already be translated to native format.`
7			`*`
8			`* Copyright (c) 1996-1997 Sun Microsystems, Inc.`
9			`*`
10			`* See the file "license.terms" for information on usage and redistribution`
11			`* of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
12			`*`
13			`* RCS: @(#) $Id: tclUnixFCmd.c,v 1.1.1.1 2002-01-16 10:25:37 markom Exp $`
14			`*`
15			`* Portions of this code were derived from NetBSD source code which has`
16			`* the following copyright notice:`
17			`*`
18			`* Copyright (c) 1988, 1993, 1994`
19			`* The Regents of the University of California. All rights reserved.`
20			`*`
21			`* Redistribution and use in source and binary forms, with or without`
22			`* modification, are permitted provided that the following conditions`
23			`* are met:`
24			`* 1. Redistributions of source code must retain the above copyright`
25			`* notice, this list of conditions and the following disclaimer.`
26			`* 2. Redistributions in binary form must reproduce the above copyright`
27			`* notice, this list of conditions and the following disclaimer in the`
28			`* documentation and/or other materials provided with the distribution.`
29			`* 3. All advertising materials mentioning features or use of this software`
30			`* must display the following acknowledgement:`
31			`* This product includes software developed by the University of`
32			`* California, Berkeley and its contributors.`
33			`* 4. Neither the name of the University nor the names of its contributors`
34			`* may be used to endorse or promote products derived from this software`
35			`* without specific prior written permission.`
36			`*`
37			* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
38			`* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE`
39			`* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE`
40			`* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE`