summaryrefslogtreecommitdiffstats
path: root/unix/tclUnixFCmd.c
diff options
context:
space:
mode:
Diffstat (limited to 'unix/tclUnixFCmd.c')
-rw-r--r--unix/tclUnixFCmd.c424
1 files changed, 295 insertions, 129 deletions
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index a96a81a..559992f 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -47,7 +47,7 @@
#ifndef NO_FSTATFS
#include <sys/statfs.h>
#endif
-#endif
+#endif /* !HAVE_STRUCT_STAT_ST_BLKSIZE */
#ifdef HAVE_FTS
#include <fts.h>
#endif
@@ -62,6 +62,16 @@
#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.
*/
@@ -80,7 +90,7 @@ static int SetPermissionsAttribute(Tcl_Interp *interp,
int objIndex, Tcl_Obj *fileName,
Tcl_Obj *attributePtr);
static int GetModeFromPermString(Tcl_Interp *interp,
- char *modeStringPtr, mode_t *modePtr);
+ const 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);
@@ -93,7 +103,7 @@ static int SetReadOnlyAttribute(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.
@@ -110,9 +120,9 @@ typedef int (TraversalProc)(Tcl_DString *srcPtr, Tcl_DString *dstPtr,
*/
extern TclFileAttrProcs tclpFileAttrProcs[];
-extern char *tclpFileAttrStrings[];
+extern const char *const tclpFileAttrStrings[];
-#else
+#else /* !DJGPP */
enum {
UNIX_GROUP_ATTRIBUTE, UNIX_OWNER_ATTRIBUTE, UNIX_PERMISSIONS_ATTRIBUTE,
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
@@ -125,8 +135,8 @@ enum {
UNIX_INVALID_ATTRIBUTE /* lint - last enum value needs no trailing , */
};
-MODULE_SCOPE CONST char *tclpFileAttrStrings[];
-CONST char *tclpFileAttrStrings[] = {
+MODULE_SCOPE const char *const tclpFileAttrStrings[];
+const char *const tclpFileAttrStrings[] = {
"-group", "-owner", "-permissions",
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
"-readonly",
@@ -137,8 +147,8 @@ CONST char *tclpFileAttrStrings[] = {
NULL
};
-MODULE_SCOPE CONST TclFileAttrProcs tclpFileAttrProcs[];
-CONST TclFileAttrProcs tclpFileAttrProcs[] = {
+MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[];
+const TclFileAttrProcs tclpFileAttrProcs[] = {
{GetGroupAttribute, SetGroupAttribute},
{GetOwnerAttribute, SetOwnerAttribute},
{GetPermissionsAttribute, SetPermissionsAttribute},
@@ -152,7 +162,7 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
#endif
};
-#endif
+#endif /* DJGPP */
/*
* This is the maximum number of consecutive readdir/unlink calls that can be
@@ -173,20 +183,23 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
* Declarations for local procedures defined in this file:
*/
-static int CopyFileAtts(CONST char *src,
- CONST char *dst, CONST Tcl_StatBuf *statBufPtr);
-static int DoCopyFile(CONST char *srcPtr, CONST char *dstPtr,
- CONST Tcl_StatBuf *statBufPtr);
-static int DoCreateDirectory(CONST char *pathPtr);
+static int 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 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);
@@ -199,19 +212,19 @@ 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
+# define Realpath realpath
+#endif /* PURIFY */
#ifndef NO_REALPATH
#if defined(__APPLE__) && defined(TCL_THREADS) && \
@@ -224,16 +237,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
#ifdef HAVE_STRUCT_STAT64
/* 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
@@ -244,9 +257,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 */
@@ -295,9 +308,9 @@ TclpObjRenameFile(
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. */
@@ -405,7 +418,7 @@ TclpObjCopyFile(
Tcl_Obj *srcPathPtr,
Tcl_Obj *destPathPtr)
{
- CONST char *src = Tcl_FSGetNativePath(srcPathPtr);
+ const char *src = Tcl_FSGetNativePath(srcPathPtr);
Tcl_StatBuf srcStatBuf;
if (TclOSlstat(src, &srcStatBuf) != 0) { /* INTL: Native. */
@@ -417,9 +430,9 @@ TclpObjCopyFile(
static int
DoCopyFile(
- CONST char *src, /* Pathname of file to be copied (native). */
- CONST char *dst, /* Pathname of file to copy to (native). */
- CONST Tcl_StatBuf *statBufPtr)
+ 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;
@@ -449,15 +462,16 @@ DoCopyFile(
switch ((int) (statBufPtr->st_mode & S_IFMT)) {
#ifndef DJGPP
case S_IFLNK: {
- char link[MAXPATHLEN];
+ char linkBuf[MAXPATHLEN];
int length;
- length = readlink(src, link, sizeof(link)); /* INTL: Native. */
+ length = readlink(src, linkBuf, sizeof(linkBuf));
+ /* INTL: Native. */
if (length == -1) {
return TCL_ERROR;
}
- link[length] = '\0';
- if (symlink(link, dst) < 0) { /* INTL: Native. */
+ linkBuf[length] = '\0';
+ if (symlink(linkBuf, dst) < 0) { /* INTL: Native. */
return TCL_ERROR;
}
#ifdef MAC_OSX_TCL
@@ -465,7 +479,7 @@ DoCopyFile(
#endif
break;
}
-#endif
+#endif /* !DJGPP */
case S_IFBLK:
case S_IFCHR:
if (mknod(dst, statBufPtr->st_mode, /* INTL: Native. */
@@ -503,10 +517,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. */
{
@@ -519,7 +533,9 @@ TclUnixCopyFile(
#define BINMODE |O_BINARY
#else
#define BINMODE
-#endif
+#endif /* DJGPP */
+
+#define DEFAULT_COPY_BLOCK_SIZE 4069
if ((srcFd = TclOSopen(src, O_RDONLY BINMODE, 0)) < 0) { /* INTL: Native */
return TCL_ERROR;
@@ -547,11 +563,11 @@ TclUnixCopyFile(
if (fstatfs(srcFd, &fs) == 0) {
blockSize = fs.f_bsize;
} else {
- blockSize = 4096;
+ blockSize = DEFAULT_COPY_BLOCK_SIZE;
}
}
#else
- blockSize = 4096;
+ blockSize = DEFAULT_COPY_BLOCK_SIZE;
#endif /* HAVE_STRUCT_STAT_ST_BLKSIZE */
/*
@@ -563,7 +579,7 @@ TclUnixCopyFile(
*/
if (blockSize <= 0) {
- blockSize = 4096;
+ blockSize = DEFAULT_COPY_BLOCK_SIZE;
}
buffer = ckalloc(blockSize);
while (1) {
@@ -626,9 +642,9 @@ TclpObjDeleteFile(
int
TclpDeleteFile(
- CONST char *path) /* Pathname of file to be removed (native). */
+ const void *path) /* Pathname of file to be removed (native). */
{
- if (unlink(path) != 0) { /* INTL: Native. */
+ if (unlink((const char *)path) != 0) {
return TCL_ERROR;
}
return TCL_OK;
@@ -669,7 +685,7 @@ TclpObjCreateDirectory(
static int
DoCreateDirectory(
- CONST char *path) /* Pathname of directory to create (native). */
+ const char *path) /* Pathname of directory to create (native). */
{
mode_t mode;
@@ -816,7 +832,7 @@ DoRemoveDirectory(
* filled with UTF-8 name of file causing
* error. */
{
- CONST char *path;
+ const char *path;
mode_t oldPerm = 0;
int result;
@@ -914,7 +930,7 @@ TraverseUnixTree(
* files. */
{
Tcl_StatBuf statBuf;
- CONST char *source, *errfile;
+ const char *source, *errfile;
int result, sourceLen;
int targetLen;
#ifndef HAVE_FTS
@@ -922,7 +938,7 @@ TraverseUnixTree(
Tcl_DirEntry *dirEntPtr;
DIR *dirPtr;
#else
- CONST char *paths[2] = {NULL, NULL};
+ const char *paths[2] = {NULL, NULL};
FTS *fts = NULL;
FTSENT *ent;
#endif
@@ -941,7 +957,7 @@ TraverseUnixTree(
* Process the regular file
*/
- return (*traverseProc)(sourcePtr, targetPtr, &statBuf, DOTREE_F,
+ return traverseProc(sourcePtr, targetPtr, &statBuf, DOTREE_F,
errorPtr);
}
#ifndef HAVE_FTS
@@ -954,18 +970,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) {
closedir(dirPtr);
return result;
}
- Tcl_DStringAppend(sourcePtr, "/", 1);
+ TclDStringAppendLiteral(sourcePtr, "/");
sourceLen = Tcl_DStringLength(sourcePtr);
if (targetPtr != NULL) {
- Tcl_DStringAppend(targetPtr, "/", 1);
+ TclDStringAppendLiteral(targetPtr, "/");
targetLen = Tcl_DStringLength(targetPtr);
}
@@ -1028,12 +1044,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;
@@ -1051,7 +1067,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;
@@ -1082,7 +1098,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;
@@ -1092,7 +1108,7 @@ TraverseUnixTree(
Tcl_DStringSetLength(targetPtr, targetLen);
}
}
-#endif /* HAVE_FTS */
+#endif /* !HAVE_FTS */
end:
if (errfile != NULL) {
@@ -1132,7 +1148,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
@@ -1196,7 +1212,7 @@ static int
TraversalDelete(
Tcl_DString *srcPtr, /* Source pathname (native). */
Tcl_DString *ignore, /* Destination pathname (not used). */
- 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
@@ -1244,9 +1260,9 @@ TraversalDelete(
static int
CopyFileAtts(
- CONST char *src, /* Path name of source file (native). */
- CONST char *dst, /* Path name of target file (native). */
- CONST Tcl_StatBuf *statBufPtr)
+ 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;
@@ -1314,9 +1330,9 @@ GetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1327,7 +1343,7 @@ GetGroupAttribute(
*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
} else {
Tcl_DString ds;
- CONST char *utf;
+ const char *utf;
utf = Tcl_ExternalToUtfDString(NULL, groupPtr->gr_name, -1, &ds);
*attributePtrPtr = Tcl_NewStringObj(utf, -1);
@@ -1368,9 +1384,9 @@ GetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1381,11 +1397,9 @@ GetOwnerAttribute(
*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
} else {
Tcl_DString ds;
- CONST char *utf;
- utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
- *attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
- Tcl_DStringFree(&ds);
+ (void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
+ *attributePtrPtr = TclDStringToObj(&ds);
}
return TCL_OK;
}
@@ -1421,9 +1435,9 @@ GetPermissionsAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1458,12 +1472,12 @@ SetGroupAttribute(
{
long gid;
int result;
- CONST char *native;
+ const char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &gid) != TCL_OK) {
Tcl_DString ds;
struct group *groupPtr = NULL;
- CONST char *string;
+ const char *string;
int length;
string = Tcl_GetStringFromObj(attributePtr, &length);
@@ -1474,9 +1488,12 @@ SetGroupAttribute(
if (groupPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": group \"", string,
- "\" does not exist", 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", NULL);
}
return TCL_ERROR;
}
@@ -1488,9 +1505,9 @@ SetGroupAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set group for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set group for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1522,12 +1539,12 @@ SetOwnerAttribute(
{
long uid;
int result;
- CONST char *native;
+ const char *native;
if (Tcl_GetLongFromObj(NULL, attributePtr, &uid) != TCL_OK) {
Tcl_DString ds;
struct passwd *pwPtr = NULL;
- CONST char *string;
+ const char *string;
int length;
string = Tcl_GetStringFromObj(attributePtr, &length);
@@ -1538,9 +1555,12 @@ SetOwnerAttribute(
if (pwPtr == NULL) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": user \"", string,
- "\" does not exist", 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", NULL);
}
return TCL_ERROR;
}
@@ -1552,9 +1572,9 @@ SetOwnerAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set owner for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set owner for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1587,8 +1607,8 @@ SetPermissionsAttribute(
long mode;
mode_t newMode;
int result = TCL_ERROR;
- CONST char *native;
- char *modeStringPtr = TclGetString(attributePtr);
+ const char *native;
+ const char *modeStringPtr = TclGetString(attributePtr);
int scanned = TclParseAllWhiteSpace(modeStringPtr, -1);
/*
@@ -1622,9 +1642,9 @@ SetPermissionsAttribute(
result = TclpObjStat(fileName, &buf);
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1632,8 +1652,10 @@ SetPermissionsAttribute(
if (GetModeFromPermString(NULL, modeStringPtr, &newMode) != TCL_OK) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "unknown permission string format \"",
- modeStringPtr, "\"", NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown permission string format \"%s\"",
+ modeStringPtr));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "PERMISSION", NULL);
}
return TCL_ERROR;
}
@@ -1643,9 +1665,9 @@ SetPermissionsAttribute(
result = chmod(native, newMode); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set permissions for file \"",
- TclGetString(fileName), "\": ",
- Tcl_PosixError(interp), NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set permissions for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -1672,7 +1694,8 @@ SetPermissionsAttribute(
Tcl_Obj *
TclpObjListVolumes(void)
{
- Tcl_Obj *resultPtr = Tcl_NewStringObj("/", 1);
+ Tcl_Obj *resultPtr;
+ TclNewLiteralStringObj(resultPtr, "/");
Tcl_IncrRefCount(resultPtr);
return resultPtr;
@@ -1700,7 +1723,7 @@ TclpObjListVolumes(void)
static int
GetModeFromPermString(
Tcl_Interp *interp, /* The interp we are using for errors. */
- char *modeStringPtr, /* Permissions string */
+ const char *modeStringPtr, /* Permissions string */
mode_t *modePtr) /* pointer to the mode value */
{
mode_t newMode;
@@ -1893,14 +1916,14 @@ TclpObjNormalizePath(
Tcl_Obj *pathPtr,
int nextCheckpoint)
{
- char *currentPathEndPosition;
+ const char *currentPathEndPosition;
int pathLen;
char cur;
- char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ Tcl_DString ds;
+ const char *nativePath;
#ifndef NO_REALPATH
char normPath[MAXPATHLEN];
- Tcl_DString ds;
- CONST char *nativePath;
#endif
/*
@@ -1952,8 +1975,6 @@ TclpObjNormalizePath(
* Reached directory separator.
*/
- Tcl_DString ds;
- CONST char *nativePath;
int accessOk;
nativePath = Tcl_UtfToExternalDString(NULL, path,
@@ -2004,7 +2025,7 @@ TclpObjNormalizePath(
return 0;
}
- nativePath = Tcl_UtfToExternalDString(NULL, path, nextCheckpoint, &ds);
+ nativePath = Tcl_UtfToExternalDString(NULL, path,nextCheckpoint, &ds);
if (Realpath(nativePath, normPath) != NULL) {
int newNormLen;
@@ -2079,6 +2100,152 @@ TclpObjNormalizePath(
return nextCheckpoint;
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 template, tmp;
+ const char *string;
+ int len, fd;
+
+ /*
+ * We should also check against making more then TMP_MAX of these.
+ */
+
+ if (dirObj) {
+ string = Tcl_GetStringFromObj(dirObj, &len);
+ Tcl_UtfToExternalDString(NULL, string, len, &template);
+ } else {
+ Tcl_DStringInit(&template);
+ Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
+ }
+
+ TclDStringAppendLiteral(&template, "/");
+
+ if (basenameObj) {
+ string = Tcl_GetStringFromObj(basenameObj, &len);
+ Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+ TclDStringAppendDString(&template, &tmp);
+ Tcl_DStringFree(&tmp);
+ } else {
+ TclDStringAppendLiteral(&template, "tcl");
+ }
+
+ TclDStringAppendLiteral(&template, "_XXXXXX");
+
+#ifdef HAVE_MKSTEMPS
+ if (extensionObj) {
+ string = Tcl_GetStringFromObj(extensionObj, &len);
+ Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+ TclDStringAppendDString(&template, &tmp);
+ fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
+ Tcl_DStringFree(&tmp);
+ } else
+#endif
+ {
+ fd = mkstemp(Tcl_DStringValue(&template));
+ }
+
+ if (fd == -1) {
+ Tcl_DStringFree(&template);
+ return -1;
+ }
+
+ if (resultingNameObj) {
+ Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&template),
+ Tcl_DStringLength(&template), &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(&template));
+ errno = 0;
+ }
+ Tcl_DStringFree(&template);
+
+ return fd;
+}
+
+/*
+ * Helper that does *part* of what tempnam() does.
+ */
+
+static const char *
+DefaultTempDir(void)
+{
+ const char *dir;
+ struct stat buf;
+
+ dir = getenv("TMPDIR");
+ if (dir && dir[0] && stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode)
+ && access(dir, W_OK)) {
+ return dir;
+ }
+
+#ifdef P_tmpdir
+ dir = P_tmpdir;
+ if (stat(dir, &buf) == 0 && S_ISDIR(buf.st_mode) && access(dir, W_OK)) {
+ 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;
+}
+
#if defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
/*
*----------------------------------------------------------------------
@@ -2111,14 +2278,14 @@ GetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj((statBuf.st_flags&UF_IMMUTABLE) != 0);
+ *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE);
return TCL_OK;
}
@@ -2147,9 +2314,8 @@ SetReadOnlyAttribute(
Tcl_Obj *attributePtr) /* The attribute to set. */
{
Tcl_StatBuf statBuf;
- int result;
- int readonly;
- CONST char *native;
+ int result, readonly;
+ const char *native;
if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
return TCL_ERROR;
@@ -2159,9 +2325,9 @@ SetReadOnlyAttribute(
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not read \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not read \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
@@ -2176,9 +2342,9 @@ SetReadOnlyAttribute(
result = chflags(native, statBuf.st_flags); /* INTL: Native. */
if (result != 0) {
if (interp != NULL) {
- Tcl_AppendResult(interp, "could not set flags for file \"",
- TclGetString(fileName), "\": ", Tcl_PosixError(interp),
- NULL);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not set flags for file \"%s\": %s",
+ TclGetString(fileName), Tcl_PosixError(interp)));
}
return TCL_ERROR;
}
generated by cgit v0.12 at 2025-10-31 16:57:51 (GMT)