Tcl Library Source Code

The current implementation of fileutil::MakeTempDir (version 1.18) makes
use of the "-permissions" option of [file attributes], which is not
supported under MS Windows. This causes fileutils::maketempdir to break under
Windows.
A suggested fix is to first check whether the OS is UNIX, as in the modified (patch-like) version below:

proc ::fileutil::MakeTempDir {config} {
    # Setup of default configuration.
    array set options {}
    set options(-suffix) ""
    set options(-prefix) "tmp"
    set options(-dir)    [tempdir]

    # TODO: Check for and reject options not in -suffix, -prefix, -dir
    # Merge user configuration, overwrite defaults.
    array set options $config

    # See also "tempfile" below. Could be shareable internal configuration.
    set chars abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
    set nrand_chars 10
    set maxtries    10

    for {set i 0} {$i < $maxtries} {incr i} {
	# Build up the candidate name. See also "tempfile".
	set directory_name $options(-prefix)
	for {set j 0} {$j < $nrand_chars} {incr j} {
	    append directory_name \
		[string index $chars [expr {int(rand() * 62)}]]
	}
	append directory_name $options(-suffix)
	set path [file join $options(-dir) $directory_name]

	# Try to create. Try again if already exists, or trouble
	# with creation and setting of perms.
	#
	# Note: The last looks as if it is able to leave partial
	# directories behind (created, trouble with perms). But
	# deleting ... Might pull the rug out from somebody else.

	if {[file exists $path]} continue
	if {[catch {
	    file mkdir $path
-           file attributes $path -permissions 0700
+           if {$::tcl_platform(platform) eq "unix"} {
+              file attributes $path -permissions 0700
+           }
	}]} continue

	return $path
    }
    return -code error "Failed to find an unused temporary directory name"
}

Done with commit [d1f2984e]

Bumped to version 1.16.1

Thanks for your patience.

Assigning to self.

Affects me too.