summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFCmd.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-07-20 23:16:00 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-07-20 23:16:00 (GMT)
commit04b1bffa1cc7b07cafdb83dd3f39c271f6493f7b (patch)
treeb2177cb66852e3b087e693c873f7ec770bb087f2 /unix/tclUnixFCmd.c
parent393e4ad337bfb7cbc972d974b4e9e2218e583738 (diff)
downloadtcl-04b1bffa1cc7b07cafdb83dd3f39c271f6493f7b.zip
tcl-04b1bffa1cc7b07cafdb83dd3f39c271f6493f7b.tar.gz
tcl-04b1bffa1cc7b07cafdb83dd3f39c271f6493f7b.tar.bz2
Getting more systematic about style
Diffstat (limited to 'unix/tclUnixFCmd.c')
-rw-r--r--unix/tclUnixFCmd.c1187
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:
+ */