From ec20c7abb7c8f4f38eecfa6593196057e0f7c824 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 10 Jun 2013 08:26:01 +0000
Subject: Start of work on a proper fix for [3613671]; just structural
 refactoring first.

---
 generic/tclCmdAH.c | 18 ++----------------
 generic/tclInt.h   |  2 ++
 unix/tclUnixFile.c | 34 ++++++++++++++++++++++++++++++++++
 win/tclWinFile.c   | 27 +++++++++++++++++++++++++++
 4 files changed, 65 insertions(+), 16 deletions(-)

diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index eb2a303..014ce01 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -1575,28 +1575,14 @@ FileAttrIsOwnedCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
-    Tcl_StatBuf buf;
-    int value = 0;
+    int value;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
-    if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
-	/*
-	 * For Windows, there are no user ids associated with a file, so we
-	 * always return 1.
-	 *
-	 * TODO: use GetSecurityInfo to get the real owner of the file and
-	 * test for equivalence to the current user.
-	 */
 
-#if defined(__WIN32__) || defined(__CYGWIN__)
-	value = 1;
-#else
-	value = (geteuid() == buf.st_uid);
-#endif
-    }
+    value = TclpFileOwnedByCurrentUser(interp, objv[1]);
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
     return TCL_OK;
 }
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e60b627..f7d876f 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2997,6 +2997,8 @@ MODULE_SCOPE int	TclParseAllWhiteSpace(const char *src, int numBytes);
 MODULE_SCOPE int	TclProcessReturn(Tcl_Interp *interp,
 			    int code, int level, Tcl_Obj *returnOpts);
 MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+MODULE_SCOPE int	TclpFileOwnedByCurrentUser(Tcl_Interp *interp,
+			    Tcl_Obj *pathObj);
 MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
 MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr);
 MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 5bfe5d9..9040021 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -1176,6 +1176,40 @@ TclpUtime(
     return utime(Tcl_FSGetNativePath(pathPtr), tval);
 }
 
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpUtime --
+ *
+ *	Check if the file named in the pathObj is owned by the current
+ *	(effective) user.
+ *
+ * Results:
+ *	Boolean: true if the file exists, is accessible and is owned by the
+ *	current user.
+ *
+ * Side effects:
+ *	pathObj may be converted to path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpFileOwnedByCurrentUser(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathObj)
+{
+    Tcl_StatBuf buf;
+
+    if (Tcl_FSConvertToPathType(interp, pathObj) != TCL_OK) {
+	return 0;
+    }
+    if (Tcl_FSStat(pathObj, &buf) < 0) {
+	return 0;
+    }
+    return (geteuid() == buf.st_uid);
+}
+
 #ifdef __CYGWIN__
 
 int
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 8e517d1..f64d583 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -3195,6 +3195,33 @@ TclpUtime(
     }
     return res;
 }
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpUtime --
+ *
+ *	Check if the file named in the pathObj is owned by the current user.
+ *
+ * Results:
+ *	Boolean: true if the file exists, is accessible and is owned by the
+ *	current user. BUG 3613671: not implemented yet.
+ *
+ * Side effects:
+ *	pathObj may be converted to path type.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclpFileOwnedByCurrentUser(
+    Tcl_Interp *interp,
+    Tcl_Obj *pathObj)
+{
+    if (Tcl_FSConvertToPathType(NULL, pathObj) != TCL_OK) {
+	return 0;
+    }
+    return (Tcl_FSAccess(pathObj, F_OK) == 0);
+}
 
 /*
  * Local Variables:
-- 
cgit v0.12