Tcl Source Code

Artifact [0008a7a708]
Login

Artifact 0008a7a7083ac96ee1819cb2cf0375e02bdbec93:

Attachment "fileperm.diff" to ticket [1100671fff] added by vincentdarley 2005-01-13 01:37:57.
? fileperm.diff
Index: tclFCmd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclFCmd.c,v
retrieving revision 1.29
diff -b -u -r1.29 tclFCmd.c
--- tclFCmd.c	19 Oct 2004 21:54:07 -0000	1.29
+++ tclFCmd.c	12 Jan 2005 18:36:55 -0000
@@ -532,14 +532,50 @@
 	 * permissions, we'll let the actual copy/rename return
 	 * an error later.
 	 */
-#if !defined(__WIN32__)
 	{
+	    Tcl_Obj *listObj;
+	    int permIndex = -1;
+	    CONST char **strings = Tcl_FSFileAttrStrings(target, &listObj);
+	    if (strings != NULL) {
+		/* We have an array of strings */
+		CONST char **strCounter = strings;
+		while (*strCounter != NULL) {
+		    CONST char *str = *strCounter;
+		    if (str[1] == 'p' && !strcmp(str,"-permissions")) {
+			permIndex = (strCounter - strings);
+		        break;
+		    }
+		    strCounter++;
+		}
+	    } else {
+		/* We have a list-object of attribute string-objects */
+		Tcl_Obj **elements;
+		Tcl_IncrRefCount(listObj);
+		if (Tcl_ListObjGetElements(NULL, listObj, &permIndex, 
+					   &elements) == TCL_OK) {
+		    while (--permIndex >= 0) {
+			int len;
+		        CONST char *str = 
+			  Tcl_GetStringFromObj(elements[permIndex],&len);
+			if (len == 12 && str[1] == 'p' 
+			  && !strcmp(str,"-permissions")) {
+			    break;
+			}
+		    }
+		}
+		Tcl_DecrRefCount(listObj);
+	    }
+	    /* 
+	     * If we found a valid permission index, then set the
+	     * path's permissions to 'u+w'.
+	     */
+	    if (permIndex != -1) {
 	Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
 	Tcl_IncrRefCount(perm);
-	Tcl_FSFileAttrsSet(NULL, 2, target, perm);
+		Tcl_FSFileAttrsSet(NULL, permIndex, target, perm);
 	Tcl_DecrRefCount(perm);
 	}
-#endif
+	}
     }
 
     if (copyFlag == 0) {