summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog44
-rw-r--r--doc/file.n20
-rw-r--r--generic/tclFCmd.c30
-rw-r--r--generic/tclInt.decls25
-rw-r--r--generic/tclIntPlatDecls.h46
-rw-r--r--generic/tclStubInit.c8
-rw-r--r--mac/tclMacFCmd.c81
-rw-r--r--mac/tclMacResource.c26
-rw-r--r--macosx/tclMacOSXFCmd.c462
-rw-r--r--tests/macFCmd.test3
-rw-r--r--tests/macOSXFCmd.test143
-rw-r--r--tests/unixFCmd.test40
-rw-r--r--tools/genStubs.tcl53
-rw-r--r--unix/Makefile.in8
-rwxr-xr-xunix/configure180
-rw-r--r--unix/configure.in14
-rw-r--r--unix/tcl.m42
-rw-r--r--unix/tclUnixFCmd.c156
18 files changed, 1266 insertions, 75 deletions
diff --git a/ChangeLog b/ChangeLog
index 11ac32f..74a941f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,47 @@
+2003-05-15 Daniel Steffen <das@users.sourceforge.net>
+
+ Implementation of TIP 118:
+
+ * generic/tclFCmd.c (TclFileAttrsCmd): return the list of attributes
+ that can be retrieved without error for a given file, instead of
+ aborting the whole command when any error occurs.
+
+ * unix/tclUnixFCmd.c: added support for new file attributes and for
+ copying Mac OS X file attributes & resource fork during [file copy].
+
+ * generic/tclInt.decls: added declarations of new external commands
+ needed by new file attributes support in tclUnixFCmd.c.
+
+ * macosx/tclMacOSXFCmd.c (new): Mac OS X specific implementation of
+ new file attributes and of attribute & resource fork copying.
+
+ * mac/tclMacFCmd.c: added implementation of -rsrclength attribute &
+ fixes to other attributes for consistency with OSX implementation.
+
+ * mac/tclMacResource.c: fixes to OSType handling.
+
+ * doc/file.n: documentation of [file attributes] changes.
+
+ * unix/configure.in: check for APIs needed by new file attributes.
+
+ * unix/Makefile.in:
+ * unix/tcl.m4: added new platform specifc tclMacOSXFCmd.c source.
+
+ * unix/configure:
+ * generic/tclStubInit.c:
+ * generic/tclIntPlatDecls.h: regen.
+
+ * tools/genStubs.tcl: fixes to completely broken code trying to
+ prevent overlap of "aqua", "macosx", "x11" and "unix" stub entries.
+
+ * tests/unixFCmd.test: added tests of -readonly attribute.
+
+ * tests/macOSXFCmd.test (new): tests of macosx file attributes and
+ of preservation of attributes & resource fork during [file copy].
+
+ * tests/macFCmd.test: restore -readonly attribute of test dir, as
+ otherwise its removal can fail on unices supporting -readonly.
+
2003-05-13 David Gravereaux <davygrvy@pobox.com>
* generic/tclEnv.c: Another putenv() copy behavior problem
diff --git a/doc/file.n b/doc/file.n
index 7fc2b07..3c46d88 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: file.n,v 1.23 2003/02/28 12:11:49 vincentdarley Exp $
+'\" RCS: @(#) $Id: file.n,v 1.24 2003/05/14 19:21:22 das Exp $
'\"
.so man.macros
.TH file n 8.3 Tcl "Tcl Built-In Commands"
@@ -59,6 +59,9 @@ where multiple symbolic attributes can be separated by commas (example:
permissions for group and other). A simplified \fBls\fR style string,
of the form rwxrwxrwx (must be 9 characters), is also supported
(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
+On versions of Unix supporting file flags, \fB-readonly\fR gives the
+value or sets or clears the readonly attribute of the file,
+i.e. the user immutable flag \fBuchg\fR to chflags(1).
.PP
On Windows, \fB-archive\fR gives the value or sets or clears the
archive attribute of the file. \fB-hidden\fR gives the value or sets
@@ -70,12 +73,15 @@ path element is replaced with its short (8.3) version of the
name. This attribute cannot be set. \fB-system\fR gives or sets or
clears the value of the system attribute of the file.
.PP
-On Macintosh, \fB-creator\fR gives or sets the Finder creator type of
-the file. \fB-hidden\fR gives or sets or clears the hidden attribute
-of the file. \fB-readonly\fR gives or sets or clears the readonly
-attribute of the file. Note that directories can only be locked if
-File Sharing is turned on. \fB-type\fR gives or sets the Finder file
-type for the file.
+On Mac OS 9, Mac OS X and Darwin, \fB-creator\fR gives or sets the
+Finder creator type of the file. \fB-hidden\fR gives or sets or clears
+the hidden attribute of the file. \fB-readonly\fR gives or sets or
+clears the readonly attribute of the file. Note that on Mac OS 9,
+directories can only be locked if File Sharing is turned on. \fB-type\fR
+gives or sets the Finder file type for the file. \fB-rsrclength\fR gives
+the length of the resource fork of the file, this attribute can only be
+set to the value 0, which results in the resource fork being stripped
+off the file.
.RE
.VS
.TP
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 50bea95..0d1cc76 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclFCmd.c,v 1.20 2002/08/08 10:41:22 hobbs Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.21 2003/05/14 19:21:22 das Exp $
*/
#include "tclInt.h"
@@ -918,21 +918,29 @@ TclFileAttrsCmd(interp, objc, objv)
* Get all attributes.
*/
- int index;
+ int index, res = TCL_OK, nbAtts = 0;
Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
for (index = 0; attributeStrings[index] != NULL; index++) {
- Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
- Tcl_ListObjAppendElement(interp, listPtr, objPtr);
- /* We now forget about objPtr, it is in the list */
- objPtr = NULL;
- if (Tcl_FSFileAttrsGet(interp, index, filePtr,
- &objPtr) != TCL_OK) {
- Tcl_DecrRefCount(listPtr);
- goto end;
+ Tcl_Obj *objPtrAttr;
+
+ if (res != TCL_OK) {
+ /* Clear the error from the last iteration */
+ Tcl_ResetResult(interp);
}
- Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ res = Tcl_FSFileAttrsGet(interp, index, filePtr, &objPtrAttr);
+ if (res == TCL_OK) {
+ Tcl_Obj *objPtr = Tcl_NewStringObj(attributeStrings[index], -1);
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ Tcl_ListObjAppendElement(interp, listPtr, objPtrAttr);
+ nbAtts++;
+ }
+ }
+ if (index > 0 && nbAtts == 0) {
+ /* Error: no valid attributes found */
+ Tcl_DecrRefCount(listPtr);
+ goto end;
}
Tcl_SetObjResult(interp, listPtr);
} else if (objc == 1) {
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index d68aa29..1a03642 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tclInt.decls,v 1.60 2003/04/28 12:34:27 dkf Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.61 2003/05/14 19:21:22 das Exp $
library tcl
@@ -993,3 +993,26 @@ declare 12 unix {
declare 13 unix {
char *TclpInetNtoa(struct in_addr addr)
}
+
+# Added in 8.5:
+
+declare 14 unix {
+ int TclUnixCopyFile (CONST char *src, CONST char *dst,
+ CONST Tcl_StatBuf *statBufPtr, int dontCopyAtts)
+}
+
+declare 15 macosx {
+ int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
+}
+
+declare 16 macosx {
+ int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
+ Tcl_Obj *fileName, Tcl_Obj *attributePtr)
+}
+
+declare 17 macosx {
+ int TclMacOSXCopyFileAttributes(CONST char *src, CONST char *dst,
+ CONST Tcl_StatBuf *statBufPtr)
+}
+
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 09c1226..b9a9dc5 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -9,7 +9,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.19 2002/12/06 23:22:59 hobbs Exp $
+ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.20 2003/05/14 19:21:22 das Exp $
*/
#ifndef _TCLINTPLATDECLS
@@ -67,6 +67,11 @@ EXTERN struct tm * TclpLocaltime _ANSI_ARGS_((time_t * clock));
EXTERN struct tm * TclpGmtime _ANSI_ARGS_((time_t * clock));
/* 13 */
EXTERN char * TclpInetNtoa _ANSI_ARGS_((struct in_addr addr));
+/* 14 */
+EXTERN int TclUnixCopyFile _ANSI_ARGS_((CONST char * src,
+ CONST char * dst,
+ CONST Tcl_StatBuf * statBufPtr,
+ int dontCopyAtts));
#endif /* UNIX */
#ifdef __WIN32__
/* 0 */
@@ -212,6 +217,21 @@ EXTERN int TclMacChmod _ANSI_ARGS_((CONST char * path, int mode));
EXTERN int FSpLLocationFromPath _ANSI_ARGS_((int length,
CONST char * path, FSSpecPtr theSpec));
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+/* 15 */
+EXTERN int TclMacOSXGetFileAttribute _ANSI_ARGS_((
+ Tcl_Interp * interp, int objIndex,
+ Tcl_Obj * fileName,
+ Tcl_Obj ** attributePtrPtr));
+/* 16 */
+EXTERN int TclMacOSXSetFileAttribute _ANSI_ARGS_((
+ Tcl_Interp * interp, int objIndex,
+ Tcl_Obj * fileName, Tcl_Obj * attributePtr));
+/* 17 */
+EXTERN int TclMacOSXCopyFileAttributes _ANSI_ARGS_((
+ CONST char * src, CONST char * dst,
+ CONST Tcl_StatBuf * statBufPtr));
+#endif /* MAC_OSX_TCL */
typedef struct TclIntPlatStubs {
int magic;
@@ -232,6 +252,7 @@ typedef struct TclIntPlatStubs {
struct tm * (*tclpLocaltime) _ANSI_ARGS_((time_t * clock)); /* 11 */
struct tm * (*tclpGmtime) _ANSI_ARGS_((time_t * clock)); /* 12 */
char * (*tclpInetNtoa) _ANSI_ARGS_((struct in_addr addr)); /* 13 */
+ int (*tclUnixCopyFile) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr, int dontCopyAtts)); /* 14 */
#endif /* UNIX */
#ifdef __WIN32__
void (*tclWinConvertError) _ANSI_ARGS_((DWORD errCode)); /* 0 */
@@ -293,6 +314,11 @@ typedef struct TclIntPlatStubs {
int (*tclMacChmod) _ANSI_ARGS_((CONST char * path, int mode)); /* 25 */
int (*fSpLLocationFromPath) _ANSI_ARGS_((int length, CONST char * path, FSSpecPtr theSpec)); /* 26 */
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+ int (*tclMacOSXGetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj ** attributePtrPtr)); /* 15 */
+ int (*tclMacOSXSetFileAttribute) _ANSI_ARGS_((Tcl_Interp * interp, int objIndex, Tcl_Obj * fileName, Tcl_Obj * attributePtr)); /* 16 */
+ int (*tclMacOSXCopyFileAttributes) _ANSI_ARGS_((CONST char * src, CONST char * dst, CONST Tcl_StatBuf * statBufPtr)); /* 17 */
+#endif /* MAC_OSX_TCL */
} TclIntPlatStubs;
#ifdef __cplusplus
@@ -363,6 +389,10 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclpInetNtoa \
(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#endif
+#ifndef TclUnixCopyFile
+#define TclUnixCopyFile \
+ (tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
+#endif
#endif /* UNIX */
#ifdef __WIN32__
#ifndef TclWinConvertError
@@ -577,6 +607,20 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
(tclIntPlatStubsPtr->fSpLLocationFromPath) /* 26 */
#endif
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+#ifndef TclMacOSXGetFileAttribute
+#define TclMacOSXGetFileAttribute \
+ (tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
+#endif
+#ifndef TclMacOSXSetFileAttribute
+#define TclMacOSXSetFileAttribute \
+ (tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
+#endif
+#ifndef TclMacOSXCopyFileAttributes
+#define TclMacOSXCopyFileAttributes \
+ (tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
+#endif
+#endif /* MAC_OSX_TCL */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 60fff39..6bd10ef 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.83 2003/05/13 08:40:31 das Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.84 2003/05/14 19:21:23 das Exp $
*/
#include "tclInt.h"
@@ -289,6 +289,7 @@ TclIntPlatStubs tclIntPlatStubs = {
TclpLocaltime, /* 11 */
TclpGmtime, /* 12 */
TclpInetNtoa, /* 13 */
+ TclUnixCopyFile, /* 14 */
#endif /* UNIX */
#ifdef __WIN32__
TclWinConvertError, /* 0 */
@@ -350,6 +351,11 @@ TclIntPlatStubs tclIntPlatStubs = {
TclMacChmod, /* 25 */
FSpLLocationFromPath, /* 26 */
#endif /* MAC_TCL */
+#ifdef MAC_OSX_TCL
+ TclMacOSXGetFileAttribute, /* 15 */
+ TclMacOSXSetFileAttribute, /* 16 */
+ TclMacOSXCopyFileAttributes, /* 17 */
+#endif /* MAC_OSX_TCL */
};
TclPlatStubs tclPlatStubs = {
diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c
index 58b81c2..a1307b4 100644
--- a/mac/tclMacFCmd.c
+++ b/mac/tclMacFCmd.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacFCmd.c,v 1.19 2003/02/04 17:06:51 vincentdarley Exp $
+ * RCS: @(#) $Id: tclMacFCmd.c,v 1.20 2003/05/14 19:21:23 das Exp $
*/
#include "tclInt.h"
@@ -26,6 +26,7 @@
#include <string.h>
#include <Finder.h>
#include <Aliases.h>
+#include <Resources.h>
/*
* Callback for the file attributes code.
@@ -52,17 +53,19 @@ static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
#define MAC_HIDDEN_ATTRIBUTE 1
#define MAC_READONLY_ATTRIBUTE 2
#define MAC_TYPE_ATTRIBUTE 3
+#define MAC_RSRCLENGTH_ATTRIBUTE 4
/*
* Global variables for the file attributes code.
*/
CONST char *tclpFileAttrStrings[] = {"-creator", "-hidden", "-readonly",
- "-type", (char *) NULL};
+ "-type", "-rsrclength", (char *) NULL};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetFileFinderAttributes, SetFileFinderAttributes},
{GetFileFinderAttributes, SetFileFinderAttributes},
{GetFileReadOnly, SetFileReadOnly},
+ {GetFileFinderAttributes, SetFileFinderAttributes},
{GetFileFinderAttributes, SetFileFinderAttributes}};
/*
@@ -1102,6 +1105,7 @@ GetFileFinderAttributes(
OSErr err;
FSSpec fileSpec;
FInfo finfo;
+ CInfoPBRec pb;
CONST char *native;
native=Tcl_FSGetNativePath(fileName);
@@ -1109,7 +1113,16 @@ GetFileFinderAttributes(
native, &fileSpec);
if (err == noErr) {
- err = FSpGetFInfo(&fileSpec, &finfo);
+ if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+ err = FSpGetFInfo(&fileSpec, &finfo);
+ } else {
+ pb.hFileInfo.ioCompletion = NULL;
+ pb.hFileInfo.ioNamePtr = fileSpec.name;
+ pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+ pb.hFileInfo.ioFDirIndex = 0;
+ pb.hFileInfo.ioDirID = fileSpec.parID;
+ err = PBGetCatInfo(&pb, 0);
+ }
}
if (err == noErr) {
@@ -1124,6 +1137,9 @@ GetFileFinderAttributes(
case MAC_TYPE_ATTRIBUTE:
*attributePtrPtr = Tcl_NewOSTypeObj(finfo.fdType);
break;
+ case MAC_RSRCLENGTH_ATTRIBUTE:
+ *attributePtrPtr = Tcl_NewLongObj(pb.hFileInfo.ioFlRLgLen);
+ break;
}
} else if (err == fnfErr) {
long dirID;
@@ -1134,7 +1150,11 @@ GetFileFinderAttributes(
if (objIndex == MAC_HIDDEN_ATTRIBUTE) {
*attributePtrPtr = Tcl_NewBooleanObj(0);
} else {
- *attributePtrPtr = Tcl_NewOSTypeObj('Fldr');
+ /* Directories only support attribute "-hidden" */
+ errno = EISDIR;
+ Tcl_AppendResult(interp, "invalid attribute: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
}
}
}
@@ -1244,6 +1264,7 @@ SetFileFinderAttributes(
OSErr err;
FSSpec fileSpec;
FInfo finfo;
+ CInfoPBRec pb;
CONST char *native;
native=Tcl_FSGetNativePath(fileName);
@@ -1251,7 +1272,16 @@ SetFileFinderAttributes(
native, &fileSpec);
if (err == noErr) {
- err = FSpGetFInfo(&fileSpec, &finfo);
+ if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+ err = FSpGetFInfo(&fileSpec, &finfo);
+ } else {
+ pb.hFileInfo.ioCompletion = NULL;
+ pb.hFileInfo.ioNamePtr = fileSpec.name;
+ pb.hFileInfo.ioVRefNum = fileSpec.vRefNum;
+ pb.hFileInfo.ioFDirIndex = 0;
+ pb.hFileInfo.ioDirID = fileSpec.parID;
+ err = PBGetCatInfo(&pb, 0);
+ }
}
if (err == noErr) {
@@ -1282,8 +1312,47 @@ SetFileFinderAttributes(
return TCL_ERROR;
}
break;
+ case MAC_RSRCLENGTH_ATTRIBUTE:
+ {
+ long newRsrcForkSize;
+
+ if (Tcl_GetLongFromObj(interp, attributePtr,
+ &newRsrcForkSize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if(newRsrcForkSize != pb.hFileInfo.ioFlRLgLen) {
+ short rf;
+ /*
+ * Only setting rsrclength to 0 to strip
+ * a file's resource fork is supported.
+ */
+ if(newRsrcForkSize != 0) {
+ Tcl_AppendResult(interp,
+ "setting nonzero rsrclength not supported",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((rf = FSpOpenResFile(&fileSpec, fsWrPerm)) >= 0) {
+ err = SetEOF(rf, 0);
+ CloseResFile(rf);
+ }
+
+ if (err != noErr) {
+ errno = TclMacOSErrorToPosixError(err);
+ Tcl_AppendResult(interp,
+ "could not truncate resource fork of \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ break;
+ }
+ }
+ if (objIndex != MAC_RSRCLENGTH_ATTRIBUTE) {
+ err = FSpSetFInfo(&fileSpec, &finfo);
}
- err = FSpSetFInfo(&fileSpec, &finfo);
} else if (err == fnfErr) {
long dirID;
Boolean isDirectory = 0;
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 78f0bc5..49e1110 100644
--- a/mac/tclMacResource.c
+++ b/mac/tclMacResource.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacResource.c,v 1.14 2002/06/05 11:59:49 das Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.15 2003/05/14 19:21:24 das Exp $
*/
#include <Errors.h>
@@ -1711,24 +1711,29 @@ SetOSTypeFromAny(
Tcl_ObjType *oldTypePtr = objPtr->typePtr;
char *string;
int length;
- long newOSType;
+ OSType newOSType = 0UL;
+ Tcl_DString ds;
/*
* Get the string representation. Make it up-to-date if necessary.
*/
string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_UtfToExternalDString(NULL, string, length, &ds);
- if (length != 4) {
+ if (Tcl_DStringLength(&ds) > sizeof(OSType)) {
if (interp != NULL) {
Tcl_ResetResult(interp);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
"expected Macintosh OS type but got \"", string, "\"",
(char *) NULL);
}
+ Tcl_DStringFree(&ds);
return TCL_ERROR;
}
- newOSType = *((long *) string);
+ memcpy(&newOSType, Tcl_DStringValue(&ds),
+ (size_t) Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
/*
* The conversion to resource type succeeded. Free the old internalRep
@@ -1767,9 +1772,16 @@ static void
UpdateStringOfOSType(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
- objPtr->bytes = ckalloc(5);
- sprintf(objPtr->bytes, "%-4.4s", &(objPtr->internalRep.longValue));
- objPtr->length = 4;
+ char string[sizeof(OSType)+1];
+ Tcl_DString ds;
+
+ memcpy(string, &(objPtr->internalRep.longValue), sizeof(OSType));
+ string[sizeof(OSType)] = '\0';
+ Tcl_ExternalToUtfDString(NULL, string, -1, &ds);
+ objPtr->bytes = ckalloc(Tcl_DStringLength(&ds) + 1);
+ memcpy(objPtr->bytes, Tcl_DStringValue(&ds), Tcl_DStringLength(&ds) + 1);
+ objPtr->length = Tcl_DStringLength(&ds);
+ Tcl_DStringFree(&ds);
}
/*
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
new file mode 100644
index 0000000..a1ce49e
--- /dev/null
+++ b/macosx/tclMacOSXFCmd.c
@@ -0,0 +1,462 @@
+/*
+ * tclMacOSXFCmd.c
+ *
+ * This file implements the MacOSX specific portion of file manipulation
+ * subcommands of the "file" command.
+ *
+ * Copyright (c) 2003 Tcl Core Team.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * RCS: @(#) $Id: tclMacOSXFCmd.c,v 1.1 2003/05/14 19:21:24 das Exp $
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+
+#ifdef HAVE_GETATTRLIST
+#include <sys/attr.h>
+#include <sys/paths.h>
+#endif
+
+/*
+ * Constants for file attributes subcommand.
+ * Need to be kept in sync with tclUnixFCmd.c !
+ */
+
+enum {
+ UNIX_GROUP_ATTRIBUTE,
+ UNIX_OWNER_ATTRIBUTE,
+ UNIX_PERMISSIONS_ATTRIBUTE,
+#ifdef HAVE_CHFLAGS
+ UNIX_READONLY_ATTRIBUTE,
+#endif
+#ifdef MAC_OSX_TCL
+ MACOSX_CREATOR_ATTRIBUTE,
+ MACOSX_TYPE_ATTRIBUTE,
+ MACOSX_HIDDEN_ATTRIBUTE,
+ MACOSX_RSRCLENGTH_ATTRIBUTE,
+#endif
+};
+
+typedef u_int32_t OSType;
+
+static int Tcl_GetOSTypeFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ OSType *osTypePtr);
+static Tcl_Obj *Tcl_NewOSTypeStringObj(CONST OSType newOSType);
+
+enum {
+ kFinfoIsInvisible = 0x4000,
+};
+
+typedef struct fileinfobuf {
+ u_int32_t info_length;
+ union {
+ struct {
+ u_int32_t type;
+ u_int32_t creator;
+ u_int16_t fdFlags;
+ u_int16_t location;
+ u_int32_t padding[4];
+ } finder;
+ off_t rsrcForkSize;
+ } data;
+} fileinfobuf;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacOSXGetFileAttribute
+ *
+ * Gets a MacOSX attribute of a file. Which attribute is
+ * controlled by objIndex. The object will have ref count 0.
+ *
+ * Results:
+ * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ * if there is no error.
+ *
+ * Side effects:
+ * A new object is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacOSXGetFileAttribute(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. */
+{
+#ifdef HAVE_GETATTRLIST
+ int result;
+ Tcl_StatBuf statBuf;
+ struct attrlist alist;
+ fileinfobuf finfo;
+ CONST char *native;
+
+ result = TclpObjStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
+ /* Directories only support attribute "-hidden" */
+ errno = EISDIR;
+ Tcl_AppendResult(interp, "invalid attribute: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&alist, 0, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ if(objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
+ alist.fileattr = ATTR_FILE_RSRCLENGTH;
+ } else {
+ alist.commonattr = ATTR_CMN_FNDRINFO;
+ }
+ native = Tcl_FSGetNativePath(fileName);
+ result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read attributes of \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ switch (objIndex) {
+ case MACOSX_CREATOR_ATTRIBUTE:
+ *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.creator);
+ break;
+ case MACOSX_TYPE_ATTRIBUTE:
+ *attributePtrPtr = Tcl_NewOSTypeStringObj(finfo.data.finder.type);
+ break;
+ case MACOSX_HIDDEN_ATTRIBUTE:
+ *attributePtrPtr = Tcl_NewBooleanObj( (finfo.data.finder.fdFlags
+ & kFinfoIsInvisible) != 0);
+ break;
+ case MACOSX_RSRCLENGTH_ATTRIBUTE:
+ *attributePtrPtr = Tcl_NewWideIntObj(finfo.data.rsrcForkSize);
+ break;
+ }
+ return TCL_OK;
+#else
+ Tcl_AppendResult(interp, "Mac OS X file attributes not supported",
+ (char *) NULL);
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacOSXSetFileAttribute --
+ *
+ * Sets a MacOSX attribute of a file. Which attribute is
+ * controlled by objIndex.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * As above.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclMacOSXSetFileAttribute(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. */
+{
+#ifdef HAVE_GETATTRLIST
+ int result;
+ Tcl_StatBuf statBuf;
+ struct attrlist alist;
+ fileinfobuf finfo;
+ CONST char *native;
+
+ result = TclpObjStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (S_ISDIR(statBuf.st_mode) && objIndex != MACOSX_HIDDEN_ATTRIBUTE) {
+ /* Directories only support attribute "-hidden" */
+ errno = EISDIR;
+ Tcl_AppendResult(interp, "invalid attribute: ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&alist, 0, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ if(objIndex == MACOSX_RSRCLENGTH_ATTRIBUTE) {
+ alist.fileattr = ATTR_FILE_RSRCLENGTH;
+ } else {
+ alist.commonattr = ATTR_CMN_FNDRINFO;
+ }
+ native = Tcl_FSGetNativePath(fileName);
+ result = getattrlist(native, &alist, &finfo, sizeof(fileinfobuf), 0);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read attributes of \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (objIndex != MACOSX_RSRCLENGTH_ATTRIBUTE) {
+ switch (objIndex) {
+ case MACOSX_CREATOR_ATTRIBUTE:
+ if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+ &finfo.data.finder.creator) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case MACOSX_TYPE_ATTRIBUTE:
+ if (Tcl_GetOSTypeFromObj(interp, attributePtr,
+ &finfo.data.finder.type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case MACOSX_HIDDEN_ATTRIBUTE:
+ {
+ int hidden;
+ if (Tcl_GetBooleanFromObj(interp, attributePtr, &hidden)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (hidden) {
+ finfo.data.finder.fdFlags |= kFinfoIsInvisible;
+ } else {
+ finfo.data.finder.fdFlags &= ~kFinfoIsInvisible;
+ }
+ }
+ break;
+ }
+ result = setattrlist(native, &alist, &finfo.data, sizeof(finfo.data), 0);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not set attributes of \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ off_t newRsrcForkSize;
+
+ if (Tcl_GetWideIntFromObj(interp, attributePtr,
+ &newRsrcForkSize) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if(newRsrcForkSize != finfo.data.rsrcForkSize) {
+ Tcl_DString ds;
+ /*
+ * Only setting rsrclength to 0 to strip
+ * a file's resource fork is supported.
+ */
+ if(newRsrcForkSize != 0) {
+ Tcl_AppendResult(interp,
+ "setting nonzero rsrclength not supported",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* construct path to resource fork */
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, native, -1);
+ Tcl_DStringAppend(&ds, _PATH_RSRCFORKSPEC, -1);
+
+ result = truncate(Tcl_DStringValue(&ds), (off_t)0);
+
+ Tcl_DStringFree(&ds);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp,
+ "could not truncate resource fork of \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+#else
+ Tcl_AppendResult(interp, "Mac OS X file attributes not supported",
+ (char *) NULL);
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacOSXCopyFileAttributes --
+ *
+ * Copy the MacOSX attributes and resource fork (if present) from one
+ * file to another.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * MacOSX attributes and resource fork are updated in the new file
+ * to reflect the old file.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclMacOSXCopyFileAttributes(src, dst, statBufPtr)
+ CONST char *src; /* Path name of source file (native). */
+ CONST char *dst; /* Path name of target file (native). */
+ CONST Tcl_StatBuf *statBufPtr;
+ /* Stat info for source file */
+{
+#ifdef HAVE_GETATTRLIST
+ struct attrlist alist;
+ fileinfobuf finfo;
+
+ memset(&alist, 0, sizeof(struct attrlist));
+ alist.bitmapcount = ATTR_BIT_MAP_COUNT;
+ alist.commonattr = ATTR_CMN_FNDRINFO;
+
+ if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
+ return TCL_ERROR;
+ }
+
+ if (setattrlist(dst, &alist, &finfo.data, sizeof(finfo.data), 0)) {
+ return TCL_ERROR;
+ }
+
+ if (!S_ISDIR(statBufPtr->st_mode)) {
+ /* only copy non-empty resource fork */
+ alist.commonattr = 0;
+ alist.fileattr = ATTR_FILE_RSRCLENGTH;
+
+ if (getattrlist(src, &alist, &finfo, sizeof(fileinfobuf), 0)) {
+ return TCL_ERROR;
+ }
+
+ if(finfo.data.rsrcForkSize > 0) {
+ int result;
+ Tcl_DString ds_src, ds_dst;
+
+ /* construct paths to resource forks */
+ Tcl_DStringInit(&ds_src);
+ Tcl_DStringAppend(&ds_src, src, -1);
+ Tcl_DStringAppend(&ds_src, _PATH_RSRCFORKSPEC, -1);
+ Tcl_DStringInit(&ds_dst);
+ Tcl_DStringAppend(&ds_dst, dst, -1);
+ Tcl_DStringAppend(&ds_dst, _PATH_RSRCFORKSPEC, -1);
+
+ result = TclUnixCopyFile(Tcl_DStringValue(&ds_src),
+ Tcl_DStringValue(&ds_dst), statBufPtr, 1);
+
+ Tcl_DStringFree(&ds_src);
+ Tcl_DStringFree(&ds_dst);
+
+ if (result != 0) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ return TCL_OK;
+#else
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetOSTypeFromObj --
+ *
+ * Attempt to return an OSType from the Tcl object "objPtr".
+ *
+ * Results:
+ * Standard TCL result. If an error occurs during conversion,
+ * an error message is left in interp->objResult.
+ *
+ * Side effects:
+ * The string representation of objPtr will be updated if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Tcl_GetOSTypeFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* The object from which to get an OSType. */
+ OSType *osTypePtr) /* Place to store resulting OSType. */
+{
+ char *string;
+ int length, result = TCL_OK;
+ Tcl_DString ds;
+ Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_UtfToExternalDString(encoding, string, length, &ds);
+
+ if (Tcl_DStringLength(&ds) > sizeof(OSType)) {
+ Tcl_AppendResult(interp,
+ "expected Macintosh OS type but got \"",
+ string, "\": ", (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ memset(osTypePtr, 0, sizeof(OSType));
+ memcpy(osTypePtr, Tcl_DStringValue(&ds),
+ (size_t) Tcl_DStringLength(&ds));
+ }
+ Tcl_DStringFree(&ds);
+ Tcl_FreeEncoding(encoding);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_NewOSTypeStringObj --
+ *
+ * Create a new OSType string object.
+ *
+ * Results:
+ * The newly created string object is returned, it has ref count 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+Tcl_NewOSTypeStringObj(
+ CONST OSType newOSType) /* OSType used to initialize the new object. */
+{
+ char string[sizeof(OSType)+1];
+ Tcl_Obj *resultPtr;
+ Tcl_DString ds;
+ Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
+
+ memcpy(string, &newOSType, sizeof(OSType));
+ string[sizeof(OSType)] = '\0';
+ Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
+ resultPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ Tcl_FreeEncoding(encoding);
+ return resultPtr;
+}
diff --git a/tests/macFCmd.test b/tests/macFCmd.test
index a6c7fa0..f50e7b9 100644
--- a/tests/macFCmd.test
+++ b/tests/macFCmd.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: macFCmd.test,v 1.10 2002/07/05 10:38:43 dkf Exp $
+# RCS: @(#) $Id: macFCmd.test,v 1.11 2003/05/14 19:21:24 das Exp $
#
if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -31,6 +31,7 @@ if {[catch {file attributes foo.dir -readonly 1}]} {
} else {
set ::tcltest::testConstraints(fileSharing) 1
set ::tcltest::testConstraints(notFileSharing) 0
+ file attributes foo.dir -readonly 0
}
file delete -force foo.dir
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
new file mode 100644
index 0000000..0bc6d30
--- /dev/null
+++ b/tests/macOSXFCmd.test
@@ -0,0 +1,143 @@
+# This file tests the tclMacOSXFCmd.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 2003 Tcl Core Team.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: macOSXFCmd.test,v 1.1 2003/05/14 19:21:25 das Exp $
+#
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+# These tests really need to be run from a writable directory, which
+# it is assumed [temporaryDirectory] is.
+set oldcwd [pwd]
+cd [temporaryDirectory]
+
+# check whether macosx file attributes are supported
+set ::tcltest::testConstraints(macosxFileAttr) 0
+if {$tcl_platform(platform) eq "unix" && \
+ $tcl_platform(os) eq "Darwin"} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ catch {
+ file attributes foo.test -creator
+ set ::tcltest::testConstraints(macosxFileAttr) 1
+ }
+ file delete -force -- foo.test
+}
+
+test macOSXFCmd-1.1 {MacOSXGetFileAttribute - file not found} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ list [catch {file attributes foo.test -creator} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test macOSXFCmd-1.2 {MacOSXGetFileAttribute - creator} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -creator} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} {}}
+test macOSXFCmd-1.3 {MacOSXGetFileAttribute - type} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -type} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} {}}
+test macOSXFCmd-1.4 {MacOSXGetFileAttribute - hidden} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -hidden} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 0 {}}
+test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -rsrclength} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 0 {}}
+
+test macOSXFCmd-2.1 {MacOSXSetFileAttribute - file not found} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ list [catch {file attributes foo.test -creator FOOO} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test macOSXFCmd-2.2 {MacOSXSetFileAttribute - creator} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -creator FOOO} msg] $msg \
+ [catch {file attributes foo.test -creator} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 FOOO {}}
+test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -creator {}} msg] $msg \
+ [catch {file attributes foo.test -creator} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 {} {}}
+test macOSXFCmd-2.4 {MacOSXSetFileAttribute - type} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -type FOOO} msg] $msg \
+ [catch {file attributes foo.test -type} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 FOOO {}}
+test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -type {}} msg] $msg \
+ [catch {file attributes foo.test -type} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 {} {}}
+test macOSXFCmd-2.6 {MacOSXSetFileAttribute - hidden} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -hidden 1} msg] $msg \
+ [catch {file attributes foo.test -hidden} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 1 {}}
+test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ catch {
+ set f [open foo.test/rsrc w]
+ fconfigure $f -translation lf -eofchar {}
+ puts -nonewline $f "foo"
+ close $f
+ }
+ list [catch {file attributes foo.test -rsrclength} msg] $msg \
+ [catch {file attributes foo.test -rsrclength 0} msg] $msg \
+ [catch {file attributes foo.test -rsrclength} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 3 0 {} 0 0 {}}
+
+test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
+ catch {file delete -force -- foo.test}
+ catch {file delete -force -- bar.test}
+ close [open foo.test w]
+ catch {
+ file attributes foo.test -creator FOOO -type FOOO -hidden 1
+ set f [open foo.test/rsrc w]
+ fconfigure $f -translation lf -eofchar {}
+ puts -nonewline $f "foo"
+ close $f
+ file copy foo.test bar.test
+ }
+ list [catch {file attributes bar.test -creator} msg] $msg \
+ [catch {file attributes bar.test -type} msg] $msg \
+ [catch {file attributes bar.test -hidden} msg] $msg \
+ [catch {file attributes bar.test -rsrclength} msg] $msg \
+ [file delete -force -- foo.test bar.test]
+} {0 FOOO 0 FOOO 0 1 0 3 {}}
+
+# cleanup
+cd $oldcwd
+::tcltest::cleanupTests
+return
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 574c5cc..e863d3b 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: unixFCmd.test,v 1.18 2003/04/11 16:00:02 vincentdarley Exp $
+# RCS: @(#) $Id: unixFCmd.test,v 1.19 2003/05/14 19:21:25 das Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -325,6 +325,44 @@ test unixFCmd-18.1 {Unix pwd} {nonPortable unixOnly notRoot} {
set r
} {1 {error getting working directory name:}}
+# check whether -readonly attribute is supported
+set ::tcltest::testConstraints(readonlyAttr) 0
+if {$tcl_platform(platform) == "unix"} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ catch {
+ file attributes foo.test -readonly
+ set ::tcltest::testConstraints(readonlyAttr) 1
+ }
+ file delete -force -- foo.test
+}
+
+test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unixOnly notRoot readonlyAttr} {
+ catch {file delete -force -- foo.test}
+ list [catch {file attributes foo.test -readonly} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+test unixFCmd-19.2 {GetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attribute foo.test -readonly} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 0 {}}
+
+test unixFCmd-20.1 {SetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+ catch {file delete -force -- foo.test}
+ close [open foo.test w]
+ list [catch {file attributes foo.test -readonly 1} msg] $msg \
+ [catch {file attribute foo.test -readonly} msg] $msg \
+ [catch {file delete -force -- foo.test}] \
+ [catch {file attributes foo.test -readonly 0} msg] $msg \
+ [catch {file attribute foo.test -readonly} msg] $msg \
+ [file delete -force -- foo.test]
+} {0 {} 0 1 1 0 {} 0 0 {}}
+test unixFCmd-20.2 {SetReadOnlyAttribute} {unixOnly notRoot readonlyAttr} {
+ catch {file delete -force -- foo.test}
+ list [catch {file attributes foo.test -readonly 1} msg] $msg
+} {1 {could not read "foo.test": no such file or directory}}
+
# cleanup
cleanup
cd $oldcwd
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index 9911fd2..36e17db 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: genStubs.tcl,v 1.14 2003/03/19 21:58:01 dgp Exp $
+# RCS: @(#) $Id: genStubs.tcl,v 1.15 2003/05/14 19:21:25 das Exp $
package require Tcl 8
@@ -631,7 +631,8 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
# emit duplicate stubs entries for the two.
#
if {[info exists stubs($name,aqua,$i)]
- && ![info exists stubs($name,macosx,$i)]} {
+ && ![info exists stubs($name,macosx,$i)]
+ && ![info exists stubs($name,unix,$i)]} {
append text [addPlatformGuard aqua \
[$slotProc $name $stubs($name,aqua,$i) $i]]
set emit 1
@@ -670,48 +671,52 @@ proc genStubs::forAllStubs {name slotProc onAll textVar \
append text [addPlatformGuard $plat $temp]
}
}
- # Again, make sure you don't duplicate entries for macosx & aqua.
- if {[info exists stubs($name,aqua,lastNum)]
- && ![info exists stubs($name,macosx,lastNum)]} {
+ if {[info exists stubs($name,unix,lastNum)]} {
+ set afterUnixNum [expr $stubs($name,unix,lastNum) + 1]
+ } else {
+ set afterUnixNum 0
+ }
+ if {[info exists stubs($name,aqua,lastNum)]} {
set lastNum $stubs($name,aqua,lastNum)
set temp {}
- for {set i 0} {$i <= $lastNum} {incr i} {
- if {![info exists stubs($name,aqua,$i)]} {
- eval {append temp} $skipString
- } else {
+ # Again, make sure you don't duplicate entries for macosx & unix & aqua.
+ for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
+ if {![info exists stubs($name,macosx,$i)]} {
+ if {![info exists stubs($name,aqua,$i)]} {
+ eval {append temp} $skipString
+ } else {
append temp [$slotProc $name $stubs($name,aqua,$i) $i]
}
}
- append text [addPlatformGuard aqua $temp]
}
- # Again, make sure you don't duplicate entries for macosx & unix.
- if {[info exists stubs($name,macosx,lastNum)]
- && ![info exists stubs($name,unix,lastNum)]} {
+ append text [addPlatformGuard aqua $temp]
+ }
+ if {[info exists stubs($name,macosx,lastNum)]} {
set lastNum $stubs($name,macosx,lastNum)
set temp {}
- for {set i 0} {$i <= $lastNum} {incr i} {
+ # Again, make sure you don't duplicate entries for macosx & unix.
+ for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
if {![info exists stubs($name,macosx,$i)]} {
eval {append temp} $skipString
} else {
- append temp [$slotProc $name $stubs($name,macosx,$i) $i]
- }
+ append temp [$slotProc $name $stubs($name,macosx,$i) $i]
}
- append text [addPlatformGuard macosx $temp]
}
- # Again, make sure you don't duplicate entries for x11 & unix.
- if {[info exists stubs($name,x11,lastNum)]
- && ![info exists stubs($name,unix,lastNum)]} {
+ append text [addPlatformGuard macosx $temp]
+ }
+ if {[info exists stubs($name,x11,lastNum)]} {
set lastNum $stubs($name,x11,lastNum)
set temp {}
- for {set i 0} {$i <= $lastNum} {incr i} {
+ # Again, make sure you don't duplicate entries for x11 & unix.
+ for {set i $afterUnixNum} {$i <= $lastNum} {incr i} {
if {![info exists stubs($name,x11,$i)]} {
eval {append temp} $skipString
} else {
- append temp [$slotProc $name $stubs($name,x11,$i) $i]
- }
+ append temp [$slotProc $name $stubs($name,x11,$i) $i]
}
- append text [addPlatformGuard x11 $temp]
}
+ append text [addPlatformGuard x11 $temp]
+ }
}
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index fc6c42c..8401624 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -5,7 +5,7 @@
# "autoconf" program (constructs like "@foo@" will get replaced in the
# actual Makefile.
#
-# RCS: @(#) $Id: Makefile.in,v 1.124 2003/04/11 16:09:51 vincentdarley Exp $
+# RCS: @(#) $Id: Makefile.in,v 1.125 2003/05/14 19:21:25 das Exp $
VERSION = @TCL_VERSION@
MAJOR_VERSION = @TCL_MAJOR_VERSION@
@@ -435,7 +435,8 @@ DL_SRCS = \
$(UNIX_DIR)/tclLoadShl.c
MAC_OSX_SRCS = \
- $(MAC_OSX_DIR)/tclMacOSXBundle.c
+ $(MAC_OSX_DIR)/tclMacOSXBundle.c \
+ $(MAC_OSX_DIR)/tclMacOSXFCmd.c
# Note: don't include DL_SRCS or MAC_OSX_SRCS in SRCS: most of those
# files won't compile on the current machine, and they will cause
@@ -1054,6 +1055,9 @@ tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c $(GENERIC_DIR)/tclInitScript.h tclConfi
tclMacOSXBundle.o: $(MAC_OSX_DIR)/tclMacOSXBundle.c
$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXBundle.c
+tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
+ $(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXFCmd.c
+
# The following targets are not completely general. They are provide
# purely for documentation purposes so people who are interested in
# the Xt based notifier can modify them to suit their own installation.
diff --git a/unix/configure b/unix/configure
index db36eb7..a7732ba 100755
--- a/unix/configure
+++ b/unix/configure
@@ -9562,6 +9562,184 @@ echo "${ECHO_T}$langinfo_ok" >&6
#--------------------------------------------------------------------
+# Check for support of chflags function
+#--------------------------------------------------------------------
+
+
+for ac_func in chflags
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+#--------------------------------------------------------------------
+# Check for support of getattrlist function (Darwin, HFS+)
+#--------------------------------------------------------------------
+
+
+for ac_func in getattrlist
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ cat >conftest.$ac_ext <<_ACEOF
+#line $LINENO "configure"
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.$ac_objext conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
@@ -11824,7 +12002,7 @@ fi
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dylib"
DL_OBJS="tclLoadDyld.o"
- PLAT_OBJS="tclMacOSXBundle.o"
+ PLAT_OBJS="tclMacOSXBundle.o tclMacOSXFCmd.o"
DL_LIBS=""
LDFLAGS="-prebind"
CC_SEARCH_FLAGS=""
diff --git a/unix/configure.in b/unix/configure.in
index ce6b5e2..c538308 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
#
-# RCS: @(#) $Id: configure.in,v 1.108 2003/03/13 10:39:58 mdejong Exp $
+# RCS: @(#) $Id: configure.in,v 1.109 2003/05/14 19:21:29 das Exp $
AC_INIT(../generic/tcl.h)
AC_PREREQ(2.57)
@@ -417,6 +417,18 @@ fi
SC_ENABLE_LANGINFO
#--------------------------------------------------------------------
+# Check for support of chflags function
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNCS(chflags)
+
+#--------------------------------------------------------------------
+# Check for support of getattrlist function (Darwin, HFS+)
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNCS(getattrlist)
+
+#--------------------------------------------------------------------
# Look for libraries that we will need when compiling the Tcl shell
#--------------------------------------------------------------------
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 88eaa56..03418d2 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1281,7 +1281,7 @@ dnl AC_CHECK_TOOL(AR, ar)
SHLIB_LD_LIBS='${LIBS}'
SHLIB_SUFFIX=".dylib"
DL_OBJS="tclLoadDyld.o"
- PLAT_OBJS="tclMacOSXBundle.o"
+ PLAT_OBJS="tclMacOSXBundle.o tclMacOSXFCmd.o"
DL_LIBS=""
LDFLAGS="-prebind"
CC_SEARCH_FLAGS=""
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index bc9746f..7b26c08 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -10,7 +10,7 @@
* 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.28 2003/02/10 12:50:31 vincentdarley Exp $
+ * RCS: @(#) $Id: tclUnixFCmd.c,v 1.29 2003/05/14 19:21:30 das Exp $
*
* Portions of this code were derived from NetBSD source code which has
* the following copyright notice:
@@ -91,6 +91,14 @@ static int SetPermissionsAttribute _ANSI_ARGS_((
static int GetModeFromPermString _ANSI_ARGS_((
Tcl_Interp *interp, char *modeStringPtr,
mode_t *modePtr));
+#ifdef HAVE_CHFLAGS
+static int GetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, Tcl_Obj *fileName,
+ Tcl_Obj **attributePtrPtr));
+static int SetReadOnlyAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ int objIndex, Tcl_Obj *fileName,
+ Tcl_Obj *attributePtr));
+#endif
/*
* Prototype for the TraverseUnixTree callback function.
@@ -107,28 +115,53 @@ typedef int (TraversalProc) _ANSI_ARGS_((Tcl_DString *srcPtr,
enum {
UNIX_GROUP_ATTRIBUTE,
UNIX_OWNER_ATTRIBUTE,
- UNIX_PERMISSIONS_ATTRIBUTE
+ UNIX_PERMISSIONS_ATTRIBUTE,
+#ifdef HAVE_CHFLAGS
+ UNIX_READONLY_ATTRIBUTE,
+#endif
+#ifdef MAC_OSX_TCL
+ MACOSX_CREATOR_ATTRIBUTE,
+ MACOSX_TYPE_ATTRIBUTE,
+ MACOSX_HIDDEN_ATTRIBUTE,
+ MACOSX_RSRCLENGTH_ATTRIBUTE,
+#endif
};
CONST char *tclpFileAttrStrings[] = {
"-group",
"-owner",
"-permissions",
+#ifdef HAVE_CHFLAGS
+ "-readonly",
+#endif
+#ifdef MAC_OSX_TCL
+ "-creator",
+ "-type",
+ "-hidden",
+ "-rsrclength",
+#endif
(char *) NULL
};
CONST TclFileAttrProcs tclpFileAttrProcs[] = {
{GetGroupAttribute, SetGroupAttribute},
{GetOwnerAttribute, SetOwnerAttribute},
- {GetPermissionsAttribute, SetPermissionsAttribute}
+ {GetPermissionsAttribute, SetPermissionsAttribute},
+#ifdef HAVE_CHFLAGS
+ {GetReadOnlyAttribute, SetReadOnlyAttribute},
+#endif
+#ifdef MAC_OSX_TCL
+ {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
+ {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
+ {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
+ {TclMacOSXGetFileAttribute, TclMacOSXSetFileAttribute},
+#endif
};
/*
* Declarations for local procedures defined in this file:
*/
-static int CopyFile _ANSI_ARGS_((CONST char *src,
- CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
static int CopyFileAtts _ANSI_ARGS_((CONST char *src,
CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
static int DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
@@ -400,7 +433,7 @@ DoCopyFile(src, dst)
return CopyFileAtts(src, dst, &srcStatBuf);
}
default: {
- return CopyFile(src, dst, &srcStatBuf);
+ return TclUnixCopyFile(src, dst, &srcStatBuf, 0);
}
}
return TCL_OK;
@@ -409,7 +442,7 @@ DoCopyFile(src, dst)
/*
*----------------------------------------------------------------------
*
- * CopyFile -
+ * TclUnixCopyFile -
*
* Helper function for TclpCopyFile. Copies one regular file,
* using read() and write().
@@ -423,13 +456,14 @@ DoCopyFile(src, dst)
*----------------------------------------------------------------------
*/
-static int
-CopyFile(src, dst, statBufPtr)
+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 srcFd;
int dstFd;
@@ -483,7 +517,7 @@ CopyFile(src, dst, statBufPtr)
unlink(dst); /* INTL: Native. */
return TCL_ERROR;
}
- if (CopyFileAtts(src, dst, statBufPtr) == TCL_ERROR) {
+ 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
@@ -1071,6 +1105,9 @@ CopyFileAtts(src, dst, statBufPtr)
if (utime(dst, &tval)) { /* INTL: Native. */
return TCL_ERROR;
}
+#ifdef MAC_OSX_TCL
+ TclMacOSXCopyFileAttributes(src, dst, statBufPtr);
+#endif
return TCL_OK;
}
@@ -1781,6 +1818,105 @@ TclpObjNormalizePath(interp, pathPtr, nextCheckpoint)
return nextCheckpoint;
}
+
+#ifdef HAVE_CHFLAGS
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetReadOnlyAttribute
+ *
+ * Gets the readonly attribute (user immutable flag) of a file.
+ *
+ * Results:
+ * Standard TCL result. Returns a new Tcl_Obj in attributePtrPtr
+ * if there is no error. The object will have ref count 0.
+ *
+ * Side effects:
+ * A new object is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+GetReadOnlyAttribute(interp, objIndex, fileName, attributePtrPtr)
+ Tcl_Interp *interp; /* The interp we are using for errors. */
+ int objIndex; /* The index of the attribute. */
+ Tcl_Obj *fileName; /* The name of the file (UTF-8). */
+ Tcl_Obj **attributePtrPtr; /* A pointer to return the object with. */
+{
+ Tcl_StatBuf statBuf;
+ int result;
+ result = TclpObjStat(fileName, &statBuf);
+
+ if (result != 0) {
+ 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);
+
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * SetReadOnlyAttribute
+ *
+ * Sets the readonly attribute (user immutable flag) of a file.
+ *
+ * Results:
+ * Standard TCL result.
+ *
+ * Side effects:
+ * The readonly attribute of the file is changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+SetReadOnlyAttribute(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_StatBuf statBuf;
+ int result;
+ int readonly;
+ CONST char *native;
+
+ if (Tcl_GetBooleanFromObj(interp, attributePtr, &readonly) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ result = TclpObjStat(fileName, &statBuf);
+
+ if (result != 0) {
+ Tcl_AppendResult(interp, "could not read \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (readonly) {
+ statBuf.st_flags |= UF_IMMUTABLE;
+ } else {
+ statBuf.st_flags &= ~UF_IMMUTABLE;
+ }
+
+ native = Tcl_FSGetNativePath(fileName);
+ result = chflags(native, statBuf.st_flags); /* INTL: Native. */
+ if (result != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "could not set flags for file \"",
+ Tcl_GetString(fileName), "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif /* HAVE_CHFLAGS */
generated by cgit v0.12 at 2024-11-10 00:52:37 (GMT)