diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 1187 |
1 files changed, 618 insertions, 569 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index cc910d1..2e74592 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1,28 +1,27 @@ /* * tclUnixFCmd.c * - * This file implements the unix specific portion of file manipulation - * subcommands of the "file" command. All filename arguments should + * 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-1998 Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * 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.43 2005/05/11 00:53:51 hobbs Exp $ + * RCS: @(#) $Id: tclUnixFCmd.c,v 1.44 2005/07/20 23:16:00 dkf Exp $ * - * Portions of this code were derived from NetBSD source code which has - * the following copyright notice: + * 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. + * 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. @@ -30,21 +29,21 @@ * 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 + * 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 + * 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. + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH + * DAMAGE. */ #include "tclInt.h" @@ -61,9 +60,9 @@ * TraverseUnixTree() calls the traverseProc() */ -#define DOTREE_PRED 1 /* pre-order directory */ -#define DOTREE_POSTD 2 /* post-order directory */ -#define DOTREE_F 3 /* regular file */ +#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. @@ -109,57 +108,51 @@ typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr, /* * Constants and variables necessary for file attributes subcommand. - * - * IMPORTANT: The permissions attribute is assumed to be the third - * item (i.e. to be indexed with '2' in arrays) in code in tclIOUtil.c - * and possibly elsewhere in Tcl's core. + * + * IMPORTANT: The permissions attribute is assumed to be the third item (i.e. + * to be indexed with '2' in arrays) in code in tclIOUtil.c and possibly + * elsewhere in Tcl's core. */ #ifdef DJGPP -/*See contrib/djgpp/tclDjgppFCmd.c for definitio*/ +/* + * See contrib/djgpp/tclDjgppFCmd.c for definition. + */ + extern TclFileAttrProcs tclpFileAttrProcs[]; extern char *tclpFileAttrStrings[]; #else enum { - UNIX_GROUP_ATTRIBUTE, - UNIX_OWNER_ATTRIBUTE, - UNIX_PERMISSIONS_ATTRIBUTE, + UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) UNIX_READONLY_ATTRIBUTE, #endif #ifdef MAC_OSX_TCL - MACOSX_CREATOR_ATTRIBUTE, - MACOSX_TYPE_ATTRIBUTE, - MACOSX_HIDDEN_ATTRIBUTE, + MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, #endif UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ }; CONST char *tclpFileAttrStrings[] = { - "-group", - "-owner", - "-permissions", + "-group", "-owner", "-permissions", #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) "-readonly", #endif #ifdef MAC_OSX_TCL - "-creator", - "-type", - "-hidden", - "-rsrclength", + "-creator", "-type", "-hidden", "-rsrclength", #endif (char *) NULL }; CONST TclFileAttrProcs tclpFileAttrProcs[] = { - {GetGroupAttribute, SetGroupAttribute}, - {GetOwnerAttribute, SetOwnerAttribute}, - {GetPermissionsAttribute, SetPermissionsAttribute}, + {GetGroupAttribute, SetGroupAttribute}, + {GetOwnerAttribute, SetOwnerAttribute}, + {GetPermissionsAttribute, SetPermissionsAttribute}, #if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - {GetReadOnlyAttribute, SetReadOnlyAttribute}, + {GetReadOnlyAttribute, SetReadOnlyAttribute}, #endif #ifdef MAC_OSX_TCL {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, @@ -195,11 +188,12 @@ static int TraverseUnixTree _ANSI_ARGS_(( #ifdef PURIFY /* - * realpath and purify don't mix happily. It has been noted that realpath + * realpath and purify don't mix happily. It has been noted that realpath * should not be used with purify because of bogus warnings, but just - * memset'ing the resolved path will squelch those. This assumes we are + * memset'ing the resolved path will squelch those. This assumes we are * passing the standard MAXPATHLEN size resolved arg. */ + static char * Realpath _ANSI_ARGS_((CONST char *path, char *resolved)); @@ -214,50 +208,48 @@ Realpath(path, resolved) #else #define Realpath realpath #endif - /* *--------------------------------------------------------------------------- * * TclpObjRenameFile, DoRenameFile -- * - * 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: + * 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. + * 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: + * 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. + * 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. + * 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. + * 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 +int TclpObjRenameFile(srcPathPtr, destPathPtr) Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; { - return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoRenameFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int @@ -275,21 +267,21 @@ DoRenameFile(src, dst) } /* - * IRIX returns EIO when you attept to move a directory into - * itself. We just map EIO to EINVAL get the right message on SGI. - * Most platforms don't return EIO except in really strange cases. + * IRIX returns EIO when you attept to move a directory into itself. We + * just map EIO to EINVAL get the right message on SGI. Most platforms + * don't return EIO except in really strange cases. */ - + if (errno == EIO) { errno = EINVAL; } - + #ifndef NO_REALPATH /* - * 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() not defined on all systems. + * 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() not defined on all systems. */ if (errno == EINVAL) { @@ -298,12 +290,12 @@ DoRenameFile(src, dst) Tcl_DirEntry *dirEntPtr; if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ - && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native. */ + && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native */ && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) { dirPtr = opendir(dst); /* INTL: Native. */ if (dirPtr != NULL) { while (1) { - dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */ + dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */ if (dirEntPtr == NULL) { break; } @@ -326,15 +318,15 @@ DoRenameFile(src, dst) * 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. + * 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; @@ -345,48 +337,48 @@ DoRenameFile(src, dst) * * TclpObjCopyFile, DoCopyFile -- * - * Copy a single file (not a directory). If dst already exists and - * is not a directory, it is removed. + * 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: + * 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. + * 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. + * 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 +int TclpObjCopyFile(srcPathPtr, destPathPtr) Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; { - return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), - Tcl_FSGetNativePath(destPathPtr)); + return DoCopyFile(Tcl_FSGetNativePath(srcPathPtr), + Tcl_FSGetNativePath(destPathPtr)); } static int DoCopyFile(src, dst) - CONST char *src; /* Pathname of file to be copied (native). */ - CONST char *dst; /* Pathname of file to copy to (native). */ + CONST char *src; /* Pathname of file to be copied (native). */ + CONST char *dst; /* Pathname of file to copy to (native). */ { Tcl_StatBuf srcStatBuf, dstStatBuf; /* * Have to do a stat() to determine the filetype. */ - + if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } @@ -396,10 +388,10 @@ DoCopyFile(src, dst) } /* - * symlink, and some of the other calls will fail if the target - * exists, so we remove it first + * symlink, and some of the other calls will fail if the target exists, so + * we remove it first. */ - + if (TclOSlstat(dst, &dstStatBuf) == 0) { /* INTL: Native. */ if (S_ISDIR(dstStatBuf.st_mode)) { errno = EISDIR; @@ -409,43 +401,40 @@ DoCopyFile(src, dst) if (unlink(dst) != 0) { /* INTL: Native. */ if (errno != ENOENT) { return TCL_ERROR; - } + } } switch ((int) (srcStatBuf.st_mode & S_IFMT)) { #ifndef DJGPP - case S_IFLNK: { - char link[MAXPATHLEN]; - int length; + case S_IFLNK: { + char link[MAXPATHLEN]; + int length; - length = readlink(src, link, sizeof(link)); /* INTL: Native. */ - if (length == -1) { - return TCL_ERROR; - } - link[length] = '\0'; - if (symlink(link, dst) < 0) { /* INTL: Native. */ - return TCL_ERROR; - } - break; + length = readlink(src, link, sizeof(link)); /* INTL: Native. */ + if (length == -1) { + return TCL_ERROR; } -#endif - case S_IFBLK: - case S_IFCHR: { - if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */ - srcStatBuf.st_rdev) < 0) { - return TCL_ERROR; - } - return CopyFileAtts(src, dst, &srcStatBuf); + link[length] = '\0'; + if (symlink(link, dst) < 0) { /* INTL: Native. */ + return TCL_ERROR; } - case S_IFIFO: { - if (mkfifo(dst, srcStatBuf.st_mode) < 0) { /* INTL: Native. */ - return TCL_ERROR; - } - return CopyFileAtts(src, dst, &srcStatBuf); + break; + } +#endif + case S_IFBLK: + case S_IFCHR: + if (mknod(dst, srcStatBuf.st_mode, /* INTL: Native. */ + srcStatBuf.st_rdev) < 0) { + return TCL_ERROR; } - default: { - return TclUnixCopyFile(src, dst, &srcStatBuf, 0); + return CopyFileAtts(src, dst, &srcStatBuf); + case S_IFIFO: + if (mkfifo(dst, srcStatBuf.st_mode) < 0) { /* INTL: Native. */ + return TCL_ERROR; } + return CopyFileAtts(src, dst, &srcStatBuf); + default: + return TclUnixCopyFile(src, dst, &srcStatBuf, 0); } return TCL_OK; } @@ -453,31 +442,30 @@ DoCopyFile(src, dst) /* *---------------------------------------------------------------------- * - * TclUnixCopyFile - + * TclUnixCopyFile - * - * Helper function for TclpCopyFile. Copies one regular file, - * using read() and write(). + * 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. + * A file is copied. Dst will be overwritten if it exists. * *---------------------------------------------------------------------- */ -int -TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) +int +TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) CONST char *src; /* Pathname of file to copy (native). */ CONST char *dst; /* Pathname of file to create/overwrite * (native). */ CONST Tcl_StatBuf *statBufPtr; /* Used to determine mode and blocksize. */ - int dontCopyAtts; /* if flag set, don't copy attributes. */ + int dontCopyAtts; /* If flag set, don't copy attributes. */ { - int srcFd; - int dstFd; + int srcFd, dstFd; unsigned blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; @@ -488,30 +476,37 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) #define BINMODE #endif - if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native. */ + if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */ return TCL_ERROR; } - dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY BINMODE, /* INTL: Native. */ + dstFd = TclOSopen(dst, O_CREAT|O_TRUNC|O_WRONLY BINMODE, /* INTL: Native */ statBufPtr->st_mode); if (dstFd < 0) { - close(srcFd); + close(srcFd); return TCL_ERROR; } + /* + * Try to work out the best size of buffer to use for copying. If we + * can't, it's no big deal as we can just use a (32-bit) page, since + * that's likely to be fairly efficient anyway. + */ + #ifdef HAVE_ST_BLKSIZE blockSize = statBufPtr->st_blksize; #else #ifndef NO_FSTATFS { struct statfs fs; + if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) { blockSize = fs.f_bsize; } else { blockSize = 4096; } } -#else +#else blockSize = 4096; #endif #endif @@ -527,7 +522,7 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) break; } } - + ckfree(buffer); close(srcFd); if ((close(dstFd) != 0) || (nread == -1)) { @@ -536,9 +531,8 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) } if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == 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. + * 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); /* INTL: Native. */ @@ -552,24 +546,24 @@ TclUnixCopyFile(src, dst, statBufPtr, dontCopyAtts) * * TclpObjDeleteFile, TclpDeleteFile -- * - * Removes a single file (not a directory). + * 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: + * 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. + * 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. + * The file is deleted, even if it is read-only. * *--------------------------------------------------------------------------- */ -int +int TclpObjDeleteFile(pathPtr) Tcl_Obj *pathPtr; { @@ -578,7 +572,7 @@ TclpObjDeleteFile(pathPtr) int TclpDeleteFile(path) - CONST char *path; /* Pathname of file to be removed (native). */ + CONST char *path; /* Pathname of file to be removed (native). */ { if (unlink(path) != 0) { /* INTL: Native. */ return TCL_ERROR; @@ -591,28 +585,28 @@ TclpDeleteFile(path) * * TclpCreateDirectory, DoCreateDirectory -- * - * 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. + * 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: + * 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. + * 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. + * A directory is created with the current umask, except that permission + * for u+rwx will always be added. * *--------------------------------------------------------------------------- */ -int +int TclpObjCreateDirectory(pathPtr) Tcl_Obj *pathPtr; { @@ -645,28 +639,26 @@ DoCreateDirectory(path) * * TclpObjCopyDirectory -- * - * 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. + * 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 TclpObjCreateDirectory and - * TclpObjCopyFile for a description of possible values for errno. + * 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 TclpObjCreateDirectory and TclpObjCopyFile 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. + * 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 +int TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_Obj *srcPathPtr; Tcl_Obj *destPathPtr; @@ -676,18 +668,18 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) Tcl_DString srcString, dstString; int ret; Tcl_Obj *transPtr; - + transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), - -1, &srcString); + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + -1, &srcString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } transPtr = Tcl_FSGetTranslatedPath(NULL,destPathPtr); - Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), - -1, &dstString); + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + -1, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -714,25 +706,25 @@ TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) * 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: + * 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. + * 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 + * Directory removed. If an error occurs, the error will be returned * immediately, and remaining files will not be deleted. * *--------------------------------------------------------------------------- */ - -int + +int TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_Obj *pathPtr; int recursive; @@ -743,9 +735,9 @@ TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), - -1, &pathString); + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + -1, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -764,32 +756,35 @@ static int DoRemoveDirectory(pathPtr, recursive, errorPtr) Tcl_DString *pathPtr; /* Pathname of directory to be removed * (native). */ - int recursive; /* If non-zero, removes directories that - * are nonempty. Otherwise, will only remove - * empty directories. */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int recursive; /* If non-zero, removes directories that are + * nonempty. Otherwise, will only remove empty + * directories. */ + Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { CONST char *path; mode_t oldPerm = 0; int result; - + path = Tcl_DStringValue(pathPtr); - + if (recursive != 0) { - /* We should try to change permissions so this can be deleted */ + /* + * We should try to change permissions so this can be deleted. + */ + Tcl_StatBuf statBuf; int newPerm; if (TclOSstat(path, &statBuf) == 0) { oldPerm = (mode_t) (statBuf.st_mode & 0x00007FFF); } - + newPerm = oldPerm | (64+128+256); chmod(path, (mode_t) newPerm); } - + if (rmdir(path) == 0) { /* INTL: Native. */ return TCL_OK; } @@ -804,46 +799,49 @@ DoRemoveDirectory(pathPtr, recursive, errorPtr) } result = TCL_ERROR; } - + /* - * The directory is nonempty, but the recursive flag has been - * specified, so we recursively remove all the files in the directory. + * The directory is nonempty, but the recursive flag has been specified, + * so we recursively remove all the files in the directory. */ if (result == TCL_OK) { result = TraverseUnixTree(TraversalDelete, pathPtr, NULL, errorPtr, 1); } - + if ((result != TCL_OK) && (recursive != 0)) { - /* Try to restore permissions */ - chmod(path, oldPerm); + /* + * Try to restore permissions. + */ + + chmod(path, oldPerm); } 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() . + * 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. + * 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. + * 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 +static int TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) TraversalProc *traverseProc;/* Function to call for every file and * directory in source hierarchy. */ @@ -851,15 +849,16 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) * traversed (native). */ Tcl_DString *targetPtr; /* Pathname of directory to traverse in * parallel with source directory (native). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ int doRewind; /* Flag indicating that to ensure complete * traversal of source hierarchy, the readdir * loop should be rewound whenever * traverseProc has returned TCL_OK; this is * required when traverseProc modifies the - * source hierarchy, e.g. by deleting files. */ + * source hierarchy, e.g. by deleting + * files. */ { Tcl_StatBuf statBuf; CONST char *source, *errfile; @@ -888,7 +887,7 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) } dirPtr = opendir(source); /* INTL: Native. */ if (dirPtr == NULL) { - /* + /* * Can't read directory */ @@ -901,9 +900,9 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) closedir(dirPtr); return result; } - + Tcl_DStringAppend(sourcePtr, "/", 1); - sourceLen = Tcl_DStringLength(sourcePtr); + sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, "/", 1); @@ -912,17 +911,17 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) do { needRewind = 0; - while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */ + while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native */ if ((dirEntPtr->d_name[0] == '.') && ((dirEntPtr->d_name[1] == '\0') || (strcmp(dirEntPtr->d_name, "..") == 0))) { continue; } - - /* + + /* * Append name after slash, and recurse on the file. */ - + Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1); if (targetPtr != NULL) { Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1); @@ -935,11 +934,11 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) } else { needRewind = doRewind; } - + /* * Remove name after slash. */ - + Tcl_DStringSetLength(sourcePtr, sourceLen); if (targetPtr != NULL) { Tcl_DStringSetLength(targetPtr, targetLen); @@ -950,7 +949,7 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) } } while (needRewind); closedir(dirPtr); - + /* * Strip off the trailing slash we added */ @@ -962,21 +961,22 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) if (result == TCL_OK) { /* - * Call traverseProc() on a directory after visiting all the - * files in that directory. + * Call traverseProc() on a directory after visiting all the files in + * that directory. */ result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, errorPtr); } - end: + + end: if (errfile != NULL) { if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); } result = TCL_ERROR; } - + return result; } @@ -985,56 +985,55 @@ TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) * * TraversalCopy * - * Called from TraverseUnixTree in order to execute a recursive copy - * of a directory. + * Called from TraverseUnixTree in order to execute a recursive copy of a + * directory. * * Results: - * Standard Tcl result. + * Standard Tcl result. * * Side effects: - * The file or directory src may be copied to dst, depending on - * the value of type. - * + * The file or directory src may be copied to dst, depending on the value + * of type. + * *---------------------------------------------------------------------- */ -static int -TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) +static int +TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) Tcl_DString *srcPtr; /* Source pathname to copy (native). */ Tcl_DString *dstPtr; /* Destination pathname of copy (native). */ CONST Tcl_StatBuf *statBufPtr; /* Stat info for file specified by srcPtr. */ - int type; /* Reason for call - see TraverseUnixTree(). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int type; /* Reason for call - see TraverseUnixTree(). */ + Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { switch (type) { - case DOTREE_F: - if (DoCopyFile(Tcl_DStringValue(srcPtr), - Tcl_DStringValue(dstPtr)) == TCL_OK) { - return TCL_OK; - } - break; - - case DOTREE_PRED: - if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_F: + if (DoCopyFile(Tcl_DStringValue(srcPtr), + Tcl_DStringValue(dstPtr)) == TCL_OK) { + return TCL_OK; + } + break; - case DOTREE_POSTD: - if (CopyFileAtts(Tcl_DStringValue(srcPtr), - Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_PRED: + if (DoCreateDirectory(Tcl_DStringValue(dstPtr)) == TCL_OK) { + return TCL_OK; + } + break; + case DOTREE_POSTD: + if (CopyFileAtts(Tcl_DStringValue(srcPtr), + Tcl_DStringValue(dstPtr), statBufPtr) == TCL_OK) { + return TCL_OK; + } + break; } /* - * There shouldn't be a problem with src, because we already checked it - * to get here. + * There shouldn't be a problem with src, because we already checked it to + * get here. */ if (errorPtr != NULL) { @@ -1049,47 +1048,44 @@ TraversalCopy(srcPtr, dstPtr, statBufPtr, type, errorPtr) * * 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. + * 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. + * Standard Tcl result. * * Side effects: - * Files or directory specified by src will be deleted. + * Files or directory specified by src will be deleted. * *---------------------------------------------------------------------- */ static int -TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) +TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) Tcl_DString *srcPtr; /* Source pathname (native). */ Tcl_DString *ignore; /* Destination pathname (not used). */ CONST Tcl_StatBuf *statBufPtr; /* Stat info for file specified by srcPtr. */ - int type; /* Reason for call - see TraverseUnixTree(). */ - Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free - * DString filled with UTF-8 name of file - * causing error. */ + int type; /* Reason for call - see TraverseUnixTree(). */ + Tcl_DString *errorPtr; /* If non-NULL, uninitialized or free DString + * filled with UTF-8 name of file causing + * error. */ { switch (type) { - case DOTREE_F: { - if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { - return TCL_OK; - } - break; + case DOTREE_F: + if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { + return TCL_OK; } - case DOTREE_PRED: { + break; + case DOTREE_PRED: + return TCL_OK; + case DOTREE_POSTD: + if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { return TCL_OK; } - case DOTREE_POSTD: { - if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { - return TCL_OK; - } - break; - } + break; } if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), @@ -1103,22 +1099,21 @@ TraversalDelete(srcPtr, ignore, statBufPtr, type, errorPtr) * * CopyFileAtts -- * - * Copy the file attributes such as owner, group, permissions, - * and modification date from one file to another. + * 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. + * 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) +CopyFileAtts(src, dst, statBufPtr) CONST char *src; /* Path name of source file (native). */ CONST char *dst; /* Path name of target file (native). */ CONST Tcl_StatBuf *statBufPtr; @@ -1126,19 +1121,18 @@ CopyFileAtts(src, dst, statBufPtr) { 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(). + + /* + * 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)) { /* INTL: Native. */ newMode &= ~(S_ISUID | S_ISGID); if (chmod(dst, newMode)) { /* INTL: Native. */ @@ -1146,8 +1140,8 @@ CopyFileAtts(src, dst, statBufPtr) } } - tval.actime = statBufPtr->st_atime; - tval.modtime = statBufPtr->st_mtime; + tval.actime = statBufPtr->st_atime; + tval.modtime = statBufPtr->st_mtime; if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; @@ -1164,15 +1158,15 @@ CopyFileAtts(src, dst, statBufPtr) * * GetGroupAttribute * - * Gets the group attribute of a file. + * Gets the group attribute of a file. * * Results: - * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr - * if there is no error. + * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there + * is no error. * * Side effects: - * A new object is allocated. - * + * A new object is allocated. + * *---------------------------------------------------------------------- */ @@ -1188,10 +1182,10 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1205,7 +1199,7 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_DString ds; CONST char *utf; - utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); + utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, -1); Tcl_DStringFree(&ds); } @@ -1218,15 +1212,15 @@ GetGroupAttribute(interp, objIndex, fileName, attributePtrPtr) * * GetOwnerAttribute * - * Gets the owner attribute of a file. + * Gets the owner attribute of a file. * * Results: - * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr - * if there is no error. + * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr if there + * is no error. * * Side effects: - * A new object is allocated. - * + * A new object is allocated. + * *---------------------------------------------------------------------- */ @@ -1242,10 +1236,10 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1259,7 +1253,7 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) Tcl_DString ds; CONST char *utf; - utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); + utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds)); Tcl_DStringFree(&ds); } @@ -1272,15 +1266,15 @@ GetOwnerAttribute(interp, objIndex, fileName, attributePtrPtr) * * GetPermissionsAttribute * - * Gets the group attribute of a file. + * 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. + * 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. - * + * A new object is allocated. + * *---------------------------------------------------------------------- */ @@ -1296,10 +1290,10 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1309,7 +1303,7 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); *attributePtrPtr = Tcl_NewStringObj(returnString, -1); - + return TCL_OK; } @@ -1318,23 +1312,23 @@ GetPermissionsAttribute(interp, objIndex, fileName, attributePtrPtr) * * SetGroupAttribute -- * - * Sets the group of the file to the specified group. + * Sets the group of the file to the specified group. * * Results: - * Standard TCL result. + * Standard TCL result. * * Side effects: - * As above. - * + * As above. + * *--------------------------------------------------------------------------- */ static int SetGroupAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp for error reporting. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* New group for file. */ + Tcl_Interp *interp; /* The interp for error reporting. */ + int objIndex; /* The index of the attribute. */ + Tcl_Obj *fileName; /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr; /* New group for file. */ { long gid; int result; @@ -1356,7 +1350,7 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr) endgrent(); if (interp != NULL) { Tcl_AppendResult(interp, "could not set group for file \"", - Tcl_GetString(fileName), "\": group \"", + Tcl_GetString(fileName), "\": group \"", string, "\" does not exist", (char *) NULL); } @@ -1372,11 +1366,11 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr) if (result != 0) { if (interp != NULL) { Tcl_AppendResult(interp, "could not set group for file \"", - Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), + Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } return TCL_ERROR; - } + } return TCL_OK; } @@ -1385,23 +1379,23 @@ SetGroupAttribute(interp, objIndex, fileName, attributePtr) * * SetOwnerAttribute -- * - * Sets the owner of the file to the specified owner. + * Sets the owner of the file to the specified owner. * * Results: - * Standard TCL result. + * Standard TCL result. * * Side effects: - * As above. - * + * As above. + * *--------------------------------------------------------------------------- */ static int SetOwnerAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp for error reporting. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* New owner for file. */ + Tcl_Interp *interp; /* The interp for error reporting. */ + int objIndex; /* The index of the attribute. */ + Tcl_Obj *fileName; /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr; /* New owner for file. */ { long uid; int result; @@ -1435,7 +1429,7 @@ SetOwnerAttribute(interp, objIndex, fileName, attributePtr) if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set owner for file \"", + Tcl_AppendResult(interp, "could not set owner for file \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1449,23 +1443,23 @@ SetOwnerAttribute(interp, objIndex, fileName, attributePtr) * * SetPermissionsAttribute * - * Sets the file to the given permission. + * Sets the file to the given permission. * * Results: - * Standard TCL result. + * Standard TCL result. * * Side effects: - * The permission of the file is changed. - * + * The permission 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. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* The attribute to set. */ + Tcl_Interp *interp; /* The interp we are using for errors. */ + int objIndex; /* The index of the attribute. */ + Tcl_Obj *fileName; /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr; /* The attribute to set. */ { long mode; mode_t newMode; @@ -1475,8 +1469,9 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) /* * First try if the string is a number */ + if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { - newMode = (mode_t) (mode & 0x00007FFF); + newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; char *modeStringPtr = Tcl_GetString(attributePtr); @@ -1484,13 +1479,14 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) /* * Try the forms "rwxrwxrwx" and "ugo=rwx" * - * We get the current mode of the file, in order to allow for - * ug+-=rwx style chmod strings. + * We get the current mode of the file, in order to allow for ug+-=rwx + * style chmod strings. */ + result = TclpObjStat(fileName, &buf); if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1511,7 +1507,7 @@ SetPermissionsAttribute(interp, objIndex, fileName, attributePtr) result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set permissions for file \"", + Tcl_AppendResult(interp, "could not set permissions for file \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1552,9 +1548,9 @@ TclpObjListVolumes(void) * * GetModeFromPermString -- * - * This procedure is invoked to process the "file permissions" - * Tcl command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "file permissions" Tcl + * command, to check for a "rwxrwxrwx" or "ugoa+-=rwxst" string. See the + * user documentation for details on what it does. * * Results: * A standard Tcl result. @@ -1572,78 +1568,79 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) mode_t *modePtr; /* pointer to the mode value */ { mode_t newMode; - mode_t oldMode; /* Storage for the value of the old mode - * (that is passed in), to allow for the - * chmod style manipulation */ + mode_t oldMode; /* Storage for the value of the old mode (that + * is passed in), to allow for the chmod style + * manipulation. */ int i,n, who, op, what, op_found, who_found; /* * We start off checking for an "rwxrwxrwx" style permissions string */ + if (strlen(modeStringPtr) != 9) { - goto chmodStyleCheck; + goto chmodStyleCheck; } newMode = 0; for (i = 0; i < 9; i++) { switch (*(modeStringPtr+i)) { - case 'r': - if ((i%3) != 0) { - goto chmodStyleCheck; - } - newMode |= (1<<(8-i)); - break; - case 'w': - if ((i%3) != 1) { - goto chmodStyleCheck; - } - newMode |= (1<<(8-i)); - break; - case 'x': - if ((i%3) != 2) { - goto chmodStyleCheck; - } - newMode |= (1<<(8-i)); - break; - case 's': - if (((i%3) != 2) || (i > 5)) { - goto chmodStyleCheck; - } - newMode |= (1<<(8-i)); - newMode |= (1<<(11-(i/3))); - break; - case 'S': - if (((i%3) != 2) || (i > 5)) { - goto chmodStyleCheck; - } - newMode |= (1<<(11-(i/3))); - break; - case 't': - if (i != 8) { - goto chmodStyleCheck; - } - newMode |= (1<<(8-i)); - newMode |= (1<<9); - break; - case 'T': - if (i != 8) { - goto chmodStyleCheck; - } - newMode |= (1<<9); - break; - case '-': - break; - default: - /* - * Oops, not what we thought it was, so go on - */ + case 'r': + if ((i%3) != 0) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 'w': + if ((i%3) != 1) { goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 'x': + if ((i%3) != 2) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + break; + case 's': + if (((i%3) != 2) || (i > 5)) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + newMode |= (1<<(11-(i/3))); + break; + case 'S': + if (((i%3) != 2) || (i > 5)) { + goto chmodStyleCheck; + } + newMode |= (1<<(11-(i/3))); + break; + case 't': + if (i != 8) { + goto chmodStyleCheck; + } + newMode |= (1<<(8-i)); + newMode |= (1<<9); + break; + case 'T': + if (i != 8) { + goto chmodStyleCheck; + } + newMode |= (1<<9); + break; + case '-': + break; + default: + /* + * Oops, not what we thought it was, so go on + */ + goto chmodStyleCheck; } } *modePtr = newMode; return TCL_OK; - chmodStyleCheck: + chmodStyleCheck: /* * We now check for an "ugoa+-=rwxst" style permissions string */ @@ -1655,18 +1652,18 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) if (!who_found) { /* who */ switch (*(modeStringPtr+n+i)) { - case 'u' : - who |= 0x9c0; - continue; - case 'g' : - who |= 0x438; - continue; - case 'o' : - who |= 0x207; - continue; - case 'a' : - who |= 0xfff; - continue; + case 'u': + who |= 0x9c0; + continue; + case 'g': + who |= 0x438; + continue; + case 'o': + who |= 0x207; + continue; + case 'a': + who |= 0xfff; + continue; } } who_found = 1; @@ -1676,43 +1673,43 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) if (!op_found) { /* op */ switch (*(modeStringPtr+n+i)) { - case '+' : - op = 1; - op_found = 1; - continue; - case '-' : - op = 2; - op_found = 1; - continue; - case '=' : - op = 3; - op_found = 1; - continue; - default : - return TCL_ERROR; - } - } - /* what */ - switch (*(modeStringPtr+n+i)) { - case 'r' : - what |= 0x124; - continue; - case 'w' : - what |= 0x92; + case '+': + op = 1; + op_found = 1; continue; - case 'x' : - what |= 0x49; + case '-': + op = 2; + op_found = 1; continue; - case 's' : - what |= 0xc00; + case '=': + op = 3; + op_found = 1; continue; - case 't' : - what |= 0x200; - continue; - case ',' : - break; - default : + default: return TCL_ERROR; + } + } + /* what */ + switch (*(modeStringPtr+n+i)) { + case 'r': + what |= 0x124; + continue; + case 'w': + what |= 0x92; + continue; + case 'x': + what |= 0x49; + continue; + case 's': + what |= 0xc00; + continue; + case 't': + what |= 0x200; + continue; + case ',': + break; + default: + return TCL_ERROR; } if (*(modeStringPtr+n+i) == ',') { i++; @@ -1720,15 +1717,15 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) } } switch (op) { - case 1 : - *modePtr = oldMode | (who & what); - continue; - case 2 : - *modePtr = oldMode & ~(who & what); - continue; - case 3 : - *modePtr = (oldMode & ~who) | (who & what); - continue; + case 1 : + *modePtr = oldMode | (who & what); + continue; + case 2 : + *modePtr = oldMode & ~(who & what); + continue; + case 3 : + *modePtr = (oldMode & ~who) | (who & what); + continue; } } return TCL_OK; @@ -1739,21 +1736,21 @@ GetModeFromPermString(interp, modeStringPtr, modePtr) * * TclpObjNormalizePath -- * - * This function scans through a path specification and replaces - * it, in place, with a normalized version. A normalized version - * is one in which all symlinks in the path are replaced with - * their expanded form (except a symlink at the very end of the - * path). + * This function scans through a path specification and replaces it, in + * place, with a normalized version. A normalized version is one in which + * all symlinks in the path are replaced with their expanded form (except + * a symlink at the very end of the path). * * Results: - * The new 'nextCheckpoint' value, giving as far as we could - * understand in the path. + * The new 'nextCheckpoint' value, giving as far as we could understand + * in the path. * * Side effects: * The pathPtr string, is modified. * *--------------------------------------------------------------------------- */ + int TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) Tcl_Interp *interp; @@ -1767,122 +1764,166 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) #ifndef NO_REALPATH char normPath[MAXPATHLEN]; Tcl_DString ds; - CONST char *nativePath; + CONST char *nativePath; #endif - /* - * We add '1' here because if nextCheckpoint is zero we know - * that '/' exists, and if it isn't zero, it must point at - * a directory separator which we also know exists. + + /* + * We add '1' here because if nextCheckpoint is zero we know that '/' + * exists, and if it isn't zero, it must point at a directory separator + * which we also know exists. */ + currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } #ifndef NO_REALPATH - /* For speed, try to get the entire path in one go */ + /* + * For speed, try to get the entire path in one go. + */ + if (nextCheckpoint == 0) { - char *lastDir = strrchr(currentPathEndPosition, '/'); + char *lastDir = strrchr(currentPathEndPosition, '/'); + if (lastDir != NULL) { - nativePath = Tcl_UtfToExternalDString(NULL, path, - lastDir - path, &ds); + nativePath = Tcl_UtfToExternalDString(NULL, path, + lastDir-path, &ds); if (Realpath(nativePath, normPath) != NULL) { nextCheckpoint = lastDir - path; goto wholeStringOk; } } } - /* Else do it the slow way */ + + /* + * Else do it the slow way. + */ #endif - + while (1) { cur = *currentPathEndPosition; if ((cur == '/') && (path != currentPathEndPosition)) { - /* Reached directory separator */ + /* + * Reached directory separator. + */ + Tcl_DString ds; CONST char *nativePath; int accessOk; - nativePath = Tcl_UtfToExternalDString(NULL, path, + nativePath = Tcl_UtfToExternalDString(NULL, path, currentPathEndPosition - path, &ds); accessOk = access(nativePath, F_OK); Tcl_DStringFree(&ds); + if (accessOk != 0) { - /* File doesn't exist */ + /* + * File doesn't exist. + */ + break; } - /* Update the acceptable point */ + + /* + * Update the acceptable point. + */ + nextCheckpoint = currentPathEndPosition - path; } else if (cur == 0) { - /* Reached end of string */ + /* + * Reached end of string. + */ + break; } currentPathEndPosition++; } - /* - * We should really now convert this to a canonical path. We do - * that with 'realpath' if we have it available. Otherwise we could - * step through every single path component, checking whether it is a - * symlink, but that would be a lot of work, and most modern OSes - * have 'realpath'. + + /* + * We should really now convert this to a canonical path. We do that with + * 'realpath' if we have it available. Otherwise we could step through + * every single path component, checking whether it is a symlink, but that + * would be a lot of work, and most modern OSes have 'realpath'. */ + #ifndef NO_REALPATH - /* - * If we only had '/foo' or '/' then we never increment nextCheckpoint - * and we don't need or want to go through 'Realpath'. Also, on some + /* + * If we only had '/foo' or '/' then we never increment nextCheckpoint and + * we don't need or want to go through 'Realpath'. Also, on some * platforms, passing an empty string to 'Realpath' will give us the * normalized pwd, which is not what we want at all! */ - if (nextCheckpoint == 0) return 0; - + + if (nextCheckpoint == 0) { + return 0; + } + nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { int newNormLen; - wholeStringOk: + + wholeStringOk: newNormLen = strlen(normPath); if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { - /* String is unchanged */ + /* + * String is unchanged. + */ + Tcl_DStringFree(&ds); + /* - * Enable this to have the native FS claim normalization of - * the whole path for existing files. That would permit the - * caller to declare normalization complete without calls to - * additional filesystems. Saving lots of calls is probably - * worth the extra access() time here. When no other FS's - * are registered though, things are less clear. + * Enable this to have the native FS claim normalization of the + * whole path for existing files. That would permit the caller to + * declare normalization complete without calls to additional + * filesystems. Saving lots of calls is probably worth the extra + * access() time here. When no other FS's are registered though, + * things are less clear. * if (0 == access(normPath, F_OK)) { return pathLen; } */ + return nextCheckpoint; } - - /* - * Free up the native path and put in its place the - * converted, normalized path. + + /* + * Free up the native path and put in its place the converted, + * normalized path. */ + Tcl_DStringFree(&ds); Tcl_ExternalToUtfDString(NULL, normPath, (int) newNormLen, &ds); if (path[nextCheckpoint] != '\0') { - /* not at end, append remaining path */ + /* + * Not at end, append remaining path. + */ + int normLen = Tcl_DStringLength(&ds); + Tcl_DStringAppend(&ds, path + nextCheckpoint, pathLen - nextCheckpoint); - /* - * We recognise up to and including the directory - * separator. - */ + + /* + * We recognise up to and including the directory separator. + */ + nextCheckpoint = normLen + 1; } else { - /* We recognise the whole string */ + /* + * We recognise the whole string. + */ + nextCheckpoint = Tcl_DStringLength(&ds); } - /* + + /* * Overwrite with the normalized path. */ + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } @@ -1898,41 +1939,41 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) * * GetReadOnlyAttribute * - * Gets the readonly attribute (user immutable flag) of a file. + * Gets the readonly attribute (user immutable flag) 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. + * 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. - * + * A new object is allocated. + * *---------------------------------------------------------------------- */ static int GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ + Tcl_Interp *interp; /* The interp we are using for errors. */ + int objIndex; /* The index of the attribute. */ + Tcl_Obj *fileName; /* The name of the file (UTF-8). */ + Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */ { Tcl_StatBuf statBuf; int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } return TCL_ERROR; } - *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags & UF_IMMUTABLE) != 0); - + *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0); + return TCL_OK; } @@ -1941,23 +1982,23 @@ GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr) * * SetReadOnlyAttribute * - * Sets the readonly attribute (user immutable flag) of a file. + * Sets the readonly attribute (user immutable flag) of a file. * * Results: - * Standard TCL result. + * Standard TCL result. * * Side effects: - * The readonly attribute of the file is changed. - * + * The readonly attribute of the file is changed. + * *--------------------------------------------------------------------------- */ static int SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) - Tcl_Interp *interp; /* The interp we are using for errors. */ - int objIndex; /* The index of the attribute. */ - Tcl_Obj *fileName; /* The name of the file (UTF-8). */ - Tcl_Obj *attributePtr; /* The attribute to set. */ + Tcl_Interp *interp; /* The interp we are using for errors. */ + int objIndex; /* The index of the attribute. */ + Tcl_Obj *fileName; /* The name of the file (UTF-8). */ + Tcl_Obj *attributePtr; /* The attribute to set. */ { Tcl_StatBuf statBuf; int result; @@ -1965,14 +2006,14 @@ SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) CONST char *native; if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", + Tcl_AppendResult(interp, "could not read \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1980,16 +2021,16 @@ SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) } if (readonly) { - statBuf.st_flags |= UF_IMMUTABLE; + statBuf.st_flags |= UF_IMMUTABLE; } else { - statBuf.st_flags &= ~UF_IMMUTABLE; + statBuf.st_flags &= ~UF_IMMUTABLE; } native = Tcl_FSGetNativePath(fileName); result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_AppendResult(interp, "could not set flags for file \"", + Tcl_AppendResult(interp, "could not set flags for file \"", Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), (char *) NULL); } @@ -1998,3 +2039,11 @@ SetReadOnlyAttribute(interp, objIndex, fileName, attributePtr) return TCL_OK; } #endif /* defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |