From e59347aca80cd4e89dac4bea20bed1e42b090418 Mon Sep 17 00:00:00 2001
From: vincentdarley <vincentdarley>
Date: Tue, 9 Dec 2003 14:57:18 +0000
Subject: NT file permissions fix and tests

---
 ChangeLog          |   8 ++++
 tests/winFCmd.test |   4 +-
 tests/winFile.test | 119 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 win/tclWinFile.c   |  16 +++----
 4 files changed, 137 insertions(+), 10 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 3d7e7b2..7afbb8b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2003-12-09  Vince Darley  <vincentdarley@users.sourceforge.net>
+
+	* win/tclWinFile.c: fix to NT file permissions code [Bug 855923]
+	* tests/winFile.test: added tests for NT file permissions - patch
+	and test scripts supplied by Benny.
+	
+	* tests/winFCmd.test: fixed one test for when not running in C:/
+	
 2003-12-02  Donal K. Fellows  <donal.k.fellows@man.ac.uk>
 
 	* generic/tclBinary.c (DeleteScanNumberCache, ScanNumber): Made
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 87c260d..5f0ff6a 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winFCmd.test,v 1.24 2003/11/21 18:47:59 dgp Exp $
+# RCS: @(#) $Id: winFCmd.test,v 1.25 2003/12/09 14:57:18 vincentdarley Exp $
 #
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
@@ -610,7 +610,7 @@ test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {pcOnly nt} {
     # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
     # decision has been made as to which is correct.
     regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST"
-} {1 {C:/ EACCES or EEXIST}}
+} [list 1 [list [file norm /] EACCES or EEXIST]]
 test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {pcOnly 95} {
     cleanup
     createfile tf1
diff --git a/tests/winFile.test b/tests/winFile.test
index 3f4c294..d19e5d6 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -10,13 +10,23 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: winFile.test,v 1.10 2003/04/11 16:00:05 vincentdarley Exp $
+# RCS: @(#) $Id: winFile.test,v 1.11 2003/12/09 14:57:18 vincentdarley Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+if {[info commands ::testvolumetype] == ""} {
+    tcltest::testConstraint notNTFS 0
+} else {
+    if {![string equal "NTFS" [testvolumetype]]} {
+	tcltest::testConstraint notNTFS 0
+    } else {
+	tcltest::testConstraint notNTFS 1
+    }
+}
+
 test winFile-1.1 {TclpGetUserHome} {pcOnly} {
     list [catch {glob ~nosuchuser} msg] $msg
 } {1 {user "nosuchuser" doesn't exist}}
@@ -78,6 +88,113 @@ test winFile-3.1 {file system} {pcOnly} {
     set res
 } {volume types ok}
 
+proc cacls {fname args} {
+    string trim [eval [list exec cacls [file nativename $fname]] $args <<y]
+}
+
+# dir/q output:
+# 2003-11-03  20:36                  598 OCTAVIAN\benny         filename.txt
+proc getuser {fname} {
+    set tryname $fname
+    if {[file isdirectory $fname]} {
+	set tryname [file dirname $fname]
+    }
+    set tail [file tail $tryname]
+    set dirtext [exec cmd /c dir /q [file nativename $fname]]
+    set owner ""
+    foreach line [split $dirtext "\n"] {
+	if {[string match -nocase "* $tail" $line]} {
+	    set attrs [string range $line \
+	      0 end-[string length $tail]]
+	    regexp { [A-Z]+\\.*$} $attrs owner
+	    set owner [string trim $owner]
+	}
+    }
+    if {"" == "$owner"} {
+	error "getuser: Owner not found in output of dir/q"
+    }
+    return $owner
+}
+
+proc test_read {fname} {
+    if {[catch {set ifs [open $fname r]}]} {
+	return 0
+    }
+    set readfailed [catch {read $ifs}]
+    return [expr {![catch {close $ifs}] && !$readfailed}]
+}
+
+proc test_writ {fname} {
+    if {[catch {set ofs [open $fname w]}]} {
+	return 0
+    }
+    set writefailed [catch {puts $ofs "Hello"}]
+    return [expr {![catch {close $ofs}] && !$writefailed}]
+}
+
+proc test_access {fname read writ} {
+    set problem {}
+    foreach type {read writ} {
+	if {[set $type] != [file ${type}able $fname]} {
+	    lappend problem "[set $type] != \[file ${type}able $fname\]"
+	}
+	if {[set $type] != [test_${type} $fname]} {
+	    lappend problem "[set $type] != \[test_${type} $fname\]"
+	}
+    }
+    if {[llength $problem]} {
+	return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
+    } else {
+	return ""
+    }
+}
+
+# Create the test file
+set fname test.dat
+file delete $fname
+close [open $fname w]
+set owner [getuser $fname]
+set user $::env(USERDOMAIN)\\$::env(USERNAME)
+
+test winFile-4.0 {Enhanced NTFS user/group permissions: test no acccess} {notNTFS pcOnly nt} {
+    # Clean out all well-known ACLs
+    catch {cacls $fname /E /R "Everyone"} result
+    catch {cacls $fname /E /R $user} result
+    catch {cacls $fname /E /R $owner} result
+    cacls $fname /E /P $user:N
+    test_access $fname 0 0
+} {}
+
+test winFile-4.1 {Enhanced NTFS user/group permissions: test readable only} {notNTFS pcOnly nt} {
+    cacls $fname /E /P $user:N
+    cacls $fname /E /G $user:R
+    test_access $fname 1 0
+} {}
+
+test winFile-4.2 {Enhanced NTFS user/group permissions: test writable only} {notNTFS pcOnly nt} {
+    catch {cacls $fname /E /R $user} result
+    cacls $fname /E /P $user:N
+    cacls $fname /E /G $user:W
+    test_access $fname 0 1
+} {}
+
+test winFile-4.3 {Enhanced NTFS user/group permissions: test read+write} {notNTFS pcOnly nt} {
+    catch {cacls $fname /E /R $user} result
+    cacls $fname /E /P $user:N
+    cacls $fname /E /G $user:R
+    cacls $fname /E /G $user:W
+    test_access $fname 1 1
+} {}
+
+test winFile-4.4 {Enhanced NTFS user/group permissions: test full access} {notNTFS pcOnly nt} {
+    catch {cacls $fname /E /R $user} result
+    cacls $fname /E /P $user:N
+    cacls $fname /E /G $user:F
+    test_access $fname 1 1
+} {}
+
+file delete $fname
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index f787669..548fd65 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclWinFile.c,v 1.55 2003/10/13 16:48:07 vincentdarley Exp $
+ * RCS: @(#) $Id: tclWinFile.c,v 1.56 2003/12/09 14:57:18 vincentdarley Exp $
  */
 
 //#define _WIN32_WINNT  0x0500
@@ -1413,22 +1413,24 @@ NativeAccess(nativePath, mode)
 	    goto accessError;
 	}
 	(*tclWinProcs->revertToSelfProc)();
+	
 	memset (&genMap, 0x00, sizeof (GENERIC_MAPPING));
+	
 	/* 
-	 * Fill GenericMask type according to access priveleges
-	 * we are checking.
+	 * Setup desiredAccess according to the access priveleges we
+	 * are checking.
 	 */
 	genMap.GenericAll = 0;
 	if (mode & R_OK) {
-	    genMap.GenericRead = FILE_GENERIC_READ;
+	    desiredAccess |= FILE_GENERIC_READ;
 	}
 	if (mode & W_OK) {
-	    genMap.GenericWrite = FILE_GENERIC_WRITE;
+	    desiredAccess |= FILE_GENERIC_WRITE;
 	}
 	if (mode & X_OK) {
-	    genMap.GenericExecute = FILE_GENERIC_EXECUTE;
+	    desiredAccess |= FILE_GENERIC_EXECUTE;
 	}
-	(*tclWinProcs->mapGenericMaskProc)(&desiredAccess, &genMap);
+
 	/* 
 	 * Perform access check using the token. 
 	 */
-- 
cgit v0.12