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.

1 files changed, 462 insertions, 0 deletions

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;
+}