diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 1691 |
1 files changed, 735 insertions, 956 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index a96a81a..50e1921 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1,49 +1,55 @@ /* * 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. * - * 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. + * 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. - * 3. Neither the name of the University nor the names of its contributors may - * be used to endorse or promote products derived from this software + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software * without specific prior written permission. * - * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY - * EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY - * DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES - * (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * 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" +#include "tclPort.h" #include <utime.h> #include <grp.h> -#ifndef HAVE_STRUCT_STAT_ST_BLKSIZE +#ifndef HAVE_ST_BLKSIZE #ifndef NO_FSTATFS #include <sys/statfs.h> #endif @@ -57,112 +63,76 @@ * 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. */ -static int GetGroupAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); -static int GetOwnerAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); -static int GetPermissionsAttribute(Tcl_Interp *interp, +static int GetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, - Tcl_Obj **attributePtrPtr); -static int SetGroupAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj *attributePtr); -static int SetOwnerAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj *attributePtr); -static int SetPermissionsAttribute(Tcl_Interp *interp, + Tcl_Obj **attributePtrPtr)); +static int GetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, - Tcl_Obj *attributePtr); -static int GetModeFromPermString(Tcl_Interp *interp, - char *modeStringPtr, mode_t *modePtr); -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) -static int GetReadOnlyAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); -static int SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex, - Tcl_Obj *fileName, Tcl_Obj *attributePtr); -#endif + Tcl_Obj **attributePtrPtr)); +static int GetPermissionsAttribute _ANSI_ARGS_(( + Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)); +static int SetGroupAttribute _ANSI_ARGS_((Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj *attributePtr)); +static int SetOwnerAttribute _ANSI_ARGS_((Tcl_Interp *interp, + int objIndex, Tcl_Obj *fileName, + Tcl_Obj *attributePtr)); +static int SetPermissionsAttribute _ANSI_ARGS_(( + Tcl_Interp *interp, int objIndex, + Tcl_Obj *fileName, Tcl_Obj *attributePtr)); +static int GetModeFromPermString _ANSI_ARGS_(( + Tcl_Interp *interp, char *modeStringPtr, + mode_t *modePtr)); /* * Prototype for the TraverseUnixTree callback function. */ -typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, - CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); +typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr, + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, int type, + Tcl_DString *errorPtr)); /* * 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. - */ - -#ifdef DJGPP - -/* - * See contrib/djgpp/tclDjgppFCmd.c for definition. */ -extern TclFileAttrProcs tclpFileAttrProcs[]; -extern char *tclpFileAttrStrings[]; - -#else enum { - 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_RSRCLENGTH_ATTRIBUTE, -#endif - UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ + UNIX_GROUP_ATTRIBUTE, + UNIX_OWNER_ATTRIBUTE, + UNIX_PERMISSIONS_ATTRIBUTE }; -MODULE_SCOPE CONST char *tclpFileAttrStrings[]; CONST char *tclpFileAttrStrings[] = { - "-group", "-owner", "-permissions", -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - "-readonly", -#endif -#ifdef MAC_OSX_TCL - "-creator", "-type", "-hidden", "-rsrclength", -#endif - NULL + "-group", + "-owner", + "-permissions", + (char *) NULL }; -MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[]; CONST TclFileAttrProcs tclpFileAttrProcs[] = { - {GetGroupAttribute, SetGroupAttribute}, - {GetOwnerAttribute, SetOwnerAttribute}, - {GetPermissionsAttribute, SetPermissionsAttribute}, -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) - {GetReadOnlyAttribute, SetReadOnlyAttribute}, -#endif -#ifdef MAC_OSX_TCL - {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, - {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, - {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, - {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, -#endif + {GetGroupAttribute, SetGroupAttribute}, + {GetOwnerAttribute, SetOwnerAttribute}, + {GetPermissionsAttribute, SetPermissionsAttribute} }; -#endif /* * This is the maximum number of consecutive readdir/unlink calls that can be * made (with no intervening rewinddir or closedir/opendir) before triggering * a bug that makes readdir return NULL even though some directory entries - * have not been processed. The bug afflicts SunOS's readdir when applied to - * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the - * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We + * have not been processed. The bug afflicts SunOS's readdir when applied to + * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+. JH found the + * Darwin readdir to reset at 147, so 130 is chosen to be conservative. We * can't do a general rewind on failure as NFS can create special files that - * recreate themselves when you try and delete them. 8.4.8 added a solution + * recreate themselves when you try and delete them. 8.4.8 added a solution * that was affected by a single such NFS file, this solution should not be * affected by less than THRESHOLD such files. [Bug 1034337] */ @@ -173,38 +143,42 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = { * Declarations for local procedures defined in this file: */ -static int CopyFileAtts(CONST char *src, - CONST char *dst, CONST Tcl_StatBuf *statBufPtr); -static int DoCopyFile(CONST char *srcPtr, CONST char *dstPtr, - CONST Tcl_StatBuf *statBufPtr); -static int DoCreateDirectory(CONST char *pathPtr); -static int DoRemoveDirectory(Tcl_DString *pathPtr, - int recursive, Tcl_DString *errorPtr); -static int DoRenameFile(CONST char *src, CONST char *dst); -static int TraversalCopy(Tcl_DString *srcPtr, +static int CopyFile _ANSI_ARGS_((CONST char *src, + CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); +static int CopyFileAtts _ANSI_ARGS_((CONST char *src, + CONST char *dst, CONST Tcl_StatBuf *statBufPtr)); +static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr, + CONST char *dstPtr, CONST Tcl_StatBuf *statBufPtr)); +static int DoCreateDirectory _ANSI_ARGS_((CONST char *pathPtr)); +static int DoRemoveDirectory _ANSI_ARGS_((Tcl_DString *pathPtr, + int recursive, Tcl_DString *errorPtr)); +static int DoRenameFile _ANSI_ARGS_((CONST char *src, + CONST char *dst)); +static int TraversalCopy _ANSI_ARGS_((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, - int type, Tcl_DString *errorPtr); -static int TraversalDelete(Tcl_DString *srcPtr, + int type, Tcl_DString *errorPtr)); +static int TraversalDelete _ANSI_ARGS_((Tcl_DString *srcPtr, Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, - int type, Tcl_DString *errorPtr); -static int TraverseUnixTree(TraversalProc *traversalProc, + int type, Tcl_DString *errorPtr)); +static int TraverseUnixTree _ANSI_ARGS_(( + TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, - Tcl_DString *errorPtr, int doRewind); + Tcl_DString *errorPtr, int doRewind)); #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(CONST char *path, char *resolved); +static char * Realpath _ANSI_ARGS_((CONST char *path, + char *resolved)); char * -Realpath( - CONST char *path, - char *resolved) +Realpath(path, resolved) + CONST char *path; + char *resolved; { memset(resolved, 0, MAXPATHLEN); return realpath(path, resolved); @@ -218,12 +192,11 @@ Realpath( defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* - * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we - * might potentially be running on pre-10.3 OSX, check Darwin release at - * runtime before using realpath. + * prior to Darwin 7, realpath is not threadsafe, c.f. bug 711232; + * if we might potentially be running on pre-10.3 OSX, + * check Darwin release at runtime before using realpath. */ - -MODULE_SCOPE long tclMacOSXDarwinRelease; +extern long tclMacOSXDarwinRelease; #define haveRealpath (tclMacOSXDarwinRelease >= 7) #else #define haveRealpath 1 @@ -238,66 +211,67 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 /* - * Prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a + * prior to Darwin 9, 64bit fts_open() without FTS_NOSTAT may crash (due to a * 64bit-unsafe ALIGN macro); if we could be running on pre-10.5 OSX, check * Darwin release at runtime and do a separate stat() if necessary. */ - -MODULE_SCOPE long tclMacOSXDarwinRelease; +extern long tclMacOSXDarwinRelease; #define noFtsStat (tclMacOSXDarwinRelease < 9) #else #define noFtsStat 0 #endif #endif /* HAVE_FTS */ + /* *--------------------------------------------------------------------------- * * 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 -TclpObjRenameFile( - Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr) +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 -DoRenameFile( - CONST char *src, /* Pathname of file or dir to be renamed +DoRenameFile(src, dst) + CONST char *src; /* Pathname of file or dir to be renamed * (native). */ - CONST char *dst) /* New pathname of file or directory + CONST char *dst; /* New pathname of file or directory * (native). */ { if (rename(src, dst) == 0) { /* INTL: Native. */ @@ -308,21 +282,21 @@ DoRenameFile( } /* - * 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 && haveRealpath) { @@ -331,12 +305,12 @@ DoRenameFile( 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; } @@ -359,15 +333,15 @@ DoRenameFile( * 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; @@ -378,32 +352,32 @@ DoRenameFile( * * 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 "". + * 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 -TclpObjCopyFile( - Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr) +int +TclpObjCopyFile(srcPathPtr, destPathPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; { CONST char *src = Tcl_FSGetNativePath(srcPathPtr); Tcl_StatBuf srcStatBuf; @@ -416,11 +390,11 @@ TclpObjCopyFile( } static int -DoCopyFile( - CONST char *src, /* Pathname of file to be copied (native). */ - CONST char *dst, /* Pathname of file to copy to (native). */ - CONST Tcl_StatBuf *statBufPtr) - /* Used to determine filetype. */ +DoCopyFile(src, dst, statBufPtr) + CONST char *src; /* Pathname of file to be copied (native). */ + CONST char *dst; /* Pathname of file to copy to (native). */ + CONST Tcl_StatBuf *statBufPtr; + /* Used to determine filetype. */ { Tcl_StatBuf dstStatBuf; @@ -430,10 +404,10 @@ DoCopyFile( } /* - * 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; @@ -443,43 +417,49 @@ DoCopyFile( if (unlink(dst) != 0) { /* INTL: Native. */ if (errno != ENOENT) { return TCL_ERROR; - } + } } switch ((int) (statBufPtr->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; - } -#ifdef MAC_OSX_TCL - TclMacOSXCopyFileAttributes(src, dst, statBufPtr); + 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; + } +#ifdef HAVE_COPYFILE +#ifdef WEAK_IMPORT_COPYFILE + if (copyfile != NULL) #endif - break; - } + copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_NOFOLLOW_SRC); #endif - case S_IFBLK: - case S_IFCHR: - if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ - statBufPtr->st_rdev) < 0) { - return TCL_ERROR; + break; } - return CopyFileAtts(src, dst, statBufPtr); - case S_IFIFO: - if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ - return TCL_ERROR; +#endif + case S_IFBLK: + case S_IFCHR: { + if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ + statBufPtr->st_rdev) < 0) { + return TCL_ERROR; + } + return CopyFileAtts(src, dst, statBufPtr); + } + case S_IFIFO: { + if (mkfifo(dst, statBufPtr->st_mode) < 0) { /* INTL: Native. */ + return TCL_ERROR; + } + return CopyFileAtts(src, dst, statBufPtr); + } + default: { + return CopyFile(src, dst, statBufPtr); } - return CopyFileAtts(src, dst, statBufPtr); - default: - return TclUnixCopyFile(src, dst, statBufPtr, 0); } return TCL_OK; } @@ -487,91 +467,79 @@ DoCopyFile( /* *---------------------------------------------------------------------- * - * TclUnixCopyFile - + * CopyFile - * - * 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( - CONST char *src, /* Pathname of file to copy (native). */ - CONST char *dst, /* Pathname of file to create/overwrite +static int +CopyFile(src, dst, statBufPtr) + CONST char *src; /* Pathname of file to copy (native). */ + CONST char *dst; /* Pathname of file to create/overwrite * (native). */ - CONST Tcl_StatBuf *statBufPtr, + CONST Tcl_StatBuf *statBufPtr; /* Used to determine mode and blocksize. */ - int dontCopyAtts) /* If flag set, don't copy attributes. */ { - int srcFd, dstFd; + int srcFd; + int dstFd; unsigned blockSize; /* Optimal I/O blocksize for filesystem */ char *buffer; /* Data buffer for copy */ size_t nread; -#ifdef DJGPP -#define BINMODE |O_BINARY -#else -#define BINMODE -#endif - - if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */ + if ((srcFd = TclOSopen(src, O_RDONLY, 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, /* 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_STRUCT_STAT_ST_BLKSIZE +#ifdef HAVE_ST_BLKSIZE blockSize = statBufPtr->st_blksize; -#elif !defined(NO_FSTATFS) +#else +#ifndef NO_FSTATFS { struct statfs fs; - - if (fstatfs(srcFd, &fs) == 0) { + if (fstatfs(srcFd, &fs, sizeof(fs), 0) == 0) { blockSize = fs.f_bsize; } else { blockSize = 4096; } } -#else +#else blockSize = 4096; -#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */ +#endif +#endif - /* - * [SF Tcl Bug 1586470] Even if we HAVE_STRUCT_STAT_ST_BLKSIZE, there are - * filesystems which report a bogus value for the blocksize. An example - * is the Andrew Filesystem (afs), reporting a blocksize of 0. When - * detecting such a situation we now simply fall back to a hardwired - * default size. + /* [SF Tcl Bug 1586470] Even if we HAVE_ST_BLKSIZE, there are + * filesystems which report a bogus value for the blocksize. An + * example is the Andrew Filesystem (afs), reporting a blocksize + * of 0. When detecting such a situation we now simply fall back + * to a hardwired default size. */ if (blockSize <= 0) { - blockSize = 4096; + blockSize = 4096; } buffer = ckalloc(blockSize); while (1) { - nread = (size_t) read(srcFd, buffer, blockSize); + nread = read(srcFd, buffer, blockSize); if ((nread == (size_t) -1) || (nread == 0)) { break; } - if ((size_t) write(dstFd, buffer, nread) != nread) { + if (write(dstFd, buffer, nread) != (int)nread) { nread = (size_t) -1; break; } @@ -583,10 +551,11 @@ TclUnixCopyFile( unlink(dst); /* INTL: Native. */ return TCL_ERROR; } - if (!dontCopyAtts && CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) { + if (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. */ @@ -600,33 +569,33 @@ TclUnixCopyFile( * * 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 -TclpObjDeleteFile( - Tcl_Obj *pathPtr) +int +TclpObjDeleteFile(pathPtr) + Tcl_Obj *pathPtr; { return TclpDeleteFile(Tcl_FSGetNativePath(pathPtr)); } int -TclpDeleteFile( - CONST char *path) /* Pathname of file to be removed (native). */ +TclpDeleteFile(path) + CONST char *path; /* Pathname of file to be removed (native). */ { if (unlink(path) != 0) { /* INTL: Native. */ return TCL_ERROR; @@ -639,37 +608,37 @@ TclpDeleteFile( * * 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 -TclpObjCreateDirectory( - Tcl_Obj *pathPtr) +int +TclpObjCreateDirectory(pathPtr) + Tcl_Obj *pathPtr; { return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int -DoCreateDirectory( - CONST char *path) /* Pathname of directory to create (native). */ +DoCreateDirectory(path) + CONST char *path; /* Pathname of directory to create (native). */ { mode_t mode; @@ -693,47 +662,49 @@ DoCreateDirectory( * * 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 -TclpObjCopyDirectory( - Tcl_Obj *srcPathPtr, - Tcl_Obj *destPathPtr, - Tcl_Obj **errorPtr) +int +TclpObjCopyDirectory(srcPathPtr, destPathPtr, errorPtr) + Tcl_Obj *srcPathPtr; + Tcl_Obj *destPathPtr; + Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_DString srcString, dstString; int ret; Tcl_Obj *transPtr; - + transPtr = Tcl_FSGetTranslatedPath(NULL,srcPathPtr); - Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? TclGetString(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 ? TclGetString(transPtr) : NULL), - -1, &dstString); + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + -1, &dstString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -750,6 +721,7 @@ TclpObjCopyDirectory( } return ret; } + /* *--------------------------------------------------------------------------- @@ -759,38 +731,38 @@ TclpObjCopyDirectory( * 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 -TclpObjRemoveDirectory( - Tcl_Obj *pathPtr, - int recursive, - Tcl_Obj **errorPtr) + +int +TclpObjRemoveDirectory(pathPtr, recursive, errorPtr) + Tcl_Obj *pathPtr; + int recursive; + Tcl_Obj **errorPtr; { Tcl_DString ds; Tcl_DString pathString; int ret; Tcl_Obj *transPtr = Tcl_FSGetTranslatedPath(NULL, pathPtr); - Tcl_UtfToExternalDString(NULL, - (transPtr != NULL ? TclGetString(transPtr) : NULL), - -1, &pathString); + Tcl_UtfToExternalDString(NULL, + (transPtr != NULL ? Tcl_GetString(transPtr) : NULL), + -1, &pathString); if (transPtr != NULL) { Tcl_DecrRefCount(transPtr); } @@ -806,38 +778,35 @@ TclpObjRemoveDirectory( } static int -DoRemoveDirectory( - Tcl_DString *pathPtr, /* Pathname of directory to be removed +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; } @@ -852,22 +821,19 @@ DoRemoveDirectory( } 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; } @@ -877,41 +843,40 @@ DoRemoveDirectory( * * 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 -TraverseUnixTree( - TraversalProc *traverseProc,/* Function to call for every file and +static int +TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind) + TraversalProc *traverseProc;/* Function to call for every file and * directory in source hierarchy. */ - Tcl_DString *sourcePtr, /* Pathname of source directory to be + Tcl_DString *sourcePtr; /* Pathname of source directory to be * traversed (native). */ - Tcl_DString *targetPtr, /* Pathname of directory to traverse in + 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. */ - int doRewind) /* Flag indicating that to ensure complete + 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; @@ -947,7 +912,7 @@ TraverseUnixTree( #ifndef HAVE_FTS dirPtr = opendir(source); /* INTL: Native. */ if (dirPtr == NULL) { - /* + /* * Can't read directory */ @@ -1003,10 +968,9 @@ TraverseUnixTree( if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) { /* * Call rewinddir if we've called unlink or rmdir so many times - * (since the opendir or the previous rewinddir), to avoid a - * NULL-return that may a symptom of a buggy readdir. + * (since the opendir or the previous rewinddir), to avoid + * a NULL-return that may a symptom of a buggy readdir. */ - rewinddir(dirPtr); numProcessed = 0; } @@ -1024,8 +988,8 @@ TraverseUnixTree( 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, @@ -1034,7 +998,7 @@ TraverseUnixTree( #else /* HAVE_FTS */ paths[0] = source; fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR | - (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); + (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); if (fts == NULL) { errfile = source; goto end; @@ -1047,7 +1011,7 @@ TraverseUnixTree( while ((ent = fts_read(fts)) != NULL) { unsigned short info = ent->fts_info; - char *path = ent->fts_path + sourceLen; + char * path = ent->fts_path + sourceLen; unsigned short pathlen = ent->fts_pathlen - sourceLen; int type; Tcl_StatBuf *statBufPtr = NULL; @@ -1061,15 +1025,15 @@ TraverseUnixTree( Tcl_DStringAppend(targetPtr, path, pathlen); } switch (info) { - case FTS_D: - type = DOTREE_PRED; - break; - case FTS_DP: - type = DOTREE_POSTD; - break; - default: - type = DOTREE_F; - break; + case FTS_D: + type = DOTREE_PRED; + break; + case FTS_DP: + type = DOTREE_POSTD; + break; + default: + type = DOTREE_F; + break; } if (!doRewind) { /* no need to stat for delete */ if (noFtsStat) { @@ -1079,7 +1043,7 @@ TraverseUnixTree( break; } } else { - statBufPtr = (Tcl_StatBuf *) ent->fts_statp; + statBufPtr = ent->fts_statp; } } result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, @@ -1094,7 +1058,7 @@ TraverseUnixTree( } #endif /* HAVE_FTS */ - end: + end: if (errfile != NULL) { if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); @@ -1105,7 +1069,7 @@ TraverseUnixTree( if (fts != NULL) { fts_close(fts); } -#endif +#endif /* HAVE_FTS */ return result; } @@ -1115,55 +1079,56 @@ TraverseUnixTree( * * 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( - Tcl_DString *srcPtr, /* Source pathname to copy (native). */ - Tcl_DString *dstPtr, /* Destination pathname of copy (native). */ - CONST Tcl_StatBuf *statBufPtr, +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), - statBufPtr) == TCL_OK) { - return TCL_OK; - } - break; + case DOTREE_F: + if (DoCopyFile(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_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; - 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) { @@ -1178,44 +1143,47 @@ TraversalCopy( * * 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( - Tcl_DString *srcPtr, /* Source pathname (native). */ - Tcl_DString *ignore, /* Destination pathname (not used). */ - CONST Tcl_StatBuf *statBufPtr, +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; + case DOTREE_F: { + if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { + return TCL_OK; + } + break; } - break; - case DOTREE_PRED: - return TCL_OK; - case DOTREE_POSTD: - if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { + case DOTREE_PRED: { return TCL_OK; } - break; + case DOTREE_POSTD: { + if (DoRemoveDirectory(srcPtr, 0, NULL) == 0) { + return TCL_OK; + } + break; + } } if (errorPtr != NULL) { Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(srcPtr), @@ -1229,40 +1197,42 @@ TraversalDelete( * * 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( - CONST char *src, /* Path name of source file (native). */ - CONST char *dst, /* Path name of target file (native). */ - CONST Tcl_StatBuf *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; /* Stat info for source file */ { struct utimbuf tval; mode_t newMode; - + newMode = statBufPtr->st_mode & (S_ISUID | S_ISGID | S_IRWXU | S_IRWXG | S_IRWXO); - - /* - * Note that if you copy a setuid file that is owned by someone else, and - * you are not root, then the copy will be setuid to you. The most correct - * implementation would probably be to have the copy not setuid to anyone - * if the original file was owned by someone else, but this corner case - * isn't currently handled. It would require another lstat(), or getuid(). + + /* + * 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. */ @@ -1270,69 +1240,72 @@ CopyFileAtts( } } - 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; } -#ifdef MAC_OSX_TCL - TclMacOSXCopyFileAttributes(src, dst, statBufPtr); +#ifdef HAVE_COPYFILE +#ifdef WEAK_IMPORT_COPYFILE + if (copyfile != NULL) +#endif + copyfile(src, dst, NULL, COPYFILE_XATTR|COPYFILE_ACL); #endif return TCL_OK; } + /* *---------------------------------------------------------------------- * * 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. + * *---------------------------------------------------------------------- */ static int -GetGroupAttribute( - 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. */ +GetGroupAttribute(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_StatBuf statBuf; struct group *groupPtr; int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - TclGetString(fileName), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } groupPtr = TclpGetGrGid(statBuf.st_gid); - if (groupPtr == NULL) { + if (result == -1 || groupPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); } else { 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); } + endgrent(); return TCL_OK; } @@ -1341,52 +1314,51 @@ GetGroupAttribute( * * 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. + * *---------------------------------------------------------------------- */ static int -GetOwnerAttribute( - 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. */ +GetOwnerAttribute(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_StatBuf statBuf; struct passwd *pwPtr; int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - TclGetString(fileName), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } pwPtr = TclpGetPwUid(statBuf.st_uid); - if (pwPtr == NULL) { + if (result == -1 || pwPtr == NULL) { *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); } else { 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); } + endpwent(); return TCL_OK; } @@ -1395,41 +1367,42 @@ GetOwnerAttribute( * * 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. + * *---------------------------------------------------------------------- */ static int -GetPermissionsAttribute( - 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. */ +GetPermissionsAttribute(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_StatBuf statBuf; + char returnString[7]; int result; result = TclpObjStat(fileName, &statBuf); - + if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - TclGetString(fileName), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } - *attributePtrPtr = Tcl_ObjPrintf( - "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); + sprintf(returnString, "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); + + *attributePtrPtr = Tcl_NewStringObj(returnString, -1); + return TCL_OK; } @@ -1438,23 +1411,23 @@ GetPermissionsAttribute( * * 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( - 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. */ +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. */ { long gid; int result; @@ -1462,22 +1435,21 @@ SetGroupAttribute( if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; - struct group *groupPtr = NULL; + struct group *groupPtr; CONST char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not set group for file \"", - TclGetString(fileName), "\": group \"", string, - "\" does not exist", NULL); - } + endgrent(); + Tcl_AppendResult(interp, "could not set group for file \"", + Tcl_GetString(fileName), "\": group \"", + string, "\" does not exist", + (char *) NULL); return TCL_ERROR; } gid = groupPtr->gr_gid; @@ -1486,14 +1458,13 @@ SetGroupAttribute( native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ + endgrent(); if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not set group for file \"", - TclGetString(fileName), "\": ", Tcl_PosixError(interp), - NULL); - } + Tcl_AppendResult(interp, "could not set group for file \"", + Tcl_GetString(fileName), "\": ", Tcl_PosixError(interp), + (char *) NULL); return TCL_ERROR; - } + } return TCL_OK; } @@ -1502,23 +1473,23 @@ SetGroupAttribute( * * 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( - 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. */ +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. */ { long uid; int result; @@ -1526,36 +1497,34 @@ SetOwnerAttribute( if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; - struct passwd *pwPtr = NULL; + struct passwd *pwPtr; CONST char *string; int length; string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, length, &ds); - pwPtr = TclpGetPwNam(native); /* INTL: Native. */ + pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not set owner for file \"", - TclGetString(fileName), "\": user \"", string, - "\" does not exist", NULL); - } + endpwent(); + Tcl_AppendResult(interp, "could not set owner for file \"", + Tcl_GetString(fileName), "\": user \"", + string, "\" does not exist", + (char *) NULL); return TCL_ERROR; } uid = pwPtr->pw_uid; } native = Tcl_FSGetNativePath(fileName); - result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ - + result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ + + endpwent(); if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not set owner for file \"", - TclGetString(fileName), "\": ", Tcl_PosixError(interp), - NULL); - } + Tcl_AppendResult(interp, "could not set owner for file \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; @@ -1566,75 +1535,57 @@ SetOwnerAttribute( * * 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( - 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. */ +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. */ { long mode; mode_t newMode; - int result = TCL_ERROR; + int result; CONST char *native; - char *modeStringPtr = TclGetString(attributePtr); - int scanned = TclParseAllWhiteSpace(modeStringPtr, -1); /* - * First supply support for octal number format + * First try if the string is a number */ - - if ((modeStringPtr[scanned] == '0') - && (modeStringPtr[scanned+1] >= '0') - && (modeStringPtr[scanned+1] <= '7')) { - /* Leading zero - attempt octal interpretation */ - Tcl_Obj *modeObj; - - TclNewLiteralStringObj(modeObj, "0o"); - Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); - result = Tcl_GetLongFromObj(NULL, modeObj, &mode); - Tcl_DecrRefCount(modeObj); - } - if (result == TCL_OK - || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { - newMode = (mode_t) (mode & 0x00007FFF); + if (Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { + newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; + char *modeStringPtr = Tcl_GetString(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 \"", - TclGetString(fileName), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_AppendResult(interp, "could not read \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } newMode = (mode_t) (buf.st_mode & 0x00007FFF); if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { - if (interp != NULL) { - Tcl_AppendResult(interp, "unknown permission string format \"", - modeStringPtr, "\"", NULL); - } + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "unknown permission string format \"", + modeStringPtr, "\"", (char *) NULL); return TCL_ERROR; } } @@ -1642,17 +1593,15 @@ SetPermissionsAttribute( native = Tcl_FSGetNativePath(fileName); result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not set permissions for file \"", - TclGetString(fileName), "\": ", - Tcl_PosixError(interp), NULL); - } + Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), + "could not set permissions for file \"", + Tcl_GetString(fileName), "\": ", + Tcl_PosixError(interp), (char *) NULL); return TCL_ERROR; } return TCL_OK; } -#ifndef DJGPP /* *--------------------------------------------------------------------------- * @@ -1669,24 +1618,23 @@ SetPermissionsAttribute( *--------------------------------------------------------------------------- */ -Tcl_Obj * +Tcl_Obj* TclpObjListVolumes(void) { - Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1); + Tcl_Obj *resultPtr = Tcl_NewStringObj("/",1); Tcl_IncrRefCount(resultPtr); return resultPtr; } -#endif /* *---------------------------------------------------------------------- * * 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. @@ -1698,85 +1646,84 @@ TclpObjListVolumes(void) */ static int -GetModeFromPermString( - Tcl_Interp *interp, /* The interp we are using for errors. */ - char *modeStringPtr, /* Permissions string */ - mode_t *modePtr) /* pointer to the mode value */ +GetModeFromPermString(interp, modeStringPtr, modePtr) + Tcl_Interp *interp; /* The interp we are using for errors. */ + char *modeStringPtr; /* Permissions string */ + 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) { + 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; - } - 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 */ @@ -1788,18 +1735,18 @@ GetModeFromPermString( 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; @@ -1809,43 +1756,43 @@ GetModeFromPermString( 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; + 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; - continue; - case 'x': - what |= 0x49; - continue; - case 's': - what |= 0xc00; - continue; - case 't': - what |= 0x200; - continue; - case ',': - break; - default: - return TCL_ERROR; + 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++; @@ -1853,15 +1800,15 @@ GetModeFromPermString( } } 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; @@ -1872,26 +1819,26 @@ GetModeFromPermString( * * 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( - Tcl_Interp *interp, - Tcl_Obj *pathPtr, - int nextCheckpoint) +TclpObjNormalizePath(interp, pathPtr, nextCheckpoint) + Tcl_Interp *interp; + Tcl_Obj *pathPtr; + int nextCheckpoint; { char *currentPathEndPosition; int pathLen; @@ -1900,31 +1847,25 @@ TclpObjNormalizePath( #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 && haveRealpath) { - 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) { if (*nativePath != '/' && *normPath == '/') { /* @@ -1939,136 +1880,89 @@ TclpObjNormalizePath( Tcl_DStringFree(&ds); } } - - /* - * 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 (haveRealpath) { - /* + /* * 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 + * 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. - * - if (0 == access(normPath, F_OK)) { - return pathLen; + if (path[nextCheckpoint] != '\0') { + nextCheckpoint++; } - */ - 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)); } @@ -2078,118 +1972,3 @@ TclpObjNormalizePath( return nextCheckpoint; } - -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) -/* - *---------------------------------------------------------------------- - * - * GetReadOnlyAttribute - * - * 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. - * - * Side effects: - * A new object is allocated. - * - *---------------------------------------------------------------------- - */ - -static int -GetReadOnlyAttribute( - 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 \"", - TclGetString(fileName), "\": ", Tcl_PosixError(interp), - NULL); - } - return TCL_ERROR; - } - - *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0); - - return TCL_OK; -} - -/* - *--------------------------------------------------------------------------- - * - * SetReadOnlyAttribute - * - * Sets the readonly attribute (user immutable flag) of a file. - * - * Results: - * Standard TCL result. - * - * Side effects: - * The readonly attribute of the file is changed. - * - *--------------------------------------------------------------------------- - */ - -static int -SetReadOnlyAttribute( - 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; - int readonly; - CONST char *native; - - if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) { - return TCL_ERROR; - } - - result = TclpObjStat(fileName, &statBuf); - - if (result != 0) { - if (interp != NULL) { - Tcl_AppendResult(interp, "could not read \"", - TclGetString(fileName), "\": ", Tcl_PosixError(interp), - NULL); - } - return TCL_ERROR; - } - - if (readonly) { - statBuf.st_flags |= UF_IMMUTABLE; - } else { - 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 \"", - TclGetString(fileName), "\": ", Tcl_PosixError(interp), - NULL); - } - return TCL_ERROR; - } - return TCL_OK; -} -#endif /* defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) */ - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |