diff options
Diffstat (limited to 'unix/tclUnixFCmd.c')
| -rw-r--r-- | unix/tclUnixFCmd.c | 944 |
1 files changed, 277 insertions, 667 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index cc8af05..b5450b1 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -1,11 +1,11 @@ /* * tclUnixFCmd.c * - * This file implements the Unix specific portion of file manipulation + * 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 © 1996-1998 Sun Microsystems, Inc. + * 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. @@ -13,7 +13,7 @@ * Portions of this code were derived from NetBSD source code which has the * following copyright notice: * - * Copyright © 1988, 1993, 1994 + * 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 @@ -47,7 +47,7 @@ #ifndef NO_FSTATFS #include <sys/statfs.h> #endif -#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */ +#endif #ifdef HAVE_FTS #include <fts.h> #endif @@ -62,16 +62,6 @@ #define DOTREE_F 3 /* regular file */ /* - * Fallback temporary file location the temporary file generation code. Can be - * overridden at compile time for when it is known that temp files can't be - * written to /tmp (hello, iOS!). - */ - -#ifndef TCL_TEMPORARY_FILE_DIRECTORY -#define TCL_TEMPORARY_FILE_DIRECTORY "/tmp" -#endif - -/* * Callbacks for file attributes code. */ @@ -90,11 +80,11 @@ static int SetPermissionsAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); static int GetModeFromPermString(Tcl_Interp *interp, - const char *modeStringPtr, mode_t *modePtr); -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) -static int GetUnixFileAttributes(Tcl_Interp *interp, int objIndex, + 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 SetUnixFileAttributes(Tcl_Interp *interp, int objIndex, +static int SetReadOnlyAttribute(Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); #endif @@ -103,7 +93,7 @@ static int SetUnixFileAttributes(Tcl_Interp *interp, int objIndex, */ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, - const Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); + CONST Tcl_StatBuf *statBufPtr, int type, Tcl_DString *errorPtr); /* * Constants and variables necessary for file attributes subcommand. @@ -113,66 +103,47 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr, * elsewhere in Tcl's core. */ -#ifndef DJGPP +#ifdef DJGPP +/* + * See contrib/djgpp/tclDjgppFCmd.c for definition. + */ + +extern TclFileAttrProcs tclpFileAttrProcs[]; +extern char *tclpFileAttrStrings[]; + +#else enum { -#if defined(__CYGWIN__) - UNIX_ARCHIVE_ATTRIBUTE, -#endif - UNIX_GROUP_ATTRIBUTE, -#if defined(__CYGWIN__) - UNIX_HIDDEN_ATTRIBUTE, -#endif - UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) + UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE, +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) UNIX_READONLY_ATTRIBUTE, #endif -#if defined(__CYGWIN__) - UNIX_SYSTEM_ATTRIBUTE, -#endif #ifdef MAC_OSX_TCL MACOSX_CREATOR_ATTRIBUTE, MACOSX_TYPE_ATTRIBUTE, MACOSX_HIDDEN_ATTRIBUTE, MACOSX_RSRCLENGTH_ATTRIBUTE, #endif - UNIX_INVALID_ATTRIBUTE + UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */ }; -const char *const tclpFileAttrStrings[] = { -#if defined(__CYGWIN__) - "-archive", -#endif - "-group", -#if defined(__CYGWIN__) - "-hidden", -#endif - "-owner", "-permissions", -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) +MODULE_SCOPE CONST char *tclpFileAttrStrings[]; +CONST char *tclpFileAttrStrings[] = { + "-group", "-owner", "-permissions", +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) "-readonly", #endif -#if defined(__CYGWIN__) - "-system", -#endif #ifdef MAC_OSX_TCL "-creator", "-type", "-hidden", "-rsrclength", #endif NULL }; -const TclFileAttrProcs tclpFileAttrProcs[] = { -#if defined(__CYGWIN__) - {GetUnixFileAttributes, SetUnixFileAttributes}, -#endif +MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[]; +CONST TclFileAttrProcs tclpFileAttrProcs[] = { {GetGroupAttribute, SetGroupAttribute}, -#if defined(__CYGWIN__) - {GetUnixFileAttributes, SetUnixFileAttributes}, -#endif {GetOwnerAttribute, SetOwnerAttribute}, {GetPermissionsAttribute, SetPermissionsAttribute}, -#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) || defined(__CYGWIN__) - {GetUnixFileAttributes, SetUnixFileAttributes}, -#endif -#if defined(__CYGWIN__) - {GetUnixFileAttributes, SetUnixFileAttributes}, +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) + {GetReadOnlyAttribute, SetReadOnlyAttribute}, #endif #ifdef MAC_OSX_TCL {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, @@ -181,7 +152,7 @@ const TclFileAttrProcs tclpFileAttrProcs[] = { {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute}, #endif }; -#endif /* DJGPP */ +#endif /* * This is the maximum number of consecutive readdir/unlink calls that can be @@ -202,23 +173,20 @@ 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 const char * DefaultTempDir(void); -static int DoCopyFile(const char *srcPtr, const char *dstPtr, - const Tcl_StatBuf *statBufPtr); -static int DoCreateDirectory(const char *pathPtr); +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 DoRenameFile(CONST char *src, CONST char *dst); static int TraversalCopy(Tcl_DString *srcPtr, - Tcl_DString *dstPtr, - const Tcl_StatBuf *statBufPtr, int type, - Tcl_DString *errorPtr); + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, + int type, Tcl_DString *errorPtr); static int TraversalDelete(Tcl_DString *srcPtr, - Tcl_DString *dstPtr, - const Tcl_StatBuf *statBufPtr, int type, - Tcl_DString *errorPtr); + Tcl_DString *dstPtr, CONST Tcl_StatBuf *statBufPtr, + int type, Tcl_DString *errorPtr); static int TraverseUnixTree(TraversalProc *traversalProc, Tcl_DString *sourcePtr, Tcl_DString *destPtr, Tcl_DString *errorPtr, int doRewind); @@ -231,22 +199,22 @@ static int TraverseUnixTree(TraversalProc *traversalProc, * passing the standard MAXPATHLEN size resolved arg. */ -static char * Realpath(const char *path, char *resolved); +static char * Realpath(CONST char *path, char *resolved); char * Realpath( - const char *path, + CONST char *path, char *resolved) { memset(resolved, 0, MAXPATHLEN); return realpath(path, resolved); } #else -# define Realpath realpath -#endif /* PURIFY */ +#define Realpath realpath +#endif #ifndef NO_REALPATH -#if defined(__APPLE__) && TCL_THREADS && \ +#if defined(__APPLE__) && defined(TCL_THREADS) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1030 /* @@ -256,16 +224,16 @@ Realpath( */ MODULE_SCOPE long tclMacOSXDarwinRelease; -# define haveRealpath (tclMacOSXDarwinRelease >= 7) +#define haveRealpath (tclMacOSXDarwinRelease >= 7) #else -# define haveRealpath 1 +#define haveRealpath 1 #endif #endif /* NO_REALPATH */ #ifdef HAVE_FTS #if defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__) /* fts doesn't do stat64 */ -# define noFtsStat 1 +#define noFtsStat 1 #elif defined(__APPLE__) && defined(__LP64__) && \ defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \ MAC_OS_X_VERSION_MIN_REQUIRED < 1050 @@ -276,9 +244,9 @@ MODULE_SCOPE long tclMacOSXDarwinRelease; */ MODULE_SCOPE long tclMacOSXDarwinRelease; -# define noFtsStat (tclMacOSXDarwinRelease < 9) +#define noFtsStat (tclMacOSXDarwinRelease < 9) #else -# define noFtsStat 0 +#define noFtsStat 0 #endif #endif /* HAVE_FTS */ @@ -321,15 +289,15 @@ TclpObjRenameFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - return DoRenameFile((const char *)Tcl_FSGetNativePath(srcPathPtr), - (const char *)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 + 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. */ @@ -340,7 +308,7 @@ DoRenameFile( } /* - * IRIX returns EIO when you attempt to move a directory into itself. We + * 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. */ @@ -359,13 +327,13 @@ DoRenameFile( if (errno == EINVAL && haveRealpath) { char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; - TclDIR *dirPtr; + DIR *dirPtr; Tcl_DirEntry *dirEntPtr; if ((Realpath((char *) src, srcPath) != NULL) /* INTL: Native. */ && (Realpath((char *) dst, dstPath) != NULL) /* INTL: Native */ && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) { - dirPtr = TclOSopendir(dst); /* INTL: Native. */ + dirPtr = opendir(dst); /* INTL: Native. */ if (dirPtr != NULL) { while (1) { dirEntPtr = TclOSreaddir(dirPtr); /* INTL: Native. */ @@ -375,11 +343,11 @@ DoRenameFile( if ((strcmp(dirEntPtr->d_name, ".") != 0) && (strcmp(dirEntPtr->d_name, "..") != 0)) { errno = EEXIST; - TclOSclosedir(dirPtr); + closedir(dirPtr); return TCL_ERROR; } } - TclOSclosedir(dirPtr); + closedir(dirPtr); } } errno = EINVAL; @@ -437,21 +405,21 @@ TclpObjCopyFile( Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr) { - const char *src = (const char *)Tcl_FSGetNativePath(srcPathPtr); + CONST char *src = Tcl_FSGetNativePath(srcPathPtr); Tcl_StatBuf srcStatBuf; if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */ return TCL_ERROR; } - return DoCopyFile(src, (const char *)Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); + return DoCopyFile(src, Tcl_FSGetNativePath(destPathPtr), &srcStatBuf); } 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) + 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; @@ -481,15 +449,15 @@ DoCopyFile( switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { - char linkBuf[MAXPATHLEN+1]; + char link[MAXPATHLEN]; int length; - length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ + length = readlink(src, link, sizeof(link)); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; } - linkBuf[length] = '\0'; - if (symlink(linkBuf, dst) < 0) { /* INTL: Native. */ + link[length] = '\0'; + if (symlink(link, dst) < 0) { /* INTL: Native. */ return TCL_ERROR; } #ifdef MAC_OSX_TCL @@ -497,7 +465,7 @@ DoCopyFile( #endif break; } -#endif /* !DJGPP */ +#endif case S_IFBLK: case S_IFCHR: if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */ @@ -535,10 +503,10 @@ DoCopyFile( int TclUnixCopyFile( - const char *src, /* Pathname of file to copy (native). */ - const char *dst, /* Pathname of file to create/overwrite + 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. */ { @@ -551,9 +519,7 @@ TclUnixCopyFile( #define BINMODE |O_BINARY #else #define BINMODE -#endif /* DJGPP */ - -#define DEFAULT_COPY_BLOCK_SIZE 4096 +#endif if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */ return TCL_ERROR; @@ -581,11 +547,11 @@ TclUnixCopyFile( if (fstatfs(srcFd, &fs) == 0) { blockSize = fs.f_bsize; } else { - blockSize = DEFAULT_COPY_BLOCK_SIZE; + blockSize = 4096; } } #else - blockSize = DEFAULT_COPY_BLOCK_SIZE; + blockSize = 4096; #endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */ /* @@ -597,9 +563,9 @@ TclUnixCopyFile( */ if (blockSize <= 0) { - blockSize = DEFAULT_COPY_BLOCK_SIZE; + blockSize = 4096; } - buffer = (char *)ckalloc(blockSize); + buffer = ckalloc(blockSize); while (1) { nread = (size_t) read(srcFd, buffer, blockSize); if ((nread == (size_t) -1) || (nread == 0)) { @@ -660,9 +626,9 @@ TclpObjDeleteFile( int TclpDeleteFile( - const void *path) /* Pathname of file to be removed (native). */ + CONST char *path) /* Pathname of file to be removed (native). */ { - if (unlink((const char *)path) != 0) { + if (unlink(path) != 0) { /* INTL: Native. */ return TCL_ERROR; } return TCL_OK; @@ -698,12 +664,12 @@ int TclpObjCreateDirectory( Tcl_Obj *pathPtr) { - return DoCreateDirectory((const char *)Tcl_FSGetNativePath(pathPtr)); + return DoCreateDirectory(Tcl_FSGetNativePath(pathPtr)); } static int DoCreateDirectory( - const char *path) /* Pathname of directory to create (native). */ + CONST char *path) /* Pathname of directory to create (native). */ { mode_t mode; @@ -729,7 +695,7 @@ DoCreateDirectory( * * 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 empty directory. + * hierarchies, even if the target directory is an an empty directory. * * Results: * If the directory was successfully copied, returns TCL_OK. Otherwise @@ -778,7 +744,7 @@ TclpObjCopyDirectory( Tcl_DStringFree(&dstString); if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } @@ -832,7 +798,7 @@ TclpObjRemoveDirectory( Tcl_DStringFree(&pathString); if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE); + *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); } @@ -850,7 +816,7 @@ DoRemoveDirectory( * filled with UTF-8 name of file causing * error. */ { - const char *path; + CONST char *path; mode_t oldPerm = 0; int result; @@ -882,7 +848,7 @@ DoRemoveDirectory( result = TCL_OK; if ((errno != EEXIST) || (recursive == 0)) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, path, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDString(NULL, path, -1, errorPtr); } result = TCL_ERROR; } @@ -948,22 +914,22 @@ TraverseUnixTree( * files. */ { Tcl_StatBuf statBuf; - const char *source, *errfile; + CONST char *source, *errfile; int result, sourceLen; int targetLen; #ifndef HAVE_FTS int numProcessed = 0; Tcl_DirEntry *dirEntPtr; - TclDIR *dirPtr; + DIR *dirPtr; #else - const char *paths[2] = {NULL, NULL}; + CONST char *paths[2] = {NULL, NULL}; FTS *fts = NULL; FTSENT *ent; #endif errfile = NULL; result = TCL_OK; - targetLen = 0; + targetLen = 0; /* lint. */ source = Tcl_DStringValue(sourcePtr); if (TclOSlstat(source, &statBuf) != 0) { /* INTL: Native. */ @@ -975,11 +941,11 @@ TraverseUnixTree( * Process the regular file */ - return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F, + return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F, errorPtr); } #ifndef HAVE_FTS - dirPtr = TclOSopendir(source); /* INTL: Native. */ + dirPtr = opendir(source); /* INTL: Native. */ if (dirPtr == NULL) { /* * Can't read directory @@ -988,18 +954,18 @@ TraverseUnixTree( errfile = source; goto end; } - result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, + result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_PRED, errorPtr); if (result != TCL_OK) { - TclOSclosedir(dirPtr); + closedir(dirPtr); return result; } - TclDStringAppendLiteral(sourcePtr, "/"); + Tcl_DStringAppend(sourcePtr, "/", 1); sourceLen = Tcl_DStringLength(sourcePtr); if (targetPtr != NULL) { - TclDStringAppendLiteral(targetPtr, "/"); + Tcl_DStringAppend(targetPtr, "/", 1); targetLen = Tcl_DStringLength(targetPtr); } @@ -1014,9 +980,9 @@ TraverseUnixTree( * Append name after slash, and recurse on the file. */ - Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, TCL_INDEX_NONE); + Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1); if (targetPtr != NULL) { - Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, TCL_INDEX_NONE); + Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1); } result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr, errorPtr, doRewind); @@ -1041,11 +1007,11 @@ TraverseUnixTree( * NULL-return that may a symptom of a buggy readdir. */ - TclOSrewinddir(dirPtr); + rewinddir(dirPtr); numProcessed = 0; } } - TclOSclosedir(dirPtr); + closedir(dirPtr); /* * Strip off the trailing slash we added @@ -1062,12 +1028,12 @@ TraverseUnixTree( * that directory. */ - result = traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, + result = (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_POSTD, errorPtr); } #else /* HAVE_FTS */ paths[0] = source; - fts = fts_open((char **) paths, FTS_PHYSICAL | FTS_NOCHDIR | + fts = fts_open((char**)paths, FTS_PHYSICAL | FTS_NOCHDIR | (noFtsStat || doRewind ? FTS_NOSTAT : 0), NULL); if (fts == NULL) { errfile = source; @@ -1085,7 +1051,7 @@ TraverseUnixTree( unsigned short pathlen = ent->fts_pathlen - sourceLen; int type; Tcl_StatBuf *statBufPtr = NULL; - + if (info == FTS_DNR || info == FTS_ERR || info == FTS_NS) { errfile = ent->fts_path; break; @@ -1116,7 +1082,7 @@ TraverseUnixTree( statBufPtr = (Tcl_StatBuf *) ent->fts_statp; } } - result = traverseProc(sourcePtr, targetPtr, statBufPtr, type, + result = (*traverseProc)(sourcePtr, targetPtr, statBufPtr, type, errorPtr); if (result != TCL_OK) { break; @@ -1126,12 +1092,12 @@ TraverseUnixTree( Tcl_DStringSetLength(targetPtr, targetLen); } } -#endif /* !HAVE_FTS */ +#endif /* HAVE_FTS */ end: if (errfile != NULL) { if (errorPtr != NULL) { - Tcl_ExternalToUtfDString(NULL, errfile, TCL_INDEX_NONE, errorPtr); + Tcl_ExternalToUtfDString(NULL, errfile, -1, errorPtr); } result = TCL_ERROR; } @@ -1166,7 +1132,7 @@ static int TraversalCopy( Tcl_DString *srcPtr, /* Source pathname to copy (native). */ Tcl_DString *dstPtr, /* Destination pathname of copy (native). */ - const Tcl_StatBuf *statBufPtr, + 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 @@ -1229,14 +1195,14 @@ TraversalCopy( static int TraversalDelete( Tcl_DString *srcPtr, /* Source pathname (native). */ - TCL_UNUSED(Tcl_DString *), - TCL_UNUSED(const Tcl_StatBuf *), + 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. */ { - switch (type) { case DOTREE_F: if (TclpDeleteFile(Tcl_DStringValue(srcPtr)) == 0) { @@ -1278,13 +1244,9 @@ TraversalDelete( static int CopyFileAtts( -#ifdef MAC_OSX_TCL - const char *src, /* Path name of source file (native). */ -#else - TCL_UNUSED(const char *) /*src*/, -#endif - const char *dst, /* Path name of target file (native). */ - const Tcl_StatBuf *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; @@ -1308,8 +1270,8 @@ CopyFileAtts( } } - tval.actime = Tcl_GetAccessTimeFromStat(statBufPtr); - tval.modtime = Tcl_GetModificationTimeFromStat(statBufPtr); + tval.actime = statBufPtr->st_atime; + tval.modtime = statBufPtr->st_mtime; if (utime(dst, &tval)) { /* INTL: Native. */ return TCL_ERROR; @@ -1340,7 +1302,7 @@ CopyFileAtts( static int GetGroupAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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. */ { @@ -1352,9 +1314,9 @@ GetGroupAttribute( if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -1362,13 +1324,13 @@ GetGroupAttribute( groupPtr = TclpGetGrGid(statBuf.st_gid); if (groupPtr == NULL) { - TclNewIntObj(*attributePtrPtr, statBuf.st_gid); + *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid); } else { Tcl_DString ds; - const char *utf; + CONST char *utf; - utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, TCL_INDEX_NONE, &ds); - *attributePtrPtr = Tcl_NewStringObj(utf, TCL_INDEX_NONE); + utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds); + *attributePtrPtr = Tcl_NewStringObj(utf, -1); Tcl_DStringFree(&ds); } return TCL_OK; @@ -1394,7 +1356,7 @@ GetGroupAttribute( static int GetOwnerAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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. */ { @@ -1406,9 +1368,9 @@ GetOwnerAttribute( if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -1416,12 +1378,14 @@ GetOwnerAttribute( pwPtr = TclpGetPwUid(statBuf.st_uid); if (pwPtr == NULL) { - TclNewIntObj(*attributePtrPtr, statBuf.st_uid); + *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid); } else { Tcl_DString ds; + CONST char *utf; - (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, TCL_INDEX_NONE, &ds); - *attributePtrPtr = Tcl_DStringToObj(&ds); + utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds); + *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds)); + Tcl_DStringFree(&ds); } return TCL_OK; } @@ -1446,7 +1410,7 @@ GetOwnerAttribute( static int GetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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. */ { @@ -1457,15 +1421,15 @@ GetPermissionsAttribute( if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } *attributePtrPtr = Tcl_ObjPrintf( - "%0#5o", ((int)statBuf.st_mode & 0x7FFF)); + "%0#5lo", (long) (statBuf.st_mode & 0x00007FFF)); return TCL_OK; } @@ -1488,47 +1452,45 @@ GetPermissionsAttribute( static int SetGroupAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ - TCL_UNUSED(int) /*objIndex*/, + 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_WideInt gid; + long gid; int result; - const char *native; + CONST char *native; - if (Tcl_GetWideIntFromObj(NULL, attributePtr, &gid) != TCL_OK) { + if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) { Tcl_DString ds; struct group *groupPtr = NULL; - const char *string; + CONST char *string; + int length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); groupPtr = TclpGetGrNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (groupPtr == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set group for file \"%s\":" - " group \"%s\" does not exist", - TclGetString(fileName), string)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETGRP", - "NO_GROUP", (char *)NULL); + Tcl_AppendResult(interp, "could not set group for file \"", + TclGetString(fileName), "\": group \"", string, + "\" does not exist", NULL); } return TCL_ERROR; } gid = groupPtr->gr_gid; } - native = (const char *)Tcl_FSGetNativePath(fileName); + native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) -1, (gid_t) gid); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set group for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not set group for file \"", + TclGetString(fileName), "\": ", Tcl_PosixError(interp), + NULL); } return TCL_ERROR; } @@ -1554,47 +1516,45 @@ SetGroupAttribute( static int SetOwnerAttribute( Tcl_Interp *interp, /* The interp for error reporting. */ - TCL_UNUSED(int) /*objIndex*/, + 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_WideInt uid; + long uid; int result; - const char *native; + CONST char *native; - if (Tcl_GetWideIntFromObj(NULL, attributePtr, &uid) != TCL_OK) { + if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) { Tcl_DString ds; struct passwd *pwPtr = NULL; - const char *string; + CONST char *string; + int length; - string = TclGetString(attributePtr); + string = Tcl_GetStringFromObj(attributePtr, &length); - native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds); + native = Tcl_UtfToExternalDString(NULL, string, length, &ds); pwPtr = TclpGetPwNam(native); /* INTL: Native. */ Tcl_DStringFree(&ds); if (pwPtr == NULL) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set owner for file \"%s\":" - " user \"%s\" does not exist", - TclGetString(fileName), string)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SETOWN", - "NO_USER", (char *)NULL); + Tcl_AppendResult(interp, "could not set owner for file \"", + TclGetString(fileName), "\": user \"", string, + "\" does not exist", NULL); } return TCL_ERROR; } uid = pwPtr->pw_uid; } - native = (const char *)Tcl_FSGetNativePath(fileName); + native = Tcl_FSGetNativePath(fileName); result = chown(native, (uid_t) uid, (gid_t) -1); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set owner for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not set owner for file \"", + TclGetString(fileName), "\": ", Tcl_PosixError(interp), + NULL); } return TCL_ERROR; } @@ -1620,15 +1580,15 @@ SetOwnerAttribute( static int SetPermissionsAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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_WideInt mode; + long mode; mode_t newMode; int result = TCL_ERROR; - const char *native; - const char *modeStringPtr = TclGetString(attributePtr); + CONST char *native; + char *modeStringPtr = TclGetString(attributePtr); int scanned = TclParseAllWhiteSpace(modeStringPtr, -1); /* @@ -1643,11 +1603,11 @@ SetPermissionsAttribute( TclNewLiteralStringObj(modeObj, "0o"); Tcl_AppendToObj(modeObj, modeStringPtr+scanned+1, -1); - result = Tcl_GetWideIntFromObj(NULL, modeObj, &mode); + result = Tcl_GetLongFromObj(NULL, modeObj, &mode); Tcl_DecrRefCount(modeObj); } if (result == TCL_OK - || Tcl_GetWideIntFromObj(NULL, attributePtr, &mode) == TCL_OK) { + || Tcl_GetLongFromObj(NULL, attributePtr, &mode) == TCL_OK) { newMode = (mode_t) (mode & 0x00007FFF); } else { Tcl_StatBuf buf; @@ -1662,9 +1622,9 @@ SetPermissionsAttribute( result = TclpObjStat(fileName, &buf); if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -1672,22 +1632,20 @@ SetPermissionsAttribute( if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown permission string format \"%s\"", - modeStringPtr)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", (char *)NULL); + Tcl_AppendResult(interp, "unknown permission string format \"", + modeStringPtr, "\"", NULL); } return TCL_ERROR; } } - native = (const char *)Tcl_FSGetNativePath(fileName); + native = Tcl_FSGetNativePath(fileName); result = chmod(native, newMode); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set permissions for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not set permissions for file \"", + TclGetString(fileName), "\": ", + Tcl_PosixError(interp), NULL); } return TCL_ERROR; } @@ -1714,8 +1672,7 @@ SetPermissionsAttribute( Tcl_Obj * TclpObjListVolumes(void) { - Tcl_Obj *resultPtr; - TclNewLiteralStringObj(resultPtr, "/"); + Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1); Tcl_IncrRefCount(resultPtr); return resultPtr; @@ -1742,8 +1699,8 @@ TclpObjListVolumes(void) static int GetModeFromPermString( - TCL_UNUSED(Tcl_Interp *), - const char *modeStringPtr, /* Permissions string */ + 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; @@ -1762,7 +1719,7 @@ GetModeFromPermString( newMode = 0; for (i = 0; i < 9; i++) { - switch (modeStringPtr[i]) { + switch (*(modeStringPtr+i)) { case 'r': if ((i%3) != 0) { goto chmodStyleCheck; @@ -1824,15 +1781,15 @@ GetModeFromPermString( * We now check for an "ugoa+-=rwxst" style permissions string */ - for (n = 0 ; modeStringPtr[n] != '\0' ; n += i) { + for (n = 0 ; *(modeStringPtr+n) != '\0' ; n = n + i) { oldMode = *modePtr; who = op = what = op_found = who_found = 0; - for (i = 0 ; modeStringPtr[n + i] != '\0' ; i++ ) { + for (i = 0 ; *(modeStringPtr+n+i) != '\0' ; i++ ) { if (!who_found) { /* who */ - switch (modeStringPtr[n + i]) { + switch (*(modeStringPtr+n+i)) { case 'u': - who |= 0x9C0; + who |= 0x9c0; continue; case 'g': who |= 0x438; @@ -1841,17 +1798,17 @@ GetModeFromPermString( who |= 0x207; continue; case 'a': - who |= 0xFFF; + who |= 0xfff; continue; } } who_found = 1; if (who == 0) { - who = 0xFFF; + who = 0xfff; } if (!op_found) { /* op */ - switch (modeStringPtr[n + i]) { + switch (*(modeStringPtr+n+i)) { case '+': op = 1; op_found = 1; @@ -1869,7 +1826,7 @@ GetModeFromPermString( } } /* what */ - switch (modeStringPtr[n + i]) { + switch (*(modeStringPtr+n+i)) { case 'r': what |= 0x124; continue; @@ -1880,7 +1837,7 @@ GetModeFromPermString( what |= 0x49; continue; case 's': - what |= 0xC00; + what |= 0xc00; continue; case 't': what |= 0x200; @@ -1890,7 +1847,7 @@ GetModeFromPermString( default: return TCL_ERROR; } - if (modeStringPtr[n + i] == ',') { + if (*(modeStringPtr+n+i) == ',') { i++; break; } @@ -1915,52 +1872,55 @@ GetModeFromPermString( * * TclpObjNormalizePath -- * - * Replaces each component except that last one in a pathname that is a - * symbolic link with the fully resolved target of that link. + * 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: - * Stores the resulting path in pathPtr and returns the offset of the last - * byte processed to obtain the resulting 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_UNUSED(Tcl_Interp *), - Tcl_Obj *pathPtr, /* An unshared object containing the path to - * normalize. */ - int nextCheckpoint) /* offset to start at in pathPtr. Must either - * be 0 or the offset of a directory separator - * at the end of a path part that is already - * normalized. I.e. this is not the index of - * the byte just after the separator. */ - + Tcl_Interp *interp, + Tcl_Obj *pathPtr, + int nextCheckpoint) { - const char *currentPathEndPosition; + char *currentPathEndPosition; + int pathLen; char cur; - const char *path = TclGetString(pathPtr); - size_t pathLen = pathPtr->length; - Tcl_DString ds; - const char *nativePath; + char *path = Tcl_GetStringFromObj(pathPtr, &pathLen); #ifndef NO_REALPATH char normPath[MAXPATHLEN]; + Tcl_DString ds; + 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. + */ + currentPathEndPosition = path + nextCheckpoint; if (*currentPathEndPosition == '/') { currentPathEndPosition++; } #ifndef NO_REALPATH - if (nextCheckpoint == 0 && haveRealpath) { - /* - * Try to get the entire path in one go - */ + /* + * For speed, try to get the entire path in one go. + */ - const char *lastDir = strrchr(currentPathEndPosition, '/'); + if (nextCheckpoint == 0 && haveRealpath) { + char *lastDir = strrchr(currentPathEndPosition, '/'); if (lastDir != NULL) { nativePath = Tcl_UtfToExternalDString(NULL, path, @@ -1968,13 +1928,8 @@ TclpObjNormalizePath( if (Realpath(nativePath, normPath) != NULL) { if (*nativePath != '/' && *normPath == '/') { /* - * realpath transformed a relative path into an - * absolute path. Fall back to the long way. - */ - - /* - * To do: This logic seems to be out of date. This whole - * routine should be reviewed and cleaed up. + * realpath has transformed a relative path into an + * absolute path, we do not know how to handle this. */ } else { nextCheckpoint = lastDir - path; @@ -1997,6 +1952,8 @@ TclpObjNormalizePath( * Reached directory separator. */ + Tcl_DString ds; + CONST char *nativePath; int accessOk; nativePath = Tcl_UtfToExternalDString(NULL, path, @@ -2013,13 +1970,13 @@ TclpObjNormalizePath( } /* - * Assign the end of the current component to nextCheckpoint + * Update the acceptable point. */ nextCheckpoint = currentPathEndPosition - path; } else if (cur == 0) { /* - * The end of the string. + * Reached end of string. */ break; @@ -2028,23 +1985,26 @@ TclpObjNormalizePath( } /* - * Call 'realpath' to obtain a canonical path. + * 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 (nextCheckpoint == 0) { - /* - * The path contains at most one component, e.g. '/foo' or '/', so - * so there is nothing to resolve. Also, on some platforms - * 'Realpath' transforms an empty string into the normalized pwd, - * which is the wrong answer. - */ + /* + * 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; } - nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds); + nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds); if (Realpath(nativePath, normPath) != NULL) { int newNormLen; @@ -2053,19 +2013,18 @@ TclpObjNormalizePath( if ((newNormLen == Tcl_DStringLength(&ds)) && (strcmp(normPath, nativePath) == 0)) { /* - * The original path is unchanged. + * String is unchanged. */ Tcl_DStringFree(&ds); /* - * Uncommenting this would mean that this native filesystem - * routine claims the path is normalized if the file exists, - * which would permit the caller to avoid iterating through - * other filesystems filesystems. Saving lots of calls is - * probably worth the extra access() time, but in the common - * case that no other filesystems are registered this is an - * unnecessary expense. + * 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; @@ -2076,7 +2035,8 @@ TclpObjNormalizePath( } /* - * Free the original path and replace it with the normalized path. + * Free up the native path and put in its place the converted, + * normalized path. */ Tcl_DStringFree(&ds); @@ -2084,7 +2044,7 @@ TclpObjNormalizePath( if (path[nextCheckpoint] != '\0') { /* - * Append the remaining path components. + * Not at end, append remaining path. */ int normLen = Tcl_DStringLength(&ds); @@ -2093,8 +2053,7 @@ TclpObjNormalizePath( pathLen - nextCheckpoint); /* - * characters up to and including the directory separator have - * been processed + * We recognise up to and including the directory separator. */ nextCheckpoint = normLen + 1; @@ -2106,6 +2065,10 @@ TclpObjNormalizePath( nextCheckpoint = Tcl_DStringLength(&ds); } + /* + * Overwrite with the normalized path. + */ + Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); } @@ -2116,366 +2079,11 @@ TclpObjNormalizePath( return nextCheckpoint; } +#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) /* *---------------------------------------------------------------------- * - * TclpOpenTemporaryFile, TclUnixOpenTemporaryFile -- - * - * Creates a temporary file, possibly based on the supplied bits and - * pieces of template supplied in the first three arguments. If the - * fourth argument is non-NULL, it contains a Tcl_Obj to store the name - * of the temporary file in (and it is caller's responsibility to clean - * up). If the fourth argument is NULL, try to arrange for the temporary - * file to go away once it is no longer needed. - * - * Results: - * A read-write Tcl Channel open on the file for TclpOpenTemporaryFile, - * or a file descriptor (or -1 on failure) for TclUnixOpenTemporaryFile. - * - * Side effects: - * Accesses the filesystem. Will set the contents of the Tcl_Obj fourth - * argument (if that is non-NULL). - * - *---------------------------------------------------------------------- - */ - -Tcl_Channel -TclpOpenTemporaryFile( - Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, - Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj) -{ - int fd = TclUnixOpenTemporaryFile(dirObj, basenameObj, extensionObj, - resultingNameObj); - - if (fd == -1) { - return NULL; - } - return Tcl_MakeFileChannel(INT2PTR(fd), TCL_READABLE|TCL_WRITABLE); -} - -int -TclUnixOpenTemporaryFile( - Tcl_Obj *dirObj, - Tcl_Obj *basenameObj, - Tcl_Obj *extensionObj, - Tcl_Obj *resultingNameObj) -{ - Tcl_DString templ, tmp; - const char *string; - int fd; - - /* - * We should also check against making more then TMP_MAX of these. - */ - - if (dirObj) { - string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); - } else { - Tcl_DStringInit(&templ); - Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ - } - - TclDStringAppendLiteral(&templ, "/"); - - if (basenameObj) { - string = TclGetString(basenameObj); - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); - TclDStringAppendDString(&templ, &tmp); - Tcl_DStringFree(&tmp); - } else { - TclDStringAppendLiteral(&templ, "tcl"); - } - - TclDStringAppendLiteral(&templ, "_XXXXXX"); - -#ifdef HAVE_MKSTEMPS - if (extensionObj) { - string = TclGetString(extensionObj); - Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp); - TclDStringAppendDString(&templ, &tmp); - fd = mkstemps(Tcl_DStringValue(&templ), Tcl_DStringLength(&tmp)); - Tcl_DStringFree(&tmp); - } else -#endif - { - fd = mkstemp(Tcl_DStringValue(&templ)); - } - - if (fd == -1) { - Tcl_DStringFree(&templ); - return -1; - } - - if (resultingNameObj) { - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); - Tcl_SetStringObj(resultingNameObj, Tcl_DStringValue(&tmp), - Tcl_DStringLength(&tmp)); - Tcl_DStringFree(&tmp); - } else { - /* - * Try to delete the file immediately since we're not reporting the - * name to anyone. Note that we're *not* handling any errors from - * this! - */ - - unlink(Tcl_DStringValue(&templ)); - errno = 0; - } - Tcl_DStringFree(&templ); - - return fd; -} - -/* - * Helper that does *part* of what tempnam() does. - */ - -static const char * -DefaultTempDir(void) -{ - const char *dir; - Tcl_StatBuf buf; - - dir = getenv("TMPDIR"); - if (dir && dir[0] && TclOSstat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) - && access(dir, W_OK) == 0) { - return dir; - } - -#ifdef P_tmpdir - dir = P_tmpdir; - if (TclOSstat(dir, &buf)==0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)==0) { - return dir; - } -#endif - - /* - * Assume that the default location ("/tmp" if not overridden) is always - * an existing writable directory; we've no recovery mechanism if it - * isn't. - */ - - return TCL_TEMPORARY_FILE_DIRECTORY; -} - -/* - *---------------------------------------------------------------------- - * - * TclpCreateTemporaryDirectory -- - * - * Creates a temporary directory, possibly based on the supplied bits and - * pieces of template supplied in the arguments. - * - * Results: - * An object (refcount 0) containing the name of the newly-created - * directory, or NULL on failure. - * - * Side effects: - * Accesses the native filesystem. Makes a directory. - * - *---------------------------------------------------------------------- - */ - -Tcl_Obj * -TclpCreateTemporaryDirectory( - Tcl_Obj *dirObj, - Tcl_Obj *basenameObj) -{ - Tcl_DString templ, tmp; - const char *string; - -#define DEFAULT_TEMP_DIR_PREFIX "tcl" - - /* - * Build the template in writable memory from the user-supplied pieces and - * some defaults. - */ - - if (dirObj) { - string = TclGetString(dirObj); - Tcl_UtfToExternalDString(NULL, string, dirObj->length, &templ); - } else { - Tcl_DStringInit(&templ); - Tcl_DStringAppend(&templ, DefaultTempDir(), TCL_INDEX_NONE); /* INTL: native */ - } - - if (Tcl_DStringValue(&templ)[Tcl_DStringLength(&templ) - 1] != '/') { - TclDStringAppendLiteral(&templ, "/"); - } - - if (basenameObj) { - string = TclGetString(basenameObj); - if (basenameObj->length) { - Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp); - TclDStringAppendDString(&templ, &tmp); - Tcl_DStringFree(&tmp); - } else { - TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX); - } - } else { - TclDStringAppendLiteral(&templ, DEFAULT_TEMP_DIR_PREFIX); - } - - TclDStringAppendLiteral(&templ, "_XXXXXX"); - - /* - * Make the temporary directory. - */ - - if (mkdtemp(Tcl_DStringValue(&templ)) == NULL) { - Tcl_DStringFree(&templ); - return NULL; - } - - /* - * The template has been updated. Tell the caller what it was. - */ - - Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&templ), - Tcl_DStringLength(&templ), &tmp); - Tcl_DStringFree(&templ); - return Tcl_DStringToObj(&tmp); -} - -#if defined(__CYGWIN__) - -static void -StatError( - Tcl_Interp *interp, /* The interp that has the error */ - Tcl_Obj *fileName) /* The name of the file which caused the - * error. */ -{ - Tcl_WinConvertError(GetLastError()); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); -} - -static WCHAR * -winPathFromObj( - Tcl_Obj *fileName) -{ - int size; - const char *native = (const char *)Tcl_FSGetNativePath(fileName); - WCHAR *winPath; - - size = cygwin_conv_path(1, native, NULL, 0); - winPath = (WCHAR *)ckalloc(size); - cygwin_conv_path(1, native, winPath, size); - - return winPath; -} - -static const int attributeArray[] = { - 0x20, 0, 2, 0, 0, 1, 4 -}; - -/* - *---------------------------------------------------------------------- - * - * GetUnixFileAttributes - * - * Gets an attribute of a file. - * - * Results: - * A standard Tcl result. - * - * Side effects: - * If there is no error assigns to *attributePtrPtr the address of a new - * Tcl_Obj having a refCount of zero and containing the value of the - * specified attribute. - * - * - *---------------------------------------------------------------------- - */ - -static int -GetUnixFileAttributes( - Tcl_Interp *interp, /* The interp to report errors to. */ - int objIndex, /* The index of the attribute. */ - Tcl_Obj *fileName, /* The pathname of the file (UTF-8). */ - Tcl_Obj **attributePtrPtr) /* Where to store the result. */ -{ - int fileAttributes; - WCHAR *winPath = winPathFromObj(fileName); - - fileAttributes = GetFileAttributesW(winPath); - ckfree(winPath); - - if (fileAttributes == -1) { - StatError(interp, fileName); - return TCL_ERROR; - } - - TclNewIntObj(*attributePtrPtr, - (fileAttributes & attributeArray[objIndex]) != 0); - return TCL_OK; -} - -/* - *--------------------------------------------------------------------------- - * - * SetUnixFileAttributes - * - * Sets the readonly attribute of a file. - * - * Results: - * Standard TCL result. - * - * Side effects: - * The readonly attribute of the file is changed. - * - *--------------------------------------------------------------------------- - */ - -static int -SetUnixFileAttributes( - 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. */ -{ - int yesNo, fileAttributes, old; - WCHAR *winPath; - - if (Tcl_GetBooleanFromObj(interp, attributePtr, &yesNo) != TCL_OK) { - return TCL_ERROR; - } - - winPath = winPathFromObj(fileName); - - fileAttributes = old = GetFileAttributesW(winPath); - - if (fileAttributes == -1) { - ckfree(winPath); - StatError(interp, fileName); - return TCL_ERROR; - } - - if (yesNo) { - fileAttributes |= attributeArray[objIndex]; - } else { - fileAttributes &= ~attributeArray[objIndex]; - } - - if ((fileAttributes != old) - && !SetFileAttributesW(winPath, fileAttributes)) { - ckfree(winPath); - StatError(interp, fileName); - return TCL_ERROR; - } - - ckfree(winPath); - return TCL_OK; -} -#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE) -/* - *---------------------------------------------------------------------- - * - * GetUnixFileAttributes + * GetReadOnlyAttribute * * Gets the readonly attribute (user immutable flag) of a file. * @@ -2490,9 +2098,9 @@ SetUnixFileAttributes( */ static int -GetUnixFileAttributes( +GetReadOnlyAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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. */ { @@ -2503,21 +2111,22 @@ GetUnixFileAttributes( if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", Tcl_PosixError(interp), + NULL); } return TCL_ERROR; } - TclNewIntObj(*attributePtrPtr, (statBuf.st_flags & UF_IMMUTABLE) != 0); + *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0); + return TCL_OK; } /* *--------------------------------------------------------------------------- * - * SetUnixFileAttributes + * SetReadOnlyAttribute * * Sets the readonly attribute (user immutable flag) of a file. * @@ -2531,15 +2140,16 @@ GetUnixFileAttributes( */ static int -SetUnixFileAttributes( +SetReadOnlyAttribute( Tcl_Interp *interp, /* The interp we are using for errors. */ - TCL_UNUSED(int) /*objIndex*/, + 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, readonly; - const char *native; + int result; + int readonly; + CONST char *native; if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) { return TCL_ERROR; @@ -2549,9 +2159,9 @@ SetUnixFileAttributes( if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not read \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not read \"", + TclGetString(fileName), "\": ", Tcl_PosixError(interp), + NULL); } return TCL_ERROR; } @@ -2562,13 +2172,13 @@ SetUnixFileAttributes( statBuf.st_flags &= ~UF_IMMUTABLE; } - native = (const char *)Tcl_FSGetNativePath(fileName); + native = Tcl_FSGetNativePath(fileName); result = chflags(native, statBuf.st_flags); /* INTL: Native. */ if (result != 0) { if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "could not set flags for file \"%s\": %s", - TclGetString(fileName), Tcl_PosixError(interp))); + Tcl_AppendResult(interp, "could not set flags for file \"", + TclGetString(fileName), "\": ", Tcl_PosixError(interp), + NULL); } return TCL_ERROR; } |