texlive[53801] Master: Real test for writability of directory rather
commits+siepo at tug.org
commits+siepo at tug.org
Sun Feb 16 13:25:29 CET 2020
Revision: 53801
http://tug.org/svn/texlive?view=revision&revision=53801
Author: siepo
Date: 2020-02-16 13:25:29 +0100 (Sun, 16 Feb 2020)
Log Message:
-----------
Real test for writability of directory rather than 'file writable'
Modified Paths:
--------------
trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
trunk/Master/tlpkg/installer/install-tl-gui.tcl
trunk/Master/tlpkg/tltcl/tltcl.tcl
Modified: trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl
===================================================================
--- trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2020-02-16 11:58:25 UTC (rev 53800)
+++ trunk/Master/texmf-dist/scripts/tlshell/tlshell.tcl 2020-02-16 12:25:29 UTC (rev 53801)
@@ -1,6 +1,6 @@
#!/usr/bin/env wish
-# Copyright 2017-2019 Siep Kroonenberg
+# Copyright 2017-2020 Siep Kroonenberg
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -85,7 +85,7 @@
file mkdir ${::instroot}/temp
set dbg [open "${::instroot}/temp/mydbglog" a]
puts $dbg "TCL: $s"
- close $dbg
+ chan close $dbg
# Track debug output in the log dialog if it is running:
if [winfo exists .tllg.dbg.tx] {
.tllg.dbg.tx configure -state normal
@@ -107,7 +107,7 @@
# create empty file. although we just want a name,
# we must make sure that it can be created.
set fid [open $fname w]
- close $fid
+ chan close $fid
if {! [file exists $fname]} {error "Cannot create temporary file"}
if {$::tcl_platform(platform) eq "unix"} {
file attributes $fname -permissions 0600
@@ -2390,7 +2390,7 @@
populate_main
# testing writablilty earlier led to sizing problems
- if {! [file writable $::instroot]} {
+ if {! [dir_writable $::instroot]} {
set ans [tk_messageBox -type yesno -icon warning -message \
[__ "%s is not writable. You can probably not do much.
Are you sure you want to continue?" $::instroot]]
Modified: trunk/Master/tlpkg/installer/install-tl-gui.tcl
===================================================================
--- trunk/Master/tlpkg/installer/install-tl-gui.tcl 2020-02-16 11:58:25 UTC (rev 53800)
+++ trunk/Master/tlpkg/installer/install-tl-gui.tcl 2020-02-16 12:25:29 UTC (rev 53801)
@@ -1,6 +1,6 @@
#!/usr/bin/env wish
-# Copyright 2018, 2019 Siep Kroonenberg
+# Copyright 2018-2020 Siep Kroonenberg
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -1177,6 +1177,7 @@
### symlinks into standard directories ###
# 'file writable' is only a check of unix permissions
+ # use proc dir_writable instead
proc dest_ok {d} {
if {$d eq ""} {return 0}
set its 1
@@ -1184,7 +1185,7 @@
if [file exists $d] {
if {! [file isdirectory $d]} {
return 0
- } elseif {! [file writable $d]} {
+ } elseif {! [dir_writable $d]} {
return 0
} else {
return 1
Modified: trunk/Master/tlpkg/tltcl/tltcl.tcl
===================================================================
--- trunk/Master/tlpkg/tltcl/tltcl.tcl 2020-02-16 11:58:25 UTC (rev 53800)
+++ trunk/Master/tlpkg/tltcl/tltcl.tcl 2020-02-16 12:25:29 UTC (rev 53801)
@@ -1,6 +1,6 @@
#!/usr/bin/env wish
-# Copyright 2018 Siep Kroonenberg
+# Copyright 2018-2020 Siep Kroonenberg
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -543,6 +543,28 @@
return $r
}
+# test whether a directory is writable.
+# 'file writable' merely tests permissions, which may not be good enough
+proc dir_writable {d} {
+ for {set x 0} {$x<100} {incr x} {
+ set y [expr {int(10000*rand())}]
+ set newfile [file join $::instroot $y]
+ if [file exists $newfile] {
+ continue
+ } else {
+ set fid [open $newfile w]
+ chan close $fid
+ if [file exists $newfile] {
+ file delete $newfile
+ return 1
+ } else {
+ return 0
+ }
+ }
+ }
+ return 0
+}
+
# unix: choose_dir replacing native directory browser
if {$::tcl_platform(platform) eq "unix"} {
More information about the tex-live-commits
mailing list.