From 570af6354743c6365032517ef0ecfa8645b3ade7 Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 22 Mar 2018 16:22:04 +0000 Subject: win: fixes check of file permissions (readable, writable, executable) - more faster and stable solution without direct check of security permissions by optimal terms; additionally corrected executable extensions (missing .ps1/.cmd) in useWide case. --- win/tclWinFile.c | 59 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 40 insertions(+), 19 deletions(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index e671058..be31541 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1576,33 +1576,51 @@ NativeAccess( return 0; } - if ((mode & W_OK) - && (attr & FILE_ATTRIBUTE_READONLY) - && !(attr & FILE_ATTRIBUTE_DIRECTORY)) { + /* + * If it's not a directory (assume file), do several fast checks: + */ + if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) { /* - * The attributes say the file is not writable. If the file is a + * If the attributes say this is not writable at all. The file is a * regular file (i.e., not a directory), then the file is not * writable, full stop. For directories, the read-only bit is * (mostly) ignored by Windows, so we can't ascertain anything about * directory access from the attrib data. However, if we have the - * advanced 'getFileSecurityProc', then more robust ACL checks + * advanced 'getNamedSecurityInfoProc', then more robust ACL checks * will be done below. */ + if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { + Tcl_SetErrno(EACCES); + return -1; + } - Tcl_SetErrno(EACCES); - return -1; - } - - if (mode & X_OK) { - if (!(attr & FILE_ATTRIBUTE_DIRECTORY) && !NativeIsExec(nativePath)) { - /* - * It's not a directory and doesn't have the correct extension. - * Therefore it can't be executable - */ - + /* If doesn't have the correct extension, it can't be executable */ + if ((mode & X_OK) && !NativeIsExec(nativePath)) { Tcl_SetErrno(EACCES); return -1; } + /* Special case for read/write/executable check on file */ + if ((mode & (R_OK|W_OK|X_OK)) && !(mode & ~(R_OK|W_OK|X_OK))) { + DWORD mask = 0; + HANDLE hFile; + if (mode & R_OK) { mask |= GENERIC_READ; } + if (mode & W_OK) { mask |= GENERIC_WRITE; } + if (mode & X_OK) { mask |= GENERIC_EXECUTE; } + + hFile = (tclWinProcs->createFileProc)(nativePath, mask, + FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, + OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); + if (hFile != INVALID_HANDLE_VALUE) { + CloseHandle(hFile); + return 0; + } + /* fast exit if access was denied */ + if (GetLastError() == ERROR_ACCESS_DENIED) { + Tcl_SetErrno(EACCES); + return -1; + } + } + /* We cannnot verify the access fast, check it below using security info. */ } /* @@ -1811,9 +1829,12 @@ NativeIsExec( * Use wide-char case-insensitive comparison */ - if ((_wcsicmp(path+len-3, L"exe") == 0) - || (_wcsicmp(path+len-3, L"com") == 0) - || (_wcsicmp(path+len-3, L"bat") == 0)) { + path += len-3; + if ((_wcsicmp(path, L"exe") == 0) + || (_wcsicmp(path, L"com") == 0) + || (_wcsicmp(path, L"cmd") == 0) + || (_wcsicmp(path, L"ps1") == 0) + || (_wcsicmp(path, L"bat") == 0)) { return 1; } } else { -- cgit v0.12 From da169b1600f14d5ab924ceefb6383c2a0062e80d Mon Sep 17 00:00:00 2001 From: sebres Date: Thu, 22 Mar 2018 17:45:32 +0000 Subject: minor fix on comment (restored getFileSecurityProc back, because getNamedSecurityInfoProc not used) --- win/tclWinFile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index be31541..8fc0b8e 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1586,7 +1586,7 @@ NativeAccess( * writable, full stop. For directories, the read-only bit is * (mostly) ignored by Windows, so we can't ascertain anything about * directory access from the attrib data. However, if we have the - * advanced 'getNamedSecurityInfoProc', then more robust ACL checks + * advanced 'getFileSecurityProc', then more robust ACL checks * will be done below. */ if ((mode & W_OK) && (attr & FILE_ATTRIBUTE_READONLY)) { -- cgit v0.12 From 9077b8ce60cdb2f2b4f9f4dc518cc8bf4d8268b5 Mon Sep 17 00:00:00 2001 From: sebres Date: Fri, 6 Apr 2018 17:28:56 +0000 Subject: =?UTF-8?q?[27b682284974d0cd]=20command=20"file=20delete":=20avoid?= =?UTF-8?q?=20possible=20race=20condition=20if=20file/directory=20deleted?= =?UTF-8?q?=20after=20call=20of=20lstat,=20so=20bypass=20ENOENT=20error=20?= =?UTF-8?q?code.=20Thanks=20to=20Rainer=20M=C3=BCller=20(aka=20raimue)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- generic/tclFCmd.c | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index c52cd1e..5b2fbe1 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -373,14 +373,7 @@ TclFileDeleteCmd( */ if (Tcl_FSLstat(objv[i], &statBuf) != 0) { - /* - * Trying to delete a file that does not exist is not considered - * an error, just a no-op - */ - - if (errno != ENOENT) { - result = TCL_ERROR; - } + result = TCL_ERROR; } else if (S_ISDIR(statBuf.st_mode)) { /* * We own a reference count on errorBuffer, if it was set as a @@ -416,9 +409,16 @@ TclFileDeleteCmd( } if (result != TCL_OK) { - result = TCL_ERROR; /* + * Avoid possible race condition (file/directory deleted after call + * of lstat), so bypass ENOENT because not an error, just a no-op + */ + if (errno == ENOENT) { + result = TCL_OK; + continue; + } + /* * It is important that we break on error, otherwise we might end * up owning reference counts on numerous errorBuffers. */ -- cgit v0.12 From 24a04c081909c75252c8def939e0473206550302 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Apr 2018 10:04:23 +0000 Subject: amend to [5acb57c7aec45e05]: set code to TCL_ERROR, because primitives from tclIOUtil return -1 --- generic/tclFCmd.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index 5b2fbe1..1363829 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -422,7 +422,7 @@ TclFileDeleteCmd( * It is important that we break on error, otherwise we might end * up owning reference counts on numerous errorBuffers. */ - + result = TCL_ERROR; break; } } -- cgit v0.12 From a9ef86f152a4cda4acf25dbb79dbd9cd18449458 Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 9 Apr 2018 19:50:12 +0000 Subject: win: fix several test-cases for windows platform --- tests/fileName.test | 14 +++++++++----- tests/tcltest.test | 8 +++++--- tests/winFCmd.test | 48 +++++++++++++++++++++++++++++++++--------------- 3 files changed, 47 insertions(+), 23 deletions(-) diff --git a/tests/fileName.test b/tests/fileName.test index d224011..0851e94 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -770,6 +770,7 @@ test filename-11.16 {Tcl_GlobCmd} { set globname "globTest" set horribleglobname "glob\[\{Test" +set tildeglobname "./~test.txt" test filename-11.17 {Tcl_GlobCmd} {unix} { list [catch {lsort [glob -directory $globname *]} msg] $msg @@ -940,11 +941,11 @@ test filename-11.21.1 {Tcl_GlobCmd} { # Get rid of file/dir if it exists, since it will have # been left behind by a previous failed run. -if {[file exists $horribleglobname]} { - file delete -force $horribleglobname -} +file delete -force $horribleglobname file rename globTest $horribleglobname set globname $horribleglobname +file delete -force $tildeglobname +close [open $tildeglobname w] test filename-11.22 {Tcl_GlobCmd} {unix} { list [catch {lsort [glob -dir $globname *]} msg] $msg @@ -1067,7 +1068,9 @@ test filename-11.41 {Tcl_GlobCmd} { test filename-11.42 {Tcl_GlobCmd} { set res [list] foreach f [glob -dir [pwd] *] { - lappend res [file tail $f] + set f [file tail $f] + regsub {^./} $f {} f; # until glob bug [2511011fff] don't fixed (tilde expansion prevention). + lappend res $f } expr {$res == [glob *]} } {1} @@ -1109,8 +1112,9 @@ test filename-11.49 {Tcl_GlobCmd} { } {1 {bad argument to "-types": abcde}} file rename $horribleglobname globTest +file delete -force $tildeglobname set globname globTest -unset horribleglobname +unset horribleglobname tildeglobname test filename-12.1 {simple globbing} {unixOrPc} { list [catch {glob {}} msg] $msg diff --git a/tests/tcltest.test b/tests/tcltest.test index ce8d617..d513856 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -549,8 +549,9 @@ switch -- $::tcl_platform(platform) { file attributes $notWriteableDir -permissions 00555 } default { + # note in FAT/NTFS we won't be able to protect directory with read-only attribute... catch {file attributes $notWriteableDir -readonly 1} - catch {testchmod 000 $notWriteableDir} + catch {testchmod 0 $notWriteableDir} } } test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { @@ -565,9 +566,10 @@ test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} { # This constraint doesn't go at the top of the file so that it doesn't # interfere with tcltest-5.5 testConstraint notFAT [expr { - ![string match "FAT*" [lindex [file system $notWriteableDir] 1]] + ![regexp {^(FAT\d*|NTFS)$} [lindex [file system $notWriteableDir] 1]] + || $::tcl_platform(platform) eq "unix" || [llength [info commands testchmod]] }] -# FAT permissions are fairly hopeless; ignore this test if that FS is used +# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} { -constraints {unixOrPc notRoot notFAT} -body { diff --git a/tests/winFCmd.test b/tests/winFCmd.test index f0cb406..b3fd921 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -17,6 +17,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Initialise the test constraints +testConstraint winVista 0 +testConstraint winXP 0 testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testfile [llength [info commands testfile]] testConstraint testchmod [llength [info commands testchmod]] @@ -50,20 +52,25 @@ proc cleanup {args} { } } +if {[testConstraint win]} { + set major [string index $tcl_platform(osVersion) 0] + if {$major > 5} { + testConstraint winVista 1 + } elseif {$major == 5} { + testConstraint winXP 1 + } +} + # find a CD-ROM so we can test read-only filesystems. proc findfile {dir} { - foreach p [glob -directory $dir *] { - if {[file type $p] == "file"} { - return $p - } + foreach p [glob -nocomplain -type f -directory $dir *] { + return $p } - foreach p [glob -directory $dir *] { - if {[file type $p] == "directory"} { - set f [findfile $p] - if {$f != ""} { - return $f - } + foreach p [glob -nocomplain -type d -directory $dir *] { + set f [findfile $p] + if {$f ne ""} { + return $f } } return "" @@ -71,7 +78,7 @@ proc findfile {dir} { if {[testConstraint testvolumetype]} { foreach p {d e f g h i j k l m n o p q r s t u v w x y z} { - if {![catch {testvolumetype ${p}:} result] && $result eq "CDFS"} { + if {![catch {testvolumetype ${p}:} result] && $result in {CDFS UDF}} { set cdrom ${p}: set cdfile [findfile $cdrom] testConstraint cdrom 1 @@ -893,11 +900,22 @@ test winFCmd-12.4 {ConvertFileNameFormat} {win} { test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {win} { list [file attributes / -longname] [file attributes \\ -longname] } {/ /} -test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {win} { +test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { catch {file delete -force -- c:/td1} - close [open c:/td1 w] - list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1] -} {0 c:/td1 {}} +} -constraints {win winXP} -body { + createfile c:/td1 {} + string tolower [file attributes c:/td1 -longname] +} -cleanup { + file delete -force -- c:/td1 +} -result {c:/td1} +test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup { + catch {file delete -force -- $::env(TEMP)/td1} +} -constraints {win} -body { + createfile $::env(TEMP)/td1 {} + string tolower [file attributes $::env(TEMP)/td1 -longname] +} -cleanup { + file delete -force -- $::env(TEMP)/td1 +} -result [string tolower [file normalize $::env(TEMP)]/td1] test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable win} { string tolower [file attributes //bisque/tcl/ws -longname] } {//bisque/tcl/ws} -- cgit v0.12 From 9856afd5903e2aec8bed684abb91fe307cd20765 Mon Sep 17 00:00:00 2001 From: sebres Date: Wed, 11 Apr 2018 11:28:41 +0000 Subject: win: some test-cases missing constraint for testexcept (if compiled without test) --- tests/winPipe.test | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/winPipe.test b/tests/winPipe.test index 3f983e1..f993e0c 100644 --- a/tests/winPipe.test +++ b/tests/winPipe.test @@ -21,6 +21,7 @@ set bindir [file join [pwd] [file dirname [info nameofexecutable]]] set cat32 [file join $bindir cat32.exe] testConstraint exec [llength [info commands exec]] +testConstraint testexcept [llength [info commands testexcept]] testConstraint cat32 [file exists $cat32] testConstraint AllocConsole [catch {puts console1 ""}] testConstraint RealConsole [expr {![testConstraint AllocConsole]}] @@ -193,28 +194,28 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} { vwait x list $result $x [contents $path(stderr)] } "{$big} 1 stderr32" -test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} { +test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept float_underflow" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGFPE} -test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} { +test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept access_violation" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGSEGV} -test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} { +test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept illegal_instruction" set status [catch {close $f}] list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2] } {1 1 SIGILL} -test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} { +test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} { set f [open "|[list [interpreter]]" w+] set pid [pid $f] puts $f "testexcept ctrl+c" -- cgit v0.12 From debcb2bf0157aa00be72330199c44e4d38a4b0ab Mon Sep 17 00:00:00 2001 From: sebres Date: Mon, 30 Apr 2018 11:52:12 +0000 Subject: amend after merge 8.5 --- win/tclWinFile.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 4525d8a..9afe0a9 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1592,7 +1592,7 @@ NativeAccess( if (mode & W_OK) { mask |= GENERIC_WRITE; } if (mode & X_OK) { mask |= GENERIC_EXECUTE; } - hFile = (tclWinProcs->createFileProc)(nativePath, mask, + hFile = CreateFile(nativePath, mask, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, NULL, OPEN_EXISTING, FILE_FLAG_NO_BUFFERING, NULL); if (hFile != INVALID_HANDLE_VALUE) { -- cgit v0.12 From 0fc27b893e12027a6b5136fb96ba216b823f43e1 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 30 Apr 2018 12:11:14 +0000 Subject: Contain platform-specific things in the constraint-controlled parts of the test. --- tests/winFCmd.test | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/winFCmd.test b/tests/winFCmd.test index b3fd921..1b2b042 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -912,10 +912,11 @@ test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp fo catch {file delete -force -- $::env(TEMP)/td1} } -constraints {win} -body { createfile $::env(TEMP)/td1 {} - string tolower [file attributes $::env(TEMP)/td1 -longname] + string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \ + [string tolower [file normalize $::env(TEMP)]/td1]] } -cleanup { file delete -force -- $::env(TEMP)/td1 -} -result [string tolower [file normalize $::env(TEMP)]/td1] +} -result 1 test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable win} { string tolower [file attributes //bisque/tcl/ws -longname] } {//bisque/tcl/ws} -- cgit v0.12