diff options
| -rw-r--r-- | generic/tclFCmd.c | 20 | ||||
| -rw-r--r-- | tests/fileName.test | 16 | ||||
| -rw-r--r-- | tests/tcltest.test | 6 | ||||
| -rw-r--r-- | tests/winFCmd.test | 8 | ||||
| -rw-r--r-- | win/tclWinFile.c | 58 |
5 files changed, 72 insertions, 36 deletions
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index bb814ea..0f0f5da 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -363,14 +363,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 @@ -406,13 +399,20 @@ 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. */ - + result = TCL_ERROR; break; } } diff --git a/tests/fileName.test b/tests/fileName.test index ce89623..7f983a7 100644 --- a/tests/fileName.test +++ b/tests/fileName.test @@ -778,6 +778,8 @@ test filename-11.16 {Tcl_GlobCmd} { } {globTest} set globname "globTest" set horribleglobname "glob\[\{Test" +set tildeglobname "./~test.txt" + test filename-11.17 {Tcl_GlobCmd} {unix} { lsort [glob -directory $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -917,11 +919,12 @@ test filename-11.21.1 {Tcl_GlobCmd} -body { } -result {{[tcl].testremains}} # 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} { lsort [glob -dir $globname *] } [lsort [list [file join $globname a1] [file join $globname a2]\ @@ -1040,7 +1043,9 @@ test filename-11.41 {Tcl_GlobCmd} -body { test filename-11.42 {Tcl_GlobCmd} -body { 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 } list $res [glob *] } -match compareWords -result equal @@ -1080,8 +1085,9 @@ test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body { } -result {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} { glob {} diff --git a/tests/tcltest.test b/tests/tcltest.test index 728a018..17fa926 100644 --- a/tests/tcltest.test +++ b/tests/tcltest.test @@ -550,6 +550,7 @@ 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 0 $notWriteableDir} } @@ -566,9 +567,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 a808c82..0e5ef38 100644 --- a/tests/winFCmd.test +++ b/tests/winFCmd.test @@ -1078,6 +1078,14 @@ test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup { } -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} -body { string tolower [file attributes //bisque/tcl/ws -longname] } -constraints {nonPortable win} -result {//bisque/tcl/ws} diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 7586af1..4525d8a 100644 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -1561,11 +1561,12 @@ 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 @@ -1573,21 +1574,38 @@ NativeAccess( * advanced 'getFileSecurityProc', 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. */ } /* @@ -1792,10 +1810,12 @@ NativeIsExec( return 0; } - if ((_tcsicmp(path+len-3, TEXT("exe")) == 0) - || (_tcsicmp(path+len-3, TEXT("com")) == 0) - || (_tcsicmp(path+len-3, TEXT("cmd")) == 0) - || (_tcsicmp(path+len-3, TEXT("bat")) == 0)) { + path += len-3; + if ((_tcsicmp(path, TEXT("exe")) == 0) + || (_tcsicmp(path, TEXT("com")) == 0) + || (_tcsicmp(path, TEXT("cmd")) == 0) + || (_tcsicmp(path, TEXT("cmd")) == 0) + || (_tcsicmp(path, TEXT("bat")) == 0)) { return 1; } return 0; |