home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclUnixFCmd.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  34.2 KB  |  1,230 lines  |  [TEXT/CWIE]
  1. /*
  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.  * SCCS: @(#) tclUnixFCmd.c 1.29 97/06/16 16:28:25
  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
  41.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  42.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  43.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  44.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  45.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  46.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  47.  * SUCH DAMAGE.
  48.  */
  49.  
  50. #include "tclInt.h"
  51. #include "tclPort.h"
  52. #include <utime.h>
  53. #include <grp.h>
  54.  
  55. /*
  56.  * The following constants specify the type of callback when
  57.  * TraverseUnixTree() calls the traverseProc()
  58.  */
  59.  
  60. #define DOTREE_PRED   1     /* pre-order directory  */
  61. #define DOTREE_POSTD  2     /* post-order directory */
  62. #define DOTREE_F      3     /* regular file */
  63.  
  64. /*
  65.  * Callbacks for file attributes code.
  66.  */
  67.  
  68. static int        GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  69.                 int objIndex, char *fileName,
  70.                 Tcl_Obj **attributePtrPtr));
  71. static int        GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  72.                 int objIndex, char *fileName,
  73.                 Tcl_Obj **attributePtrPtr));
  74. static int        GetPermissionsAttribute _ANSI_ARGS_((
  75.                 Tcl_Interp *interp, int objIndex, char *fileName,
  76.                 Tcl_Obj **attributePtrPtr));
  77. static int        SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  78.                 int objIndex, char *fileName,
  79.                 Tcl_Obj *attributePtr));
  80. static int        SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp,
  81.                 int objIndex, char *fileName,
  82.                 Tcl_Obj *attributePtr));
  83. static int        SetPermissionsAttribute _ANSI_ARGS_((
  84.                 Tcl_Interp *interp, int objIndex, char *fileName,
  85.                 Tcl_Obj *attributePtr));
  86.               
  87. /*
  88.  * Prototype for the TraverseUnixTree callback function.
  89.  */
  90.  
  91. typedef int (TraversalProc) _ANSI_ARGS_((char *src, char *dst, 
  92.         struct stat *sb, int type, Tcl_DString *errorPtr));
  93.  
  94. /*
  95.  * Constants and variables necessary for file attributes subcommand.
  96.  */
  97.  
  98. enum {
  99.     UNIX_GROUP_ATTRIBUTE,
  100.     UNIX_OWNER_ATTRIBUTE,
  101.     UNIX_PERMISSIONS_ATTRIBUTE
  102. };
  103.  
  104. char *tclpFileAttrStrings[] = {"-group", "-owner", "-permissions",
  105.     (char *) NULL};
  106. CONST TclFileAttrProcs tclpFileAttrProcs[] = {
  107.     {GetGroupAttribute, SetGroupAttribute},
  108.     {GetOwnerAttribute, SetOwnerAttribute},
  109.     {GetPermissionsAttribute, SetPermissionsAttribute}};
  110.  
  111. /*
  112.  * Declarations for local procedures defined in this file:
  113.  */
  114.  
  115. static int        CopyFile _ANSI_ARGS_((char *src, char *dst, 
  116.                 struct stat *srcStatBufPtr));
  117. static int        CopyFileAtts _ANSI_ARGS_((char *src, char *dst, 
  118.                 struct stat *srcStatBufPtr));
  119. static int        TraversalCopy _ANSI_ARGS_((char *src, char *dst, 
  120.                 struct stat *sbPtr, int type,
  121.                 Tcl_DString *errorPtr));
  122. static int        TraversalDelete _ANSI_ARGS_((char *src, char *dst, 
  123.                 struct stat *sbPtr, int type,
  124.                 Tcl_DString *errorPtr));
  125. static int        TraverseUnixTree _ANSI_ARGS_((
  126.                 TraversalProc *traversalProc,
  127.                 Tcl_DString *sourcePath, Tcl_DString *destPath,
  128.                 Tcl_DString *errorPtr));
  129.  
  130. /*
  131.  *---------------------------------------------------------------------------
  132.  *
  133.  * TclpRenameFile --
  134.  *
  135.  *      Changes the name of an existing file or directory, from src to dst.
  136.  *    If src and dst refer to the same file or directory, does nothing
  137.  *    and returns success.  Otherwise if dst already exists, it will be
  138.  *    deleted and replaced by src subject to the following conditions:
  139.  *        If src is a directory, dst may be an empty directory.
  140.  *        If src is a file, dst may be a file.
  141.  *    In any other situation where dst already exists, the rename will
  142.  *    fail.  
  143.  *
  144.  * Results:
  145.  *    If the directory was successfully created, returns TCL_OK.
  146.  *    Otherwise the return value is TCL_ERROR and errno is set to
  147.  *    indicate the error.  Some possible values for errno are:
  148.  *
  149.  *    EACCES:     src or dst parent directory can't be read and/or written.
  150.  *    EEXIST:        dst is a non-empty directory.
  151.  *    EINVAL:        src is a root directory or dst is a subdirectory of src.
  152.  *    EISDIR:        dst is a directory, but src is not.
  153.  *    ENOENT:        src doesn't exist, or src or dst is "".
  154.  *    ENOTDIR:    src is a directory, but dst is not.  
  155.  *    EXDEV:        src and dst are on different filesystems.
  156.  *    
  157.  * Side effects:
  158.  *    The implementation of rename may allow cross-filesystem renames,
  159.  *    but the caller should be prepared to emulate it with copy and
  160.  *    delete if errno is EXDEV.
  161.  *
  162.  *---------------------------------------------------------------------------
  163.  */
  164.  
  165. int
  166. TclpRenameFile(src, dst)
  167.     char *src;            /* Pathname of file or dir to be renamed. */
  168.     char *dst;            /* New pathname of file or directory. */
  169. {
  170.     if (rename(src, dst) == 0) {
  171.     return TCL_OK;
  172.     }
  173.     if (errno == ENOTEMPTY) {
  174.     errno = EEXIST;
  175.     }
  176.  
  177. #ifdef sparc
  178.     /*
  179.      * SunOS 4.1.4 reports overwriting a non-empty directory with a
  180.      * directory as EINVAL instead of EEXIST (first rule out the correct
  181.      * EINVAL result code for moving a directory into itself).  Must be
  182.      * conditionally compiled because realpath() is only defined on SunOS.
  183.      */
  184.  
  185.     if (errno == EINVAL) {
  186.     char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN];
  187.     DIR *dirPtr;
  188.     struct dirent *dirEntPtr;
  189.  
  190.     if ((realpath(src, srcPath) != NULL)
  191.         && (realpath(dst, dstPath) != NULL)
  192.         && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) {
  193.         dirPtr = opendir(dst);
  194.         if (dirPtr != NULL) {
  195.         while ((dirEntPtr = readdir(dirPtr)) != NULL) {
  196.             if ((strcmp(dirEntPtr->d_name, ".") != 0) &&
  197.                 (strcmp(dirEntPtr->d_name, "..") != 0)) {
  198.             errno = EEXIST;
  199.             closedir(dirPtr);
  200.             return TCL_ERROR;
  201.             }
  202.         }
  203.         closedir(dirPtr);
  204.         }
  205.     }
  206.     errno = EINVAL;
  207.     }
  208. #endif    /* sparc */
  209.  
  210.     if (strcmp(src, "/") == 0) {
  211.     /*
  212.      * Alpha reports renaming / as EBUSY and Linux reports it as EACCES,
  213.      * instead of EINVAL.
  214.      */
  215.      
  216.     errno = EINVAL;
  217.     }
  218.  
  219.     /*
  220.      * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a
  221.      * file across filesystems and the parent directory of that file is
  222.      * not writable.  Most other systems return EXDEV.  Does nothing to
  223.      * correct this behavior.
  224.      */
  225.  
  226.     return TCL_ERROR;
  227. }
  228.  
  229.  
  230. /*
  231.  *---------------------------------------------------------------------------
  232.  *
  233.  * TclpCopyFile --
  234.  *
  235.  *      Copy a single file (not a directory).  If dst already exists and
  236.  *    is not a directory, it is removed.
  237.  *
  238.  * Results:
  239.  *    If the file was successfully copied, returns TCL_OK.  Otherwise
  240.  *    the return value is TCL_ERROR and errno is set to indicate the
  241.  *    error.  Some possible values for errno are:
  242.  *
  243.  *    EACCES:     src or dst parent directory can't be read and/or written.
  244.  *    EISDIR:        src or dst is a directory.
  245.  *    ENOENT:        src doesn't exist.  src or dst is "".
  246.  *
  247.  * Side effects:
  248.  *      This procedure will also copy symbolic links, block, and
  249.  *      character devices, and fifos.  For symbolic links, the links 
  250.  *      themselves will be copied and not what they point to.  For the
  251.  *    other special file types, the directory entry will be copied and
  252.  *    not the contents of the device that it refers to.
  253.  *
  254.  *---------------------------------------------------------------------------
  255.  */
  256.  
  257. int 
  258. TclpCopyFile(src, dst)
  259.     char *src;            /* Pathname of file to be copied. */
  260.     char *dst;            /* Pathname of file to copy to. */
  261. {
  262.     struct stat srcStatBuf, dstStatBuf;
  263.     char link[MAXPATHLEN];
  264.     int length;
  265.  
  266.     /*
  267.      * Have to do a stat() to determine the filetype.
  268.      */
  269.     
  270.     if (lstat(src, &srcStatBuf) != 0) {
  271.     return TCL_ERROR;
  272.     }
  273.     if (S_ISDIR(srcStatBuf.st_mode)) {
  274.     errno = EISDIR;
  275.     return TCL_ERROR;
  276.     }
  277.  
  278.     /*
  279.      * symlink, and some of the other calls will fail if the target 
  280.      * exists, so we remove it first
  281.      */
  282.     
  283.     if (lstat(dst, &dstStatBuf) == 0) {
  284.     if (S_ISDIR(dstStatBuf.st_mode)) {
  285.         errno = EISDIR;
  286.         return TCL_ERROR;
  287.     }
  288.     }
  289.     if (unlink(dst) != 0) {
  290.     if (errno != ENOENT) {
  291.         return TCL_ERROR;
  292.     } 
  293.     }
  294.  
  295.     switch ((int) (srcStatBuf.st_mode & S_IFMT)) {
  296.         case S_IFLNK:
  297.         length = readlink(src, link, sizeof(link)); 
  298.         if (length == -1) {
  299.         return TCL_ERROR;
  300.         }
  301.         link[length] = '\0';
  302.         if (symlink(link, dst) < 0) {
  303.         return TCL_ERROR;
  304.         }
  305.         break;
  306.  
  307.         case S_IFBLK:
  308.         case S_IFCHR:
  309.         if (mknod(dst, srcStatBuf.st_mode, srcStatBuf.st_rdev) < 0) {
  310.         return TCL_ERROR;
  311.         }
  312.         return CopyFileAtts(src, dst, &srcStatBuf);
  313.  
  314.         case S_IFIFO:
  315.         if (mkfifo(dst, srcStatBuf.st_mode) < 0) {
  316.         return TCL_ERROR;
  317.         }
  318.         return CopyFileAtts(src, dst, &srcStatBuf);
  319.  
  320.         default:
  321.         return CopyFile(src, dst, &srcStatBuf);
  322.     }
  323.     
  324.     return TCL_OK;
  325. }
  326.  
  327. /*
  328.  *----------------------------------------------------------------------
  329.  *
  330.  * CopyFile - 
  331.  *
  332.  *      Helper function for TclpCopyFile.  Copies one regular file,
  333.  *    using read() and write().
  334.  *
  335.  * Results:
  336.  *    A standard Tcl result.
  337.  *
  338.  * Side effects:
  339.  *      A file is copied.  Dst will be overwritten if it exists.
  340.  *
  341.  *----------------------------------------------------------------------
  342.  */
  343.  
  344. static int 
  345. CopyFile(src, dst, srcStatBufPtr) 
  346.     char *src;                   /* Pathname of file to copy. */
  347.     char *dst;                   /* Pathname of file to create/overwrite. */
  348.     struct stat *srcStatBufPtr;  /* Used to determine mode and blocksize */
  349. {
  350.     int srcFd;
  351.     int dstFd;
  352.     u_int blockSize;   /* Optimal I/O blocksize for filesystem */
  353.     char *buffer;      /* Data buffer for copy */
  354.     size_t nread;
  355.  
  356.     if ((srcFd = open(src, O_RDONLY, 0)) < 0) { 
  357.     return TCL_ERROR;
  358.     }
  359.  
  360.     dstFd = open(dst, O_CREAT | O_TRUNC | O_WRONLY, srcStatBufPtr->st_mode);
  361.     if (dstFd < 0) {
  362.     close(srcFd); 
  363.     return TCL_ERROR;
  364.     }
  365.  
  366.     blockSize = srcStatBufPtr->st_blksize;
  367.     buffer = ckalloc(blockSize);
  368.     while (1) {
  369.     nread = read(srcFd, buffer, blockSize);
  370.     if ((nread == -1) || (nread == 0)) {
  371.         break;
  372.     }
  373.     if (write(dstFd, buffer, nread) != nread) {
  374.         nread = (size_t) -1;
  375.         break;
  376.     }
  377.     }
  378.     
  379.     ckfree(buffer);
  380.     close(srcFd);
  381.     if ((close(dstFd) != 0) || (nread == -1)) {
  382.     unlink(dst);
  383.     return TCL_ERROR;
  384.     }
  385.     if (CopyFileAtts(src, dst, srcStatBufPtr) == TCL_ERROR) {
  386.     /*
  387.      * The copy succeeded, but setting the permissions failed, so be in
  388.      * a consistent state, we remove the file that was created by the
  389.      * copy.
  390.      */
  391.  
  392.     unlink(dst);
  393.     return TCL_ERROR;
  394.     }
  395.     return TCL_OK;
  396. }
  397.  
  398. /*
  399.  *---------------------------------------------------------------------------
  400.  *
  401.  * TclpDeleteFile --
  402.  *
  403.  *      Removes a single file (not a directory).
  404.  *
  405.  * Results:
  406.  *    If the file was successfully deleted, returns TCL_OK.  Otherwise
  407.  *    the return value is TCL_ERROR and errno is set to indicate the
  408.  *    error.  Some possible values for errno are:
  409.  *
  410.  *    EACCES:     a parent directory can't be read and/or written.
  411.  *    EISDIR:        path is a directory.
  412.  *    ENOENT:        path doesn't exist or is "".
  413.  *
  414.  * Side effects:
  415.  *      The file is deleted, even if it is read-only.
  416.  *
  417.  *---------------------------------------------------------------------------
  418.  */
  419.  
  420. int
  421. TclpDeleteFile(path) 
  422.     char *path;            /* Pathname of file to be removed. */
  423. {
  424.     if (unlink(path) != 0) {
  425.     return TCL_ERROR;
  426.     }
  427.     return TCL_OK;
  428. }
  429.  
  430. /*
  431.  *---------------------------------------------------------------------------
  432.  *
  433.  * TclpCreateDirectory --
  434.  *
  435.  *      Creates the specified directory.  All parent directories of the
  436.  *    specified directory must already exist.  The directory is
  437.  *    automatically created with permissions so that user can access
  438.  *    the new directory and create new files or subdirectories in it.
  439.  *
  440.  * Results:
  441.  *    If the directory was successfully created, returns TCL_OK.
  442.  *    Otherwise the return value is TCL_ERROR and errno is set to
  443.  *    indicate the error.  Some possible values for errno are:
  444.  *
  445.  *    EACCES:     a parent directory can't be read and/or written.
  446.  *    EEXIST:        path already exists.
  447.  *    ENOENT:        a parent directory doesn't exist.
  448.  *
  449.  * Side effects:
  450.  *      A directory is created with the current umask, except that
  451.  *    permission for u+rwx will always be added.
  452.  *
  453.  *---------------------------------------------------------------------------
  454.  */
  455.  
  456. int
  457. TclpCreateDirectory(path)
  458.     char *path;            /* Pathname of directory to create. */
  459. {
  460.     mode_t mode;
  461.  
  462.     mode = umask(0);
  463.     umask(mode);
  464.  
  465.     /*
  466.      * umask return value is actually the inverse of the permissions.
  467.      */
  468.     
  469.     mode = (0777 & ~mode);
  470.  
  471.     if (mkdir(path, mode | S_IRUSR | S_IWUSR | S_IXUSR) != 0) {
  472.     return TCL_ERROR;
  473.     }
  474.     return TCL_OK;
  475. }
  476.  
  477. /*
  478.  *---------------------------------------------------------------------------
  479.  *
  480.  * TclpCopyDirectory --
  481.  *
  482.  *      Recursively copies a directory.  The target directory dst must
  483.  *    not already exist.  Note that this function does not merge two
  484.  *    directory hierarchies, even if the target directory is an an
  485.  *    empty directory.
  486.  *
  487.  * Results:
  488.  *    If the directory was successfully copied, returns TCL_OK.
  489.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  490.  *    the error, and the pathname of the file that caused the error
  491.  *    is stored in errorPtr.  See TclpCreateDirectory and TclpCopyFile
  492.  *    for a description of possible values for errno.
  493.  *
  494.  * Side effects:
  495.  *      An exact copy of the directory hierarchy src will be created
  496.  *    with the name dst.  If an error occurs, the error will
  497.  *      be returned immediately, and remaining files will not be
  498.  *    processed.
  499.  *
  500.  *---------------------------------------------------------------------------
  501.  */
  502.  
  503. int
  504. TclpCopyDirectory(src, dst, errorPtr)
  505.     char *src;            /* Pathname of directory to be copied.  */
  506.     char *dst;            /* Pathname of target directory. */
  507.     Tcl_DString *errorPtr;    /* If non-NULL, initialized DString for
  508.                  * error reporting. */
  509. {
  510.     int result;
  511.     Tcl_DString srcBuffer;
  512.     Tcl_DString dstBuffer;
  513.  
  514.     Tcl_DStringInit(&srcBuffer);
  515.     Tcl_DStringInit(&dstBuffer);
  516.     Tcl_DStringAppend(&srcBuffer, src, -1);
  517.     Tcl_DStringAppend(&dstBuffer, dst, -1);
  518.     result = TraverseUnixTree(TraversalCopy, &srcBuffer, &dstBuffer,
  519.         errorPtr);
  520.     Tcl_DStringFree(&srcBuffer);
  521.     Tcl_DStringFree(&dstBuffer);
  522.     return result;
  523. }
  524.  
  525. /*
  526.  *---------------------------------------------------------------------------
  527.  *
  528.  * TclpRemoveDirectory --
  529.  *
  530.  *    Removes directory (and its contents, if the recursive flag is set).
  531.  *
  532.  * Results:
  533.  *    If the directory was successfully removed, returns TCL_OK.
  534.  *    Otherwise the return value is TCL_ERROR, errno is set to indicate
  535.  *    the error, and the pathname of the file that caused the error
  536.  *    is stored in errorPtr.  Some possible values for errno are:
  537.  *
  538.  *    EACCES:     path directory can't be read and/or written.
  539.  *    EEXIST:        path is a non-empty directory.
  540.  *    EINVAL:        path is a root directory.
  541.  *    ENOENT:        path doesn't exist or is "".
  542.  *     ENOTDIR:    path is not a directory.
  543.  *
  544.  * Side effects:
  545.  *    Directory removed.  If an error occurs, the error will be returned
  546.  *    immediately, and remaining files will not be deleted.
  547.  *
  548.  *---------------------------------------------------------------------------
  549.  */
  550.  
  551. int
  552. TclpRemoveDirectory(path, recursive, errorPtr) 
  553.     char *path;            /* Pathname of directory to be removed. */
  554.     int recursive;        /* If non-zero, removes directories that
  555.                  * are nonempty.  Otherwise, will only remove
  556.                  * empty directories. */
  557.     Tcl_DString *errorPtr;    /* If non-NULL, initialized DString for
  558.                  * error reporting. */
  559. {
  560.     int result;
  561.     Tcl_DString buffer;
  562.  
  563.     if (rmdir(path) == 0) {
  564.     return TCL_OK;
  565.     }
  566.     if (errno == ENOTEMPTY) {
  567.     errno = EEXIST;
  568.     }
  569.     if ((errno != EEXIST) || (recursive == 0)) {
  570.     if (errorPtr != NULL) {
  571.         Tcl_DStringAppend(errorPtr, path, -1);
  572.     }
  573.     return TCL_ERROR;
  574.     }
  575.     
  576.     /*
  577.      * The directory is nonempty, but the recursive flag has been
  578.      * specified, so we recursively remove all the files in the directory.
  579.      */
  580.  
  581.     Tcl_DStringInit(&buffer);
  582.     Tcl_DStringAppend(&buffer, path, -1);
  583.     result = TraverseUnixTree(TraversalDelete, &buffer, NULL, errorPtr);
  584.     Tcl_DStringFree(&buffer);
  585.     return result;
  586. }
  587.     
  588. /*
  589.  *---------------------------------------------------------------------------
  590.  *
  591.  * TraverseUnixTree --
  592.  *
  593.  *      Traverse directory tree specified by sourcePtr, calling the function 
  594.  *    traverseProc for each file and directory encountered.  If destPtr 
  595.  *    is non-null, each of name in the sourcePtr directory is appended to 
  596.  *    the directory specified by destPtr and passed as the second argument 
  597.  *    to traverseProc() .
  598.  *
  599.  * Results:
  600.  *      Standard Tcl result.
  601.  *
  602.  * Side effects:
  603.  *      None caused by TraverseUnixTree, however the user specified 
  604.  *    traverseProc() may change state.  If an error occurs, the error will
  605.  *      be returned immediately, and remaining files will not be processed.
  606.  *
  607.  *---------------------------------------------------------------------------
  608.  */
  609.  
  610. static int 
  611. TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr)
  612.     TraversalProc *traverseProc;/* Function to call for every file and
  613.                  * directory in source hierarchy. */
  614.     Tcl_DString *sourcePtr;    /* Pathname of source directory to be
  615.                  * traversed. */
  616.     Tcl_DString *targetPtr;    /* Pathname of directory to traverse in
  617.                  * parallel with source directory. */
  618.     Tcl_DString *errorPtr;    /* If non-NULL, an initialized DString for
  619.                  * error reporting. */
  620. {
  621.     struct stat statbuf;
  622.     char *source, *target, *errfile;
  623.     int result, sourceLen;
  624.     int targetLen = 0;        /* Initialization needed only to prevent
  625.                  * warning in gcc. */
  626.     struct dirent *dirp;
  627.     DIR *dp;
  628.  
  629.     result = TCL_OK;
  630.     source = Tcl_DStringValue(sourcePtr);
  631.     if (targetPtr != NULL) {
  632.     target = Tcl_DStringValue(targetPtr);
  633.     } else {
  634.     target = NULL;
  635.     }
  636.  
  637.     errfile = NULL;
  638.     if (lstat(source, &statbuf) != 0) {
  639.     errfile = source;
  640.     goto end;
  641.     }
  642.     if (!S_ISDIR(statbuf.st_mode)) {
  643.     /*
  644.      * Process the regular file
  645.      */
  646.  
  647.     return (*traverseProc)(source, target, &statbuf, DOTREE_F, errorPtr);
  648.     }
  649.  
  650.     dp = opendir(source);
  651.     if (dp == NULL) {
  652.     /* 
  653.      * Can't read directory
  654.      */
  655.  
  656.     errfile = source;
  657.     goto end;
  658.     }
  659.     result = (*traverseProc)(source, target, &statbuf, DOTREE_PRED, errorPtr);
  660.     if (result != TCL_OK) {
  661.     closedir(dp);
  662.     return result;
  663.     }
  664.     
  665.     Tcl_DStringAppend(sourcePtr, "/", 1);
  666.     source = Tcl_DStringValue(sourcePtr);
  667.     sourceLen = Tcl_DStringLength(sourcePtr);    
  668.  
  669.     if (targetPtr != NULL) {
  670.     Tcl_DStringAppend(targetPtr, "/", 1);
  671.     target = Tcl_DStringValue(targetPtr);
  672.     targetLen = Tcl_DStringLength(targetPtr);
  673.     }
  674.                   
  675.     while ((dirp = readdir(dp)) != NULL) {
  676.     if ((strcmp(dirp->d_name, ".") == 0)
  677.             || (strcmp(dirp->d_name, "..") == 0)) {
  678.         continue;
  679.     }
  680.  
  681.     /* 
  682.      * Append name after slash, and recurse on the file.
  683.      */
  684.  
  685.     Tcl_DStringAppend(sourcePtr, dirp->d_name, -1);
  686.     if (targetPtr != NULL) {
  687.         Tcl_DStringAppend(targetPtr, dirp->d_name, -1);
  688.     }
  689.     result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
  690.         errorPtr);
  691.     if (result != TCL_OK) {
  692.         break;
  693.     }
  694.     
  695.     /*
  696.      * Remove name after slash.
  697.      */
  698.  
  699.     Tcl_DStringSetLength(sourcePtr, sourceLen);
  700.     if (targetPtr != NULL) {
  701.         Tcl_DStringSetLength(targetPtr, targetLen);
  702.     }
  703.     }
  704.     closedir(dp);
  705.     
  706.     /*
  707.      * Strip off the trailing slash we added
  708.      */
  709.  
  710.     Tcl_DStringSetLength(sourcePtr, sourceLen - 1);
  711.     source = Tcl_DStringValue(sourcePtr);
  712.     if (targetPtr != NULL) {
  713.     Tcl_DStringSetLength(targetPtr, targetLen - 1);
  714.     target = Tcl_DStringValue(targetPtr);
  715.     }
  716.  
  717.     if (result == TCL_OK) {
  718.     /*
  719.      * Call traverseProc() on a directory after visiting all the
  720.      * files in that directory.
  721.      */
  722.  
  723.     result = (*traverseProc)(source, target, &statbuf, DOTREE_POSTD,
  724.         errorPtr);
  725.     }
  726.     end:
  727.     if (errfile != NULL) {
  728.     if (errorPtr != NULL) {
  729.         Tcl_DStringAppend(errorPtr, errfile, -1);
  730.     }
  731.     result = TCL_ERROR;
  732.     }
  733.         
  734.     return result;
  735. }
  736.  
  737. /*
  738.  *----------------------------------------------------------------------
  739.  *
  740.  * TraversalCopy
  741.  *
  742.  *      Called from TraverseUnixTree in order to execute a recursive copy of a 
  743.  *      directory. 
  744.  *
  745.  * Results:
  746.  *      Standard Tcl result.
  747.  *
  748.  * Side effects:
  749.  *      The file or directory src may be copied to dst, depending on 
  750.  *      the value of type.
  751.  *      
  752.  *----------------------------------------------------------------------
  753.  */
  754.  
  755. static int 
  756. TraversalCopy(src, dst, sbPtr, type, errorPtr) 
  757.     char *src;            /* Source pathname to copy. */
  758.     char *dst;                  /* Destination pathname of copy. */
  759.     struct stat *sbPtr;        /* Stat info for file specified by src. */
  760.     int type;                   /* Reason for call - see TraverseUnixTree(). */
  761.     Tcl_DString *errorPtr;    /* If non-NULL, initialized DString for
  762.                  * error return. */
  763. {
  764.     switch (type) {
  765.     case DOTREE_F:
  766.         if (TclpCopyFile(src, dst) == TCL_OK) {
  767.         return TCL_OK;
  768.         }
  769.         break;
  770.  
  771.     case DOTREE_PRED:
  772.         if (TclpCreateDirectory(dst) == TCL_OK) {
  773.         return TCL_OK;
  774.         }
  775.         break;
  776.  
  777.     case DOTREE_POSTD:
  778.         if (CopyFileAtts(src, dst, sbPtr) == TCL_OK) {
  779.         return TCL_OK;
  780.         }
  781.         break;
  782.  
  783.     }
  784.  
  785.     /*
  786.      * There shouldn't be a problem with src, because we already
  787.      * checked it to get here.
  788.      */
  789.  
  790.     if (errorPtr != NULL) {
  791.     Tcl_DStringAppend(errorPtr, dst, -1);
  792.     }
  793.     return TCL_ERROR;
  794. }
  795.  
  796. /*
  797.  *---------------------------------------------------------------------------
  798.  *
  799.  * TraversalDelete --
  800.  *
  801.  *      Called by procedure TraverseUnixTree for every file and directory
  802.  *    that it encounters in a directory hierarchy. This procedure unlinks
  803.  *      files, and removes directories after all the containing files 
  804.  *      have been processed.
  805.  *
  806.  * Results:
  807.  *      Standard Tcl result.
  808.  *
  809.  * Side effects:
  810.  *      Files or directory specified by src will be deleted.
  811.  *
  812.  *----------------------------------------------------------------------
  813.  */
  814.  
  815. static int
  816. TraversalDelete(src, ignore, sbPtr, type, errorPtr) 
  817.     char *src;            /* Source pathname. */
  818.     char *ignore;        /* Destination pathname (not used). */
  819.     struct stat *sbPtr;        /* Stat info for file specified by src. */
  820.     int type;                   /* Reason for call - see TraverseUnixTree(). */
  821.     Tcl_DString *errorPtr;    /* If non-NULL, initialized DString for
  822.                  * error return. */
  823. {
  824.     switch (type) {
  825.         case DOTREE_F:
  826.         if (unlink(src) == 0) {
  827.         return TCL_OK;
  828.         }
  829.         break;
  830.  
  831.         case DOTREE_PRED:
  832.         return TCL_OK;
  833.  
  834.         case DOTREE_POSTD:
  835.         if (rmdir(src) == 0) {
  836.         return TCL_OK;
  837.         }
  838.         break;
  839.         
  840.     }
  841.  
  842.     if (errorPtr != NULL) {
  843.     Tcl_DStringAppend(errorPtr, src, -1);
  844.     }
  845.     return TCL_ERROR;
  846. }
  847.  
  848. /*
  849.  *----------------------------------------------------------------------
  850.  *
  851.  * CopyFileAtts
  852.  *
  853.  *      Copy the file attributes such as owner, group, permissions, and
  854.  *      modification date from one file to another.
  855.  *
  856.  * Results:
  857.  *      Standard Tcl result.
  858.  *
  859.  * Side effects:
  860.  *      user id, group id, permission bits, last modification time, and 
  861.  *      last access time are updated in the new file to reflect the old
  862.  *      file.
  863.  *      
  864.  *----------------------------------------------------------------------
  865.  */
  866.  
  867. static int
  868. CopyFileAtts(src, dst, statBufPtr) 
  869.     char *src;                 /* Path name of source file */
  870.     char *dst;                 /* Path name of target file */
  871.     struct stat *statBufPtr;   /* ptr to stat info for source file */
  872. {
  873.     struct utimbuf tval;
  874.     mode_t newMode;
  875.     
  876.     newMode = statBufPtr->st_mode
  877.         & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO);
  878.     
  879.     /* 
  880.      * Note that if you copy a setuid file that is owned by someone
  881.      * else, and you are not root, then the copy will be setuid to you.
  882.      * The most correct implementation would probably be to have the
  883.      * copy not setuid to anyone if the original file was owned by 
  884.      * someone else, but this corner case isn't currently handled.
  885.      * It would require another lstat(), or getuid().
  886.      */
  887.     
  888.     if (chmod(dst, newMode)) {
  889.     newMode &= ~(S_ISUID | S_ISGID);
  890.     if (chmod(dst, newMode)) {
  891.         return TCL_ERROR;
  892.     }
  893.     }
  894.  
  895.     tval.actime = statBufPtr->st_atime; 
  896.     tval.modtime = statBufPtr->st_mtime; 
  897.  
  898.     if (utime(dst, &tval)) {
  899.     return TCL_ERROR;
  900.     }
  901.     return TCL_OK;
  902. }
  903.  
  904. /*
  905.  *----------------------------------------------------------------------
  906.  *
  907.  * GetGroupAttribute
  908.  *
  909.  *      Gets the group attribute of a file.
  910.  *
  911.  * Results:
  912.  *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
  913.  *    if there is no error.
  914.  *
  915.  * Side effects:
  916.  *      A new object is allocated.
  917.  *      
  918.  *----------------------------------------------------------------------
  919.  */
  920.  
  921. static int
  922. GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr)
  923.     Tcl_Interp *interp;        /* The interp we are using for errors. */
  924.     int objIndex;        /* The index of the attribute. */
  925.     char *fileName;        /* The name of the file. */
  926.     Tcl_Obj **attributePtrPtr;    /* A pointer to return the object with. */
  927. {
  928.     struct stat statBuf;
  929.     struct group *groupPtr;
  930.  
  931.     if (stat(fileName, &statBuf) != 0) {
  932.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  933.         "could not stat file \"", fileName, "\": ",
  934.         Tcl_PosixError(interp), (char *) NULL);
  935.     return TCL_ERROR;
  936.     }
  937.  
  938.     groupPtr = getgrgid(statBuf.st_gid);
  939.     if (groupPtr == NULL) {
  940.     endgrent();
  941.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  942.         "could not get group for file \"", fileName, "\": ",
  943.         Tcl_PosixError(interp), (char *) NULL);
  944.     return TCL_ERROR;
  945.     }
  946.  
  947.     *attributePtrPtr = Tcl_NewStringObj(groupPtr->gr_name, -1);
  948.     endgrent();
  949.     
  950.     return TCL_OK;
  951. }
  952.  
  953. /*
  954.  *----------------------------------------------------------------------
  955.  *
  956.  * GetOwnerAttribute
  957.  *
  958.  *      Gets the owner attribute of a file.
  959.  *
  960.  * Results:
  961.  *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
  962.  *    if there is no error.
  963.  *
  964.  * Side effects:
  965.  *      A new object is allocated.
  966.  *      
  967.  *----------------------------------------------------------------------
  968.  */
  969.  
  970. static int
  971. GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr)
  972.     Tcl_Interp *interp;        /* The interp we are using for errors. */
  973.     int objIndex;        /* The index of the attribute. */
  974.     char *fileName;        /* The name of the file. */
  975.     Tcl_Obj **attributePtrPtr;    /* A pointer to return the object with. */
  976. {
  977.     struct stat statBuf;
  978.     struct passwd *pwPtr;
  979.  
  980.     if (stat(fileName, &statBuf) != 0) {
  981.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  982.         "could not stat file \"", fileName, "\": ",
  983.         Tcl_PosixError(interp), (char *) NULL);
  984.     return TCL_ERROR;
  985.     }
  986.  
  987.     pwPtr = getpwuid(statBuf.st_uid);
  988.     if (pwPtr == NULL) {
  989.     endpwent();
  990.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  991.         "could not get owner for file \"", fileName, "\": ",
  992.         Tcl_PosixError(interp), (char *) NULL);
  993.     return TCL_ERROR;
  994.     }
  995.  
  996.     *attributePtrPtr = Tcl_NewStringObj(pwPtr->pw_name, -1);
  997.     endpwent();
  998.     
  999.     return TCL_OK;
  1000. }
  1001.  
  1002. /*
  1003.  *----------------------------------------------------------------------
  1004.  *
  1005.  * GetPermissionsAttribute
  1006.  *
  1007.  *      Gets the group attribute of a file.
  1008.  *
  1009.  * Results:
  1010.  *      Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
  1011.  *    if there is no error. The object will have ref count 0.
  1012.  *
  1013.  * Side effects:
  1014.  *      A new object is allocated.
  1015.  *      
  1016.  *----------------------------------------------------------------------
  1017.  */
  1018.  
  1019. static int
  1020. GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr)
  1021.     Tcl_Interp *interp;            /* The interp we are using for errors. */
  1022.     int objIndex;            /* The index of the attribute. */
  1023.     char *fileName;            /* The name of the file. */
  1024.     Tcl_Obj **attributePtrPtr;        /* A pointer to return the object with. */
  1025. {
  1026.     struct stat statBuf;
  1027.     char returnString[6];
  1028.  
  1029.     if (stat(fileName, &statBuf) != 0) {
  1030.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1031.         "could not stat file \"", fileName, "\": ",
  1032.         Tcl_PosixError(interp), (char *) NULL);
  1033.     return TCL_ERROR;
  1034.     }
  1035.  
  1036.     sprintf(returnString, "%0#5lo", (statBuf.st_mode & 0x00007FFF));
  1037.  
  1038.     *attributePtrPtr = Tcl_NewStringObj(returnString, -1);
  1039.     
  1040.     return TCL_OK;
  1041. }
  1042.  
  1043. /*
  1044.  *----------------------------------------------------------------------
  1045.  *
  1046.  * SetGroupAttribute
  1047.  *
  1048.  *      Sets the file to the given group.
  1049.  *
  1050.  * Results:
  1051.  *      Standard TCL result.
  1052.  *
  1053.  * Side effects:
  1054.  *      The group of the file is changed.
  1055.  *      
  1056.  *----------------------------------------------------------------------
  1057.  */
  1058.  
  1059. static int
  1060. SetGroupAttribute(interp, objIndex, fileName, attributePtr)
  1061.     Tcl_Interp *interp;            /* The interp we are using for errors. */
  1062.     int objIndex;            /* The index of the attribute. */
  1063.     char *fileName;            /* The name of the file. */
  1064.     Tcl_Obj *attributePtr;        /* The attribute to set. */
  1065. {
  1066.     gid_t groupNumber;
  1067.     long placeHolder;
  1068.  
  1069.     if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
  1070.     struct group *groupPtr;
  1071.     char *groupString = Tcl_GetStringFromObj(attributePtr, NULL);
  1072.  
  1073.     Tcl_ResetResult(interp);
  1074.     groupPtr = getgrnam(groupString);
  1075.     if (groupPtr == NULL) {
  1076.         endgrent();
  1077.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1078.             "could not set group for file \"", fileName,
  1079.             "\": group \"", groupString, "\" does not exist",
  1080.             (char *) NULL);
  1081.         return TCL_ERROR;
  1082.     }
  1083.     groupNumber = groupPtr->gr_gid;
  1084.     } else {
  1085.     groupNumber = (gid_t) placeHolder;
  1086.     }
  1087.  
  1088.     if (chown(fileName, -1, groupNumber) != 0) {
  1089.     endgrent();
  1090.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1091.         "could not set group for file \"", fileName, "\": ",
  1092.         Tcl_PosixError(interp), (char *) NULL);
  1093.     return TCL_ERROR;
  1094.     }    
  1095.     endgrent();
  1096.     return TCL_OK;
  1097. }
  1098.  
  1099. /*
  1100.  *----------------------------------------------------------------------
  1101.  *
  1102.  * SetOwnerAttribute
  1103.  *
  1104.  *      Sets the file to the given owner.
  1105.  *
  1106.  * Results:
  1107.  *      Standard TCL result.
  1108.  *
  1109.  * Side effects:
  1110.  *      The group of the file is changed.
  1111.  *      
  1112.  *----------------------------------------------------------------------
  1113.  */
  1114.  
  1115. static int
  1116. SetOwnerAttribute(interp, objIndex, fileName, attributePtr)
  1117.     Tcl_Interp *interp;            /* The interp we are using for errors. */
  1118.     int objIndex;            /* The index of the attribute. */
  1119.     char *fileName;            /* The name of the file. */
  1120.     Tcl_Obj *attributePtr;        /* The attribute to set. */
  1121. {
  1122.     uid_t userNumber;
  1123.     long placeHolder;
  1124.  
  1125.     if (Tcl_GetLongFromObj(interp, attributePtr, &placeHolder) != TCL_OK) {
  1126.     struct passwd *pwPtr;
  1127.     char *ownerString = Tcl_GetStringFromObj(attributePtr, NULL);
  1128.  
  1129.     Tcl_ResetResult(interp);
  1130.     pwPtr = getpwnam(ownerString);
  1131.     if (pwPtr == NULL) {
  1132.         Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1133.             "could not set owner for file \"", fileName,
  1134.             "\": user \"", ownerString, "\" does not exist",
  1135.             (char *) NULL);
  1136.         return TCL_ERROR;
  1137.     }
  1138.     userNumber = pwPtr->pw_uid;
  1139.     } else {
  1140.     userNumber = (uid_t) placeHolder;
  1141.     }
  1142.  
  1143.     if (chown(fileName, userNumber, -1) != 0) {
  1144.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1145.         "could not set owner for file \"", fileName, "\": ",
  1146.         Tcl_PosixError(interp), (char *) NULL);
  1147.     return TCL_ERROR;
  1148.     }    
  1149.     
  1150.     return TCL_OK;
  1151. }
  1152.  
  1153. /*
  1154.  *----------------------------------------------------------------------
  1155.  *
  1156.  * SetPermissionsAttribute
  1157.  *
  1158.  *      Sets the file to the given group.
  1159.  *
  1160.  * Results:
  1161.  *      Standard TCL result.
  1162.  *
  1163.  * Side effects:
  1164.  *      The group of the file is changed.
  1165.  *      
  1166.  *----------------------------------------------------------------------
  1167.  */
  1168.  
  1169. static int
  1170. SetPermissionsAttribute(interp, objIndex, fileName, attributePtr)
  1171.     Tcl_Interp *interp;            /* The interp we are using for errors. */
  1172.     int objIndex;            /* The index of the attribute. */
  1173.     char *fileName;            /* The name of the file. */
  1174.     Tcl_Obj *attributePtr;        /* The attribute to set. */
  1175. {
  1176.     long modeInt;
  1177.     mode_t newMode;
  1178.  
  1179.     /*
  1180.      * mode_t is a long under SPARC; an int under SunOS. Since we do not
  1181.      * know how big it really is, we get the long and then cast it
  1182.      * down to a mode_t.
  1183.      */
  1184.     
  1185.     if (Tcl_GetLongFromObj(interp, attributePtr, &modeInt)
  1186.         != TCL_OK) {
  1187.     return TCL_ERROR;
  1188.     }
  1189.  
  1190.     newMode = (mode_t) modeInt;
  1191.  
  1192.     if (chmod(fileName, newMode) != 0) {
  1193.     Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
  1194.         "could not set permissions for file \"", fileName, "\": ",
  1195.         Tcl_PosixError(interp), (char *) NULL);
  1196.     return TCL_ERROR;
  1197.     }
  1198.     return TCL_OK;
  1199. }
  1200. /*
  1201.  *---------------------------------------------------------------------------
  1202.  *
  1203.  * TclpListVolumes --
  1204.  *
  1205.  *    Lists the currently mounted volumes, which on UNIX is just /.
  1206.  *
  1207.  * Results:
  1208.  *    A standard Tcl result.  Will always be TCL_OK, since there is no way
  1209.  *    that this command can fail.  Also, the interpreter's result is set to 
  1210.  *    the list of volumes.
  1211.  *
  1212.  * Side effects:
  1213.  *    None.
  1214.  *
  1215.  *---------------------------------------------------------------------------
  1216.  */
  1217.  
  1218. int
  1219. TclpListVolumes(interp)
  1220.     Tcl_Interp *interp;            /* Interpreter to which to pass
  1221.                      * the volume list. */
  1222. {
  1223.     Tcl_Obj *resultPtr;
  1224.     
  1225.     resultPtr = Tcl_GetObjResult(interp);
  1226.     Tcl_SetStringObj(resultPtr, "/", 1);
  1227.     return TCL_OK;    
  1228. }
  1229.  
  1230.