Stop reliance on absolute attribute indexes with helper function [Bug 1100671]

1 files changed, 84 insertions, 4 deletions

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 17fd376..e4ddcd4 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.113 2004/11/17 00:31:47 dgp Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.114 2005/01/14 14:16:51 dkf Exp $
  */
 
 #include "tclInt.h"
@@ -2292,6 +2292,83 @@ Tcl_FSFileAttrStrings(pathPtr, objPtrRef)
 /*
  *----------------------------------------------------------------------
  *
+ * TclFSFileAttrIndex --
+ *
+ *	Helper function for converting an attribute name to an index
+ *	into the attribute table.
+ *
+ * Results:
+ *	Tcl result code, index written to *indexPtr on result==TCL_OK
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFSFileAttrIndex(pathPtr, attributeName, indexPtr)
+    Tcl_Obj *pathPtr;			/* File whose attributes are to be
+					 * indexed into. */
+    CONST char *attributeName;		/* The attribute being looked for. */
+    int *indexPtr;			/* Where to write the found index. */
+{
+    Tcl_Obj *listObj = NULL;
+    CONST char **attrTable;
+
+    /*
+     * Get the attribute table for the file.
+     */
+
+    attrTable = Tcl_FSFileAttrStrings(pathPtr, &listObj);
+    if (listObj != NULL) {
+	Tcl_IncrRefCount(listObj);
+    }
+
+    if (attrTable != NULL) {
+	/*
+	 * It's a constant attribute table, so use T_GIFO.
+	 */
+
+	Tcl_Obj *tmpObj = Tcl_NewStringObj(attributeName, NULL);
+	int result;
+
+	result = Tcl_GetIndexFromObj(NULL, tmpObj, attrTable, NULL, TCL_EXACT,
+		indexPtr);
+	TclDecrRefCount(tmpObj);
+	if (listObj != NULL) {
+	    TclDecrRefCount(listObj);
+	}
+	return result;
+    } else if (listObj != NULL) {
+	/*
+	 * It's a non-constant attribute list, so do a literal search.
+	 */
+
+        int i, objc;
+	Tcl_Obj **objv;
+
+	if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) {
+	    TclDecrRefCount(listObj);
+	    return TCL_ERROR;
+	}
+	for (i=0 ; i<objc ; i++) {
+	    if (!strcmp(attributeName, TclGetString(objv[i]))) {
+		TclDecrRefCount(listObj);
+		*indexPtr = i;
+		return TCL_OK;
+	    }
+	}
+	TclDecrRefCount(listObj);
+	return TCL_ERROR;
+    } else {
+	return TCL_ERROR;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_FSFileAttrsGet --
  *
  *	This procedure implements read access for the hookable 'file
@@ -2951,8 +3028,7 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
 	    return -1;
 	}
 	
-	if (TclCrossFilesystemCopy(interp, pathPtr, 
-				   copyToPtr) == TCL_OK) {
+	if (TclCrossFilesystemCopy(interp, pathPtr, copyToPtr) == TCL_OK) {
 	    Tcl_LoadHandle newLoadHandle = NULL;
 	    ClientData newClientData = NULL;
 	    Tcl_FSUnloadFileProc *newUnloadProcPtr = NULL;
@@ -2969,9 +3045,13 @@ TclLoadFile(interp, pathPtr, symc, symbols, procPtrs,
 	     * we just do this directly, like this:
 	     */
 	    
+	    int index;
 	    Tcl_Obj* perm = Tcl_NewStringObj("0700",-1);
 	    Tcl_IncrRefCount(perm);
-	    Tcl_FSFileAttrsSet(NULL, 2, copyToPtr, perm);
+	    if (TclFSFileAttrIndex(copyToPtr, "-permissions",
+		    &index) == TCL_OK) {
+		Tcl_FSFileAttrsSet(NULL, index, copyToPtr, perm);
+	    }
 	    Tcl_DecrRefCount(perm);
 #endif