summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFCmd.c')
-rw-r--r--unix/tclUnixFCmd.c1224
1 files changed, 1224 insertions, 0 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
new file mode 100644
index 0000000..3ec1a69
--- /dev/null
+++ b/unix/tclUnixFCmd.c
@@ -0,0 +1,1224 @@
+/*
+ * 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.
+ *
+ * SCCS: @(#) tclUnixFCmd.c 1.31 97/10/13 16:51:14
+ *
+ * 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);
+
+ case S_IFIFO:
+ if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
+ return TCL_ERROR;
+ }
+ return CopyFileAtts(src, dst, &srcStatBuf);
+
+ 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 (stat(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 (stat(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 (stat(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;
+}
+