summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-01-14 14:16:51 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-01-14 14:16:51 (GMT)
commit582c4b826c90acc0c55d36b72802ee875ba9a7f4 (patch)
tree7f9d20aefbde66ed75c724de139652dae82026f8 /generic
parent7558ac7276f0ee10f5beb26fe368eea7cbdb9e37 (diff)
downloadtcl-582c4b826c90acc0c55d36b72802ee875ba9a7f4.zip
tcl-582c4b826c90acc0c55d36b72802ee875ba9a7f4.tar.gz
tcl-582c4b826c90acc0c55d36b72802ee875ba9a7f4.tar.bz2
Stop reliance on absolute attribute indexes with helper function [Bug 1100671]
Diffstat (limited to 'generic')
-rw-r--r--generic/tclFCmd.c13
-rw-r--r--generic/tclIOUtil.c88
-rw-r--r--generic/tclInt.h4
3 files changed, 95 insertions, 10 deletions
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index a74b6d6..9eb4685 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.29 2004/10/19 21:54:07 dgp Exp $
+ * RCS: @(#) $Id: tclFCmd.c,v 1.30 2005/01/14 14:16:53 dkf Exp $
*/
#include "tclInt.h"
@@ -534,10 +534,13 @@ CopyRenameOneFile(interp, source, target, copyFlag, force)
*/
#if !defined(__WIN32__)
{
- Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
- Tcl_IncrRefCount(perm);
- Tcl_FSFileAttrsSet(NULL, 2, target, perm);
- Tcl_DecrRefCount(perm);
+ Tcl_Obj* perm = Tcl_NewStringObj("u+w",-1);
+ int index;
+ Tcl_IncrRefCount(perm);
+ if (TclFSFileAttrIndex(target, "-permissions", &index) == TCL_OK) {
+ Tcl_FSFileAttrsSet(NULL, index, target, perm);
+ }
+ Tcl_DecrRefCount(perm);
}
#endif
}
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
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0338e3f..0f88767 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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.h,v 1.210 2005/01/05 10:31:02 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.211 2005/01/14 14:16:52 dkf Exp $
*/
#ifndef _TCLINT
@@ -1843,6 +1843,8 @@ MODULE_SCOPE void TclFinalizeAsync _ANSI_ARGS_((void));
MODULE_SCOPE void TclFinalizeSynchronization _ANSI_ARGS_((void));
MODULE_SCOPE void TclFinalizeLock _ANSI_ARGS_((void));
MODULE_SCOPE void TclFinalizeThreadData _ANSI_ARGS_((void));
+MODULE_SCOPE int TclFSFileAttrIndex _ANSI_ARGS_((Tcl_Obj *pathPtr,
+ CONST char *attributeName, int *indexPtr));
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler _ANSI_ARGS_((Tcl_Interp *interp));
MODULE_SCOPE int TclGetNamespaceFromObj _ANSI_ARGS_((
Tcl_Interp *interp, Tcl_Obj *objPtr,