summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/winFCmd.test4
-rw-r--r--tests/winFile.test119
2 files changed, 120 insertions, 3 deletions
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