diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/winFCmd.test | 4 | ||||
| -rw-r--r-- | tests/winFile.test | 119 |
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 |