Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch ak-fix-traverse-symlinks Excluding Merge-Ins
This is equivalent to a diff from d9d86cd9ff to 4599fe667f
2014-11-27
| ||
01:09 | fileutil 1.14.9 - Fixed issue with symlink handling of the "find" command. While the original code broke cycles it also broke (i.e. skipped) non-cycle symlinks. The new code breaks only cycles. fileutil::traverse 0.4.4 - Ditto. Updated tests, docs. No ticket associated with this. check-in: e4cc97ecc8 user: aku tags: trunk | |
00:54 | Updated version information in the package index as well, and updated the documentation. This is now ready for merging. Closed-Leaf check-in: 4599fe667f user: andreask tags: ak-fix-traverse-symlinks | |
00:10 | Confirmed same issue for fileutil(::find). Test added, fixed buglet in expected output. check-in: 935565ca7e user: andreask tags: ak-fix-traverse-symlinks | |
00:04 | Extended testsuite of fileutil::traverse demonstrating a problem with its symlink handling. While it properly breaks cycles, it can also break non-cycle links if the referenced path is handled before the link. And vice versa, if the link is handled the non-link path is not traversed. The fileutil package's find command is likely affected in the same manner. Opened branch to fix this. check-in: e3bc24a81e user: andreask tags: ak-fix-traverse-symlinks | |
2014-11-25
| ||
14:50 | Create branch for working on modules for JSON Web Token (JWT) support. Leaf check-in: 783e8f3bf8 user: neilmadden tags: nmadden-json-web-token | |
2014-11-19
| ||
04:49 | Get lastest from trunk check-in: 24cd9d7b26 user: aku tags: nettool | |
04:29 | Merged pooryorick's original work and branch check-in: d9d86cd9ff user: aku tags: trunk | |
01:09 | Ticket [ba3b0d913c] - Extended configure(.in) to enable specification of the path to the tclsh to use. Thanks to pooryorick for the patch. check-in: 262292fc92 user: andreask tags: trunk | |
2014-11-14
| ||
23:34 | add --with-tclsh to configure, see issue ba3b0d91 Closed-Leaf check-in: e08de35f0a user: pooryorick tags: pyk-withtclsh-ba3b0d91 | |
Changes to modules/fileutil/fileutil.man.
|
| | | 1 2 3 4 5 6 7 8 | [vset PACKAGE_VERSION 1.14.9] [comment {-*- tcl -*- doctools manpage}] [manpage_begin fileutil n [vset PACKAGE_VERSION]] [keywords cat] [keywords {file utilities}] [keywords grep] [keywords {temp file}] [keywords test] |
︙ | ︙ |
Changes to modules/fileutil/fileutil.tcl.
︙ | ︙ | |||
9 10 11 12 13 14 15 | # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: fileutil.tcl,v 1.78 2010/06/17 04:46:19 andreas_kupries Exp $ package require Tcl 8.2 package require cmdline | | | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: fileutil.tcl,v 1.78 2010/06/17 04:46:19 andreas_kupries Exp $ package require Tcl 8.2 package require cmdline package provide fileutil 1.14.9 namespace eval ::fileutil { namespace export \ grep find findByPattern cat touch foreachLine \ jail stripPwd stripN stripPath tempdir tempfile \ install fileType writeFile appendToFile \ insertIntoFile removeFromFile replaceInFile \ |
︙ | ︙ | |||
109 110 111 112 113 114 115 | # handled by _fully_ normalizing directory paths and checking # if we encountered the normalized form before. The array # 'known' is our cache where we record the known normalized # paths. set pending [list $basedir] set at 0 | | > > | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | # handled by _fully_ normalizing directory paths and checking # if we encountered the normalized form before. The array # 'known' is our cache where we record the known normalized # paths. set pending [list $basedir] set at 0 array set parent {} array set norm {} Enter {} $basedir while {$at < [llength $pending]} { # Get next directory not yet processed. set current [lindex $pending $at] incr at # Is the directory accessible? Continue if not. |
︙ | ︙ | |||
140 141 142 143 144 145 146 | # Detection of symlink loops via a portable path # normalization computing a canonical form of the path # followed by a check if that canonical form was # encountered before. If ok, record directory for # expansion in future iterations. | | | < > > > > > > > > > > > > > > > > > | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 | # Detection of symlink loops via a portable path # normalization computing a canonical form of the path # followed by a check if that canonical form was # encountered before. If ok, record directory for # expansion in future iterations. Enter $current $f if {[Cycle $f]} continue lappend pending $f } } } else { return -code error "$basedir does not exist" } return $result } proc ::fileutil::Enter {parent path} { upvar 1 parent _parent norm _norm set _parent($path) $parent set _norm($path) [fileutil::fullnormalize $path] } proc ::fileutil::Cycle {path} { upvar 1 parent parent _norm _norm set nform $_norm($path) set paren $_parent($path) while {$paren ne {}} { if {$_norm($paren) eq $nform} { return yes } set paren $_parent($paren) } return no } # Helper command for fileutil::find. Performs the filtering of the # result per a filter command for the candidates found by the # traversal core, see above. This is portable. proc ::fileutil::FADD {filename} { upvar 1 result result filt filt filtercmd filtercmd |
︙ | ︙ |
Changes to modules/fileutil/find.setup.
︙ | ︙ | |||
211 212 213 214 215 216 217 218 219 220 221 222 223 224 | proc f_setupdot {} { makeDirectory dotfiles makeFile "" [file join dotfiles foo] makeFile "" [file join dotfiles .foo] return } proc f_cleanupdot {} { removeDirectory dotfiles return } proc f_setupnostat {} { | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | proc f_setupdot {} { makeDirectory dotfiles makeFile "" [file join dotfiles foo] makeFile "" [file join dotfiles .foo] return } # Complex directory tree with DAG-links and circular links. We want to # break the latter, but not the former. I.e. DAG-links allow us to # find a file by multiple paths, and we wish to see these all. # # Paths Links Seen Broken Why # dir/a | a # dir/b | a/c # dir/a/c | a/c/g == a # dir/a/d | a/c/h # dir/a/c/g --> .. | a/c/h/e == c # dir/a/c/h --> ../../b | a/c/h/f # dir/a/c/i | a/c/i # dir/b/e --> ../a/c | a/d # dir/b/f | b # | b/e # | b/e/g # | b/e/g/c # | b/e/g/c/g == b/e/g # | b/e/g/c/h == b # | b/e/g/d # | b/e/h == b # | b/e/i # | b/f proc pathmap {args} { set res {} foreach p $args { lappend res [tempPath $p] } return $res } proc f_setupcircle3 {} { makeDirectory z/a makeDirectory z/a/c makeDirectory z/b makeFile "" z/a/d makeFile "" z/a/c/i makeFile "" z/b/f f_link z/a/c/g ../../a f_link z/a/c/h ../../b f_link z/b/e ../a/c return } proc f_cleanup3 {} { # Remove sym links first. Not doing this causes the file delete for # the directory to fail (on Windows, Unix would have been fine). catch { removeFile z/a/c/g } catch { removeFile z/a/c/h } catch { removeFile z/b/e } removeDirectory z return } proc f_link {src target} { # Added use of 'file link' for Tcl 8.4+, on windows, to have a # modicum of x-platform testing regarding the handling of symbolic # links. if { [string equal $::tcl_platform(platform) windows] && [package vsatisfies [package require Tcl] 8.4] } { if {[string equal $::tcl_platform(platform) windows]} { # Windows doesn't like the .. in the target, it needs an # absolute path. # NOTE/BUG Even so the 'fullnormalize' in the traverser # returns bogus results for the link, whereas use of file # normalize and fullnormalize in a simple tclsh, # i.e. outside of the testing is ok. # It seems if the 'file join' in fullnormalize is replaced # by a plain / then the results are ok again => The # handling of paths on Windows by the Tcl core is bogus in # some way which breaks the core 'normalize'. set here [pwd] cd [file dirname [tempPath $src]] file link [file tail $src] [file normalize $target] cd $here } else { file link [tempPath $src] $target } return } exec ln -s $target [tempPath $src] return } proc f_cleanupdot {} { removeDirectory dotfiles return } proc f_setupnostat {} { |
︙ | ︙ | |||
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 | exec chmod +r [tempPath find3/find4] } removeDirectory find3 return } proc f_cleanall {} { rename f_setup {} rename f_cleanup {} rename f_setupcircle {} rename f_setupdot {} rename f_cleanupdot {} rename f_setupnostat {} rename f_cleanupnostat {} rename f_setupnoread {} rename f_cleanupnoread {} rename f_cleanall {} | > > > > | 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 | exec chmod +r [tempPath find3/find4] } removeDirectory find3 return } proc f_cleanall {} { rename f_link {} rename f_setup {} rename f_cleanup {} rename f_cleanup3 {} rename f_setupcircle {} rename f_setupcircle2 {} rename f_setupcircle3 {} rename f_setupdot {} rename f_cleanupdot {} rename f_setupnostat {} rename f_cleanupnostat {} rename f_setupnoread {} rename f_cleanupnoread {} rename f_cleanall {} |
︙ | ︙ |
Changes to modules/fileutil/find.test.
︙ | ︙ | |||
136 137 138 139 140 141 142 143 144 145 146 147 148 149 | set res [lsort [fileutil::find [tempPath {find 1}]]] f_cleanup set res } [list [tempPath {find 1/file [1]}] \ [tempPath {find 1/find 2}] \ [tempPath {find 1/find 2/file 3}]] # ------------------------------------------------------------------------- test find-2.0 {find by pattern} { list [catch { ::fileutil::findByPattern [tempPath {}] -glob {fil*} foo } err] $err } {1 {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}} | > > > > > > > > > > > > > > > > > > > > > > > | 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | set res [lsort [fileutil::find [tempPath {find 1}]]] f_cleanup set res } [list [tempPath {find 1/file [1]}] \ [tempPath {find 1/find 2}] \ [tempPath {find 1/find 2/file 3}]] test find-1.11.0 {find result, circular links, unix} -setup { f_setupcircle3 } -constraints unix -body { join [lsort [fileutil::find [tempPath z]]] \n } -cleanup { f_cleanup3 } -result [join [pathmap \ z z/a z/a/c z/a/c/g z/a/c/h z/a/c/h/e z/a/c/h/f \ z/a/c/i z/a/d z/b z/b/e z/b/e/g z/b/e/g/c z/b/e/g/d \ z/b/e/h z/b/e/i z/b/f] \n] test find-1.11.1 {find result, circular links, windows, 8.4+} -setup { f_setupcircle3 } -constraints {win tcl8.4plus} -body { join [lsort [fileutil::find [tempPath z]]] \n } -cleanup { f_cleanup3 } -result [join [pathmap \ z z/a z/a/c z/a/c/g z/a/c/h z/a/c/h/e z/a/c/h/f \ z/a/c/i z/a/d z/b z/b/e z/b/e/g z/b/e/g/c z/b/e/g/d \ z/b/e/h z/b/e/i z/b/f] \n] # ------------------------------------------------------------------------- test find-2.0 {find by pattern} { list [catch { ::fileutil::findByPattern [tempPath {}] -glob {fil*} foo } err] $err } {1 {wrong#args for "::fileutil::findByPattern", should be "::fileutil::findByPattern basedir ?-regexp|-glob? ?--? patterns"}} |
︙ | ︙ |
Changes to modules/fileutil/pkgIndex.tcl.
1 | if {![package vsatisfies [package provide Tcl] 8.2]} {return} | | | | 1 2 3 4 5 6 7 8 9 10 | if {![package vsatisfies [package provide Tcl] 8.2]} {return} package ifneeded fileutil 1.14.9 [list source [file join $dir fileutil.tcl]] if {![package vsatisfies [package provide Tcl] 8.3]} {return} package ifneeded fileutil::traverse 0.4.4 [list source [file join $dir traverse.tcl]] if {![package vsatisfies [package provide Tcl] 8.4]} {return} package ifneeded fileutil::multi 0.1 [list source [file join $dir multi.tcl]] package ifneeded fileutil::multi::op 0.5.3 [list source [file join $dir multiop.tcl]] package ifneeded fileutil::decode 0.2 [list source [file join $dir decode.tcl]] |
Changes to modules/fileutil/traverse.man.
1 | [comment {-*- text -*- doctools manpage}] | | | 1 2 3 4 5 6 7 8 9 | [comment {-*- text -*- doctools manpage}] [manpage_begin fileutil_traverse n 0.4.4] [keywords {directory traversal}] [keywords traversal] [moddesc {file utilities}] [titledesc {Iterative directory traversal}] [category {Programming tools}] [require Tcl 8.3] [require fileutil::traverse [opt 0.4.3]] |
︙ | ︙ | |||
76 77 78 79 80 81 82 | This is the lowest possible interface to the traverser, the core all higher methods are built on. When invoked it returns a boolean value indicating whether it found a path matching the current configuration ([const True]), or not ([const False]). If a path was found it is stored into the variable named by [arg filevar], in the context of the caller. | | | | | > > > > > > | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 | This is the lowest possible interface to the traverser, the core all higher methods are built on. When invoked it returns a boolean value indicating whether it found a path matching the current configuration ([const True]), or not ([const False]). If a path was found it is stored into the variable named by [arg filevar], in the context of the caller. [para] The [method foreach] method simply calls this method in a loop until it returned [const False]. This method is exposed so that we are also able to incrementally traverse a directory hierarchy in an event-based manner. [para] Note that the traverser does follow symbolic links, except when doing so would cause it to enter a link-cycle. In other words, the command takes care to [emph not] lose itself in infinite loops upon encountering circular link structures. Note that even links which are not followed will still appear in the result. [list_end] [section OPTIONS] [list_begin options] [opt_def -prefilter command_prefix] |
︙ | ︙ |
Changes to modules/fileutil/traverse.tcl.
︙ | ︙ | |||
202 203 204 205 206 207 208 | [string equal [file tail $f] ".."] } continue if {[Valid $f]} { lappend _results $f } | | | < | 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | [string equal [file tail $f] ".."] } continue if {[Valid $f]} { lappend _results $f } Enter $top $f if {[Cycle $f]} continue if {[Recurse $f]} { lappend _pending $f } } # Stop expanding if we have paths to return. if {[llength $_results]} { |
︙ | ︙ | |||
243 244 245 246 247 248 249 | # * Set of directories already visited (normalized paths), for # detection of circular symbolic links. variable _init 0 ; # Initialization flag. variable _base {} ; # Base directory. variable _pending {} ; # Processing stack. variable _results {} ; # Result stack. | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | < | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 | # * Set of directories already visited (normalized paths), for # detection of circular symbolic links. variable _init 0 ; # Initialization flag. variable _base {} ; # Base directory. variable _pending {} ; # Processing stack. variable _results {} ; # Result stack. # sym link handling (to break cycles, while allowing the following of non-cycle links). # Notes # - path parent tracking is lexical. # - path identity tracking is based on the normalized path, i.e. the path with all # symlinks resolved. # Maps # - path -> parent (easier to follow the list than doing dirname's) # - path -> normalized (cache to avoid redundant calls of fullnormalize) # cycle <=> A parent's normalized form (NF) is identical to the current path's NF variable _parent -array {} variable _norm -array {} # ### ### ### ######### ######### ######### ## Internal helpers. proc Enter {parent path} { upvar 1 _parent _parent _norm _norm set _parent($path) $parent set _norm($path) [fileutil::fullnormalize $path] } proc Cycle {path} { upvar 1 _parent _parent _norm _norm set nform $_norm($path) set paren $_parent($path) while {$paren ne {}} { if {$_norm($paren) eq $nform} { return yes } set paren $_parent($paren) } return no } method Init {} { array unset _parent * array unset _norm * # Path ok as result? if {[Valid $_base]} { lappend _results $_base } # Expansion allowed by prefilter? if {[file isdirectory $_base] && [Recurse $_base]} { Enter {} $_base lappend _pending $_base } # System is set up now. set _init 1 return } |
︙ | ︙ | |||
413 414 415 416 417 418 419 | return $l } } # ### ### ### ######### ######### ######### ## Ready | | | 441 442 443 444 445 446 447 448 | return $l } } # ### ### ### ######### ######### ######### ## Ready package provide fileutil::traverse 0.4.4 |
Changes to modules/fileutil/traverse.test.
︙ | ︙ | |||
298 299 300 301 302 303 304 305 306 307 308 309 310 | $t destroy unset rec f_cleanupnostat } -result [list [list [tempPath find3/find4] {Inacessible directory}]] # traverse 1.3.x - error callback, all platforms - Not possible. We have # no win32 setup code for non-readable/non-accessible directories. # ------------------------------------------------------------------------- f_cleanall testsuiteCleanup return | > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 | $t destroy unset rec f_cleanupnostat } -result [list [list [tempPath find3/find4] {Inacessible directory}]] # traverse 1.3.x - error callback, all platforms - Not possible. We have # no win32 setup code for non-readable/non-accessible directories. # ------------------------------------------------------------------------- test traverse-1.4.0 {Traverse result, circular links, unix} -setup { f_setupcircle3 set t [fileutil::traverse %AUTO% [tempPath z]] } -constraints unix -body { join [lsort [$t files]] \n } -cleanup { $t destroy f_cleanup3 } -result [join [pathmap \ z z/a z/a/c z/a/c/g z/a/c/h z/a/c/h/e z/a/c/h/f \ z/a/c/i z/a/d z/b z/b/e z/b/e/g z/b/e/g/c z/b/e/g/d \ z/b/e/h z/b/e/i z/b/f] \n] test traverse-1.4.1 {Traverse result, circular links, windows, 8.4+} -setup { f_setupcircle3 set t [fileutil::traverse %AUTO% [tempPath z]] } -constraints {win tcl8.4plus} -body { join [lsort [$t files]] \n } -cleanup { $t destroy f_cleanup3 } -result [join [pathmap \ z z/a z/a/c z/a/c/g z/a/c/h z/a/c/h/e z/a/c/h/f \ z/a/c/i z/a/d z/b z/b/e z/b/e/g z/b/e/g/c z/b/e/g/d \ z/b/e/h z/b/e/i z/b/f] \n] # ------------------------------------------------------------------------- f_cleanall testsuiteCleanup return |