1# 2# <20190627.1738.30> 3# 4# This is the begining spec. for a Virtual File System for use with Filerunner. 5# 6# The intent is to provide a frame work for a generalized VFS for inside of 7# Filerunner. We are NOT trying to provide access to any other program to the 8# virtual files we are working with, however, for those VFS implementations 9# that map into (read 'mount') normal file system space, such access is 10# available. 11# 12# When we started, Filerunner already had three vfs' up and running: 13# 14# ftp:// 15# sftp:// 16# aftp:// (aftp: being access through adb to such devices as it talks to) 17# 18# This is an attempt to generalize this and inclued many more types of 19# vfs'. In particular, we want to be able to handel: 20# 21# zip, tar tar+comp such as tar.gz any archive sort of structure 22# including rpm, deb and msi 23# 24# It is hoped that we can generalize this enough that a user can easily add 25# a new type by supplying only a few key parts. 26# 27# Here we define the basic structure and use of VFS. 28# We define two types: 29# Type I requires code for most (if not all) of the accesses. These are usually 30# accesses to file structure on remote systems. ftp://, sftp:// and such 31# are examples 32# Type II requires only setup (open/mount) and close/umount. It is usually 33# completely local (although it may cast a remote system to a different 34# format for access). Examples of this form of VFS are zip, tar, etc. 35 36# Type II is implemented by providing an open/mount script and a close/unmount 37# script. These scripts may call external programs, but once a given 38# Type II VFS is mounted it is treated and behaves as a normal file 39# system, i.e. open/close/read/write etc. work within and out side 40# of filerunner. This means we can use all of our normal scripts 41# to display modify and manage these files. 42# The scrits that filerunner provides for Type II VFS mounts are: 43# 1) The choosing and execution of the open/mount and close/umount 44# scripts. 45# 2) The DisplayName structure that puts up a different name for the 46# VFS mount point. 47# 3) Logic to allow nested Type II VFS mounts and their proper close/umount 48# 49# Each Type II VFS subtype (e.g. zip, tar, etc.) requires a structure 50# that tells the 'mount' command that it handles this particular subtype. 51# Usually this is done by passing the 'mount' command the name of the 52# file to mount (e.g. subtype zip might have a *.zip as its selection 53# criteria) the same as the "view" command does. The 'mount' command finds 54# the required list entry which will have a script to run to do the 55# mount. 56 57 58# The following code implements Type I VFS 59# Identifying a Type I VFS. 60# A particular VFS is identified by a URL type of reference. For our use we 61# are interested in identifing that we have a URL (as apposed to a simple file name) 62# Here is a full blown URL: 63# <protocol>://<address><path> 64# <protocol> is something like "file", "https", "http", "zip", "tar", etc. 65# :// is what we use to suggest that this is a URL rather than a simple file or dir 66# <address> is (possibly) composed of a set of 1 or more names seperated by dots (.) 67# and optionally followed by :<port>. This <port> is usually a number but 68# we do not require this to be so. It may be preceded by "user@" where user 69# is the user on the given host address to login as. 70# The <address> is terminated by the '/' 71# (forward slash) which can also be considered part of the <path>. That is: 72# <path> starts with '/' and has the same format as a normal file. 73 74# 75# IsVFS <URL> 76# 77# This command tests for a VFS URL. If it is of proper form we populate the variables: 78# VFStok with <protocol>://<address> 79# VFSpro with the <protocol> 80# VFSadd with the <address> 81# VFSpath with the <path> 82# We have extra stuff here to allow pro:// to be VFS while pro:/// is not. 83# This makes it easier to do URL join, below. 84proc IsVFS {url} { 85 return [uplevel regexp {^((\[^:\]+)://($|(\[^/\]+)))(.*)} \{[regsub -all {\{|\}} $url {\\&}]\} match \ 86 VFStok VFSpro VFSadd VFSextraRubish VFSpath] 87} 88 89# This command splits a URL (much as split) and returns a list 90# of the parts. Missing parts are returned as nil ({}). 91# The parts are: protocol, user, address, port and path 92 93proc URLsplit {url} { 94 if {![IsVFS $url]} {return {}} 95 regexp {(([^@]*)@)?([^:]*)?(:(.*))?} $VFSadd m ux user add px port 96 return [list $VFSpro $user $add $port $VFSpath] 97} 98# just the address split... 99proc VFSaddrSplit {VFSadd} { 100 regexp {(([^@]*)@)?([^:]*)?(:(.*))?} $VFSadd m ux user add px port 101 return [list $user $add $port] 102} 103 104# URL normalize removes "." and ".." from the path 105# while preserving the URL front end. 106# For a local file it will also resolve soft links (same 107# as file norm. 108# This is set to work with any file path, VFS/URL or not 109# NOTE: On MSW file norm wants to put the 'pwd' in front of 110# file names that start with "/". To prevent this we 111# put a volume name (a:) in front and then strip it 112# after 'file norm' is done. The use of 'a:' for this 113# should also prevent attempts to find softlinks. 114 115# URL join does the "file" join for URLs and normal files 116# in addition it removes the "." and ".."s 117 118# URL directory does "file" directory on URLs and normal file names 119# error on others 120 121# The normalizeVFSPath is a bit of code to save coding the routine 122# in three places. We also need slightly different code for MSW and *nix 123 124# WARNNING ## WARNNING ## WARNNING ## WARNNING # 125# We have a deep distrust of the 'join' option in the URL command below. 126# The tcl 'file join' treats a leading "~" as the stare of an absolute path 127# which it then tries to dereference (usually failing). 128# For filerunner, we never want to join more than two items, it is much safer 129# to do it manually. The code in 'normalizeVFSPath' below works because 'IsVFS' 130# puts a '/' in front of the VFSpath. 131# The 'normalize' option has the same problem if the argument starts with '~'. 132# If we know it is relative we should add the path, i.e. [pwd]/ or ./ if it is 133# the cwd... 134 135if {$::MSW} { 136 proc normalizeVFSPath {path} { 137 upvar VFStok VFStok 138 if {$path in {. {}}} {return $VFStok} 139 frputs VFStok path 140 return $VFStok[string range [file norm a:/$path] 2 end] 141 } 142} else { 143 proc normalizeVFSPath {path} { 144 upvar VFStok VFStok 145 if {$path in {. {}}} {return $VFStok} 146 frputs VFStok path 147 return $VFStok[file norm $path] 148 } 149} 150 151proc URL {option URL args} { 152 set pos {dirname normalize join} 153 set opt [lsearch -glob -all -inline $pos "$option*"] 154 if {$args != {} && $opt != "join" && $opt != {}} { 155 return -code error "Too many arguments. Should be \"URL $opt url\"." 156 } 157 switch -exact $opt[IsVFS $URL] { 158 normalize1 {return [normalizeVFSPath $VFSpath]} 159 normalize0 {return [file norm $URL]} 160 join1 {return [normalizeVFSPath [file join $VFSpath {*}$args]]} 161 join0 { 162 set tmp [file join $URL {*}$args] 163 if {$URL == {}} {return $tmp} 164 return [file norm $tmp] 165 } 166 dirname1 {return [normalizeVFSPath [file dir $VFSpath]]} 167 dirname0 {return [file dir $URL]} 168 1 - 169 0 - 170 default {return -code error\ 171 "URL: unrecognized option \"$option\", not one of \"$pos\""} 172 } 173} 174# 175# Here we provide a VFS global statment 176# 177proc VFSglobal {args} { 178 # We assume that the caller has a defined URL or VFStok in his local space 179 uplevel {if {![info exists VFStok]} {IsVFS $URL}} 180 uplevel [list foreach arg $args { 181 upvar #0 ::VFSvars::($VFStok,$arg) $arg 182 }] 183} 184 185# Exploring various ways to build a script with a \; in it. This is one 186# of the few that work... WE leave here for education and recall... 187# proc VFSglobalt {args} { 188# # We assume that the caller has a defined URL or VFStok in his local space 189# append s expr { {[info exists VFStok] ? {} : [IsVFS $URL]} ;foreach arg } 190# append s "$args" { { 191# upvar #0 ::VFSvars::($VFStok,$arg) $arg 192# }} 193# uplevel $s 194# } 195 196# Here is a name space to keep more global stuff in. 197 198namespace eval VFSvars { 199 # For full VFS all the following are required. For a VFS that is mapped 200 # to file space, only open and close are required. 201 202 # The way to think about this is to consider a read only file system 203 variable requiredProcs [list open cd isdir pwd get close live] 204 205 variable eitherOrProcs [list {list listF}] 206 variable optionalProcs [list rename delete mkdir rmdir chmod chown list listF\ 207 put copy link command search debug menu] 208 variable binaryEntries [list RcopyOk rmdirEmpty] 209 210 variable open 211 variable cache 212 variable cacheCount 0 213 variable timeout 214 variable vfsIsUpWait 215 variable afterId 216 217 proc VFSopenSet {VFStok arg} { 218 variable timeout 219 set timeout($VFStok) 10000 220 foreach {opt value} $arg { 221 set tar [lsearch -glob -all -inline timeout "$opt*"] 222 if {$tar == {}} {continue} 223 if {[llength $tar] != 1} { 224 error "VFSvars: option ($opt) must be timeout" 225 } 226 set timeout($VFStok) $value 227 break 228 } 229 set afterId($VFStok) [after $timeout($VFStok) {}] 230 231 } 232 233 proc VFSnoCommand {cmd URL args} { 234 # If we are here there was and attempt to call a missing proc 235 IsVFS $URL 236 return -code error "VFS \"$VFSpro\" does not support the $cmd function." 237 } 238 239 # The VFSsetCommands proc a) insures required commands are present and 240 # b) Sets any missing commands to point the the VFSnoCommand which 241 # generates a rather standard error message. 242 243 proc VFSsetCommands {} { 244 variable requiredProcs 245 variable optionalProcs 246 variable binaryEntries 247 # First check for the min command set 248 uplevel { 249 foreach reqProc $::VFSvars::requiredProcs { 250 if {![info exists commands($reqProc)]} { 251 lappend missing $reqProc 252 } 253 } 254 foreach eithOr $::VFSvars::eitherOrProcs { 255 lassign $eithOr a b 256 if {![info exists commands($a)] && ![info exists commands($b)]} { 257 lappend missing "$a or $b" 258 } 259 } 260 if {[info exists missing]} { 261 if {[info exists commands(close)] && [info procs $commands(close)] != {}} { 262 uplevel [list {*}$commands(close) $VFStok] 263 } 264 error "Package VFS$VFSpro is missing the following commands: $missing" 265 } 266 # If we are still here, set up the missing commands 267 foreach opProc $::VFSvars::optionalProcs { 268 if {![info exists commands($opProc)]} { 269 set commands($opProc) [list ::VFSvars::VFSnoCommand $opProc] 270 } 271 } 272 foreach opProc $::VFSvars::binaryEntries { 273 if {![info exists commands($opProc)]} { 274 set commands($opProc) 0 275 } 276 } 277 } 278 } 279 280 # VFScheckNotMapped 281 # VFScheckNotMapped URL This routine insures that the given URL is an open 282 # URL and that it is not mapped. This is a local routine 283 # Note: this code depends on the URL existing on the callers stack as "URL" 284 # If it looks open, a test to see if the link is up is made, conditioned on 285 # time since last request and if it is not canceled by an "arg" of ! {} 286 287 proc VFScheckNotMapped {args} { 288 variable open 289 variable vfsIsUpWait 290 variable afterId 291 variable timeout 292 variable temp $args 293 294 uplevel { 295 if {![IsVFS $URL] ||\ 296 ! [info exists ::VFSvars::open($VFStok)] ||\ 297 $::VFSvars::open($VFStok)!= $VFStok} { 298 error "$URL is not an open VFS URL" 299 } 300 # Check if this access is beyond the timeout since the last one 301 # We pass args through VFSvars::temp since it is not in scope 302 # (nor is namespace current usable) 303 if {[catch {after info $::VFSvars::afterId($VFStok)}] != 0 &&\ 304 $::VFSvars::temp == {}} { 305 set ::VFSvars::afterId($VFStok)\ 306 [after 10000 [list set VFSvars::vfsIsUpWait($VFStok) 10]] 307 after idle [list VFSvars::VFSisLinkUpTest\ 308 $VFStok [set ::VFS[set VFSpro]::commands(live)]] 309 vwait ::VFSvars::vfsIsUpWait($VFStok) 310 after cancel $::VFSvars::afterId($VFStok) 311 lassign $VFSvars::vfsIsUpWait($VFStok) r ret 312 if {$r != 0 || $ret == {}} { 313 # Link appears to be down... 314 frputs r ret 315 eval [list {*}[set ::VFS[set VFSpro]::commands(reopen)] $VFStok] 316 } 317 } 318 after cancel $::VFSvars::afterId($VFStok) 319 set ::VFSvars::afterId($VFStok) [after $VFSvars::timeout($VFStok) {}] 320 } 321 } 322 323 # This is the after code used above 324 proc VFSisLinkUpTest {VFStok live} { 325 variable vfsIsUpWait 326 variable command 327 328 set r [catch {eval [list {*}$live $VFStok]} ret] 329 set ::VFSvars::vfsIsUpWait($VFStok) [list $r $ret] 330 frputs r ret 331 } 332 333 # Cache management code =========================================== 334 proc VFS_WriteCache { key data } { 335 variable cache 336 variable cachet 337 variable cacheTimeOut 338 variable cacheCount 339 340 global config 341 set cache($key) $data 342 set cachet($key) [incr cacheCount] 343 # 344 # It is not clear, given the timeout on entries, that this is needed 345 if {[array size cache] > $config(vfs,cache,maxentries)} { 346 # prunning time 347 set low $cacheCount 348 foreach ent [array names cachet] { 349 if {$cachet($ent) < $low} { 350 set low $cachet($ent) 351 set an $ent 352 } 353 } 354 unset cachet($an) 355 unset cache($an) 356 } 357 # End of questionable prune code.... 358 if { [info exists cacheTimeOut]} { 359 after cancel $cacheTimeOut 360 } 361 # Lets try 1.5 min. (90000) 362 set cacheTimeOut [after 90000 [namespace current]::VFS_InvalidateCache] 363 } 364 365 366 proc VFS_ReadCache { key} { 367 variable cache 368 variable cachet 369 variable cacheCount 370 371 if {[info exist cache($key)]} { 372 set cachet($key) [incr cacheCount] 373 return $cache($key) 374 } 375 return 0 376 } 377 378 proc VFS_InvalidateCache {{URL ""}} { 379 variable cache 380 variable cachet 381 variable cacheCount 382 variable cacheTimeOut 383 384 if {$URL == ""} { 385 array unset cache 386 array unset cachet 387 set cacheCount 0 388 389 if { [info exists cacheTimeOut]} { 390 after cancel $cacheTimeOut 391 unset cacheTimeOut 392 } 393 return 394 } 395 # If we are here it is a targeted cache delete. 396 # we cheat a little and go into the details of 397 # the the entries to pick up the IsDir entries 398 # 399 foreach name [array names cache -regexp "^(Dir:)?$URL.*$"] { 400 unset cache($name) 401 unset cachet($name) 402 frputs URL 403 } 404 } 405#============================ End of Cache code ================ 406} 407 408#============================ End of NameSpace VFSvars ======[::VFSvars::VFS_ReadCache $URL][::VFSvars::VFS_ReadCache $URL]==== 409 410# # This routine will verify that the link is up and if not will try to 411# # reopen it. If all that fails and error is thrown. 412# proc VFSisLinkUp {$VFStok} { 413# frputs 414# # This gets control back if "live" hangs 415# set afterId [after 10000 {set ::vfsIsUpWait 10}] 416# after idle {VFSisLinkUpTest $VFStok} 417# after cancel $afterId 418# vwait ::vfsIsUpWait 419 420# lassign $::vfsIsUpWait r ret 421# if {$r != 0 || $ret == {}} { 422# # Link appears to be down... 423# frputs 424# uplevel [list {*}$commands(reopen) $VFStok] 425# } 426# } 427# ==================================================== 428# 429# The interface: 430# In the following discussion the "real" code is that which is in the VFS 431# package we are calling. 432# 433# VFSopen URL options 434# open (or Mount) For things like ftp this may mean contacting another system 435# to extablish a connection. The open request requires a URL and 436# a user as well as other possible options. 437 438# The password is NOT passed, but rather obtained by the callee 439# using the "password Locker" interface. This allows us to keep 440# all passwords in one place and to manage them else where in 441# encrypted form. It is recommended that callees not (in general) 442# save passwords, but rather get them, use them and erase 443# (or at least obscure) the local copy. 444 445# options is a list of doublets of form "<option> <value>" 446# expected options are: 447# user (may also be in the URL) 448# port (may also be in the URL) 449# proxy if an indirect connection 450# abortflag global variable that, if set, will abort the connection 451# timeout how long to wait for an action in seconds 452# log log function for progress reports 453# timefmt format to use for time in progress reports 454# debug bool, true if debugging 455 456# The open routine open should return {} or a corrected URL. 457# 458 459# Comment: The following would appear to be an idea not used. Local VFS 460# and their management is now the job of cmdMount and friends. 461 462# If the VFS is to be access with a <local root> (i.e. a tmp 463# area on the local disk) the disk address of this area is 464# to be returned by the "real' open. 465# This code will put this address in a safe 466# place. 467 468# (For VFS protocols such as zip, the file to be 469# mounted will be in the current working directory.) 470# In the case of a <local root> the 471# VFS implimtation should supply only the 'open' and 'close' 472# routines. 473 474proc VFSopen {URL args} { 475 if {![IsVFS $URL]} { 476 error "$URL is not a VFS URL" 477 } 478 set r [catch "package require VFS$VFSpro" er] 479 if {$r != 0} { 480 error "Failed to find VFS$VFSpro: $er" 481 } 482 if {! [info exists ::VFS${VFSpro}::commands(open)]} { 483 error "VFS$VFSpro does not define VFS${VFSpro}::commands(open)" 484 } 485 # Well, it looks like we might be able to open/mount this thing... 486 global ::VFS[set VFSpro]::commands 487 frputs commands(open) 488 set rtn [eval [list {*}$commands(open) $URL $args]] 489 IsVFS $rtn 490 set ::VFSvars::open($VFStok) $VFStok 491 ::VFSvars::VFSsetCommands 492 # Set our local vars 493 VFSvars::VFSopenSet $VFStok [concat {*}$args] 494 return [expr {$rtn == {} ? 1 : $rtn}] 495} 496 497# VFS supports command 498# VFSsupport URL command Returns true if VFS is open and supports "command" 499# This 500proc VFSsupports {URL command} { 501 VFSvars::VFScheckNotMapped 502 global ::VFS[set VFSpro]::commands 503 return [expr {[info exists commands($command)] && \ 504 [lindex $commands($command) 0] ni {0 "::VFSvars::VFSnoCommand"}}] 505} 506 507# VFS management code: 508# VFSisOpen URL returns 0 if no open flag, else the corrected VFStok or 509# what ever the vfs command returned. 510# 511proc VFSisOpen {URL} { 512 if {[IsVFS $URL] && \ 513 [info exists ::VFSvars::open($VFStok)] && \ 514 $::VFSvars::open($VFStok) != 0} { 515 return $::VFSvars::open($VFStok) 516 } else { 517 return 0 518 } 519} 520 521# It is unclear if the live routine should be exported beyond its 522# use in VFScheckNotMapped 523 524# VFSlive URL 525# live VFStok This should insure that the vfs is 526# still mounted or open and ready to handle requests. 527# If it is not, this function should make every effort to 528# restore the connection. Failure here will close/unmount 529# the connection. If this command fails to verify that the 530# connetion is alive and well, it should return true. If 531# a connection is closed/unmounted this should return false. 532# If VFSlive ever returns false, the "reopen" routine must 533# be supplied. 534# proc VFSlive {URL} { 535# global ::VFS[set VFSpro]::commands 536# return [uplevel [list {*}$commands(live) $VFStok]] 537# } 538 539# VFScd URL 540# cd VFStok dir Change the directory to path. True if successful, false if not. 541proc VFScd {URL} { 542 VFSvars::VFScheckNotMapped 543 global ::VFS[set VFSpro]::commands 544 return [eval [list {*}$commands(cd) $VFStok $VFSpath]] 545} 546 547# VFSrename URL oldname newname dirFlag 548# Rename VFStok new Rename a file or directory (possibly implies move) True if 549# successful, false if not. "dirFlag" should be true if 550# the call is renaming a directory (helps us manage 551# the cache). 552proc VFSrename {URL new dir} { 553 VFSvars::VFScheckNotMapped 554 global ::VFS[set VFSpro]::commands 555 if {$dir} { 556 # if a dir, get the whole tree... 557 ::VFSvars::VFS_InvalidateCache 558 } else { 559 # a file, just its dir(s) 560 ::VFSvars::VFS_InvalidateCache [URL dir $URL] 561 ::VFSvars::VFS_InvalidateCache [URL dir $VFStok/$new] 562 } 563 set rtn [uplevel [list {*}$commands(rename) $VFStok $VFSpath $new]] 564 return $rtn 565} 566 567# VFSdelete URL 568# Delete Delete a file. True if successful, false if not. 569proc VFSdelete {URL} { 570 VFSvars::VFScheckNotMapped 571 ::VFSvars::VFS_InvalidateCache $URL 572 global ::VFS[set VFSpro]::commands 573 return [uplevel [list {*}$commands(delete) $VFStok $VFSpath]] 574} 575 576# VFSmkdir URL 577# Make Directory Makes a new directory. True if successful, false if not. 578# Note: directory is part of the URL 579 580proc VFSmkdir {URL} { 581 VFSvars::VFScheckNotMapped 582 ::VFSvars::VFS_InvalidateCache [URL dir $URL] 583 global ::VFS[set VFSpro]::commands 584 return [uplevel [list {*}$commands(mkdir) $VFStok $VFSpath]] 585} 586 587# VFSrmdir URL 588# rmdir (open question on if the directory is empty. In general filerunner 589# assumes we can delete a directory and every thing in it with 590# just one call. OTH ftp can not do that and so we have a 591# recursive function to do just this. So, we need an option 592# flag here to indicate if this VFS can do the full delete. 593# directory is indicated by the path part of the URL 594proc VFSrmdir {URL} { 595 VFSvars::VFScheckNotMapped 596 ::VFSvars::VFS_InvalidateCache $URL 597 ::VFSvars::VFS_InvalidateCache [URL dirname $URL] 598 global ::VFS[set VFSpro]::commands 599 return [uplevel [list {*}$commands(rmdir) $VFStok $VFSpath]] 600} 601 602 603# VFSisDir URL 604# IsDir Test if object is a directory. Either throw an 605# error or return 0 if not. If it is return the 606# actual dir name (assumes it may be a symbolic link) 607# For the most part this is only called when a dir 608# entry is a sym link. 609# 610proc VFSisDir {URL} { 611 VFSvars::VFScheckNotMapped 612 global ::VFS[set VFSpro]::commands 613 set rtn [::VFSvars::VFS_ReadCache Dir:$URL] 614 if {$rtn != 0} { 615 return $rtn 616 } 617 set r [catch {{*}$commands(isdir) $VFStok $VFSpath} path] 618 set rtn [expr {$r == 0 && $path != 0 ? $path : {}}] 619 ::VFSvars::VFS_WriteCache "Dir:$URL" $rtn 620 return $rtn 621} 622 623# VFSpwd URL 624# Pwd Return the current working directory. It is assumed that 625# this returns the true path to the WD even though 626# the Cd command to get to it may have been via a link 627# It would be "nice" if the return was a URL, but if not 628# we fix it. 629proc VFSpwd {URL} { 630 VFSvars::VFScheckNotMapped 631 global ::VFS[set VFSpro]::commands 632 if {[IsVFS [set ret [uplevel [list {*}$commands(pwd) $VFStok]]]]} { 633 return $ret 634 } 635 return [URL norm $VFStok/$ret] 636} 637 638# VFSchmod URL mode 639# chmod Change mode of the object (file or directory) to mode. 640# mode may inclued the recursion flag (formats TBD) 641proc VFSchmod {URL mode} { 642 VFSvars::VFScheckNotMapped 643 ::VFSvars::VFS_InvalidateCache [URL dirname $URL] 644 global ::VFS[set VFSpro]::commands 645 return [uplevel [list {*}$commands(chmod) $VFStok $mode $VFSpath]] 646} 647 648# VFSchown URL owner 649# chown Change owner of the object (file or directory). owner may 650# include a recursion flag 651proc VFSchown {URL mode} { 652 VFSvars::VFScheckNotMapped 653 ::VFSvars::VFS_InvalidateCache $URL 654 global ::VFS[set VFSpro]::commands 655 return [uplevel [list {*}$commands(chown) $VFStok $mode $VFSpath]] 656} 657 658# VFSlist URL showall 659# list Return a list of files and their attributes for the current directory. 660# Currently filerunner process several versions of this list. 661# 1.) Those provided by 'glob' and 'file stat' 662# 2.) Those provided by 'ftp' 663# 3.) Those provided by 'sftp' (which, I think, is from *nix 'ls') 664# 4.) The *nix 'ls' command. 665# 5.) The MS windows 'cmd dir' command (with most of its options) 666# WARNNING "list" is passed the URL, not the VFStok. For the VFSglobal to work correctly 667# this NUST be called URL by the VFSlist/VFSlistF handler. 668proc VFSlist {URL showall} { 669 frputs URL showall 670 VFSvars::VFScheckNotMapped 671 LogStatusOnly "Reading VFS directory $URL" 672 set result [::VFSvars::VFS_ReadCache $URL] 673 if {$result != 0} { 674 LogStatusOnly "done (found in cache)" 675 return $result 676 } 677 global ::VFS[set VFSpro]::commands 678 set result [uplevel [list {*}$commands(list) $URL $showall]] 679 ::VFSvars::VFS_WriteCache $URL $result 680 LogStatusOnly "done" 681 return $result 682} 683 684# VFSlistF URL args 685# list Return a list of files and their attributes for the current directory. 686# This is an optional list request. Either VFSlist or VFSlistF must 687# be supported. In this format the callee (the VFS code) supplies a 688# dictionary of values for each field seperated into 689# the various bits of info about the file. 690# The dictionary MUST have values for: 691# file <files name> 692# type <one of: {d n ld ln}> d->directory n->file l->link 693# -optional- 694# size <file/dir size in bytes> 695# sec <last modify time> 696# og <owner/group string> 697# link <link to string> 698# nlinks <number of links> refers to hard links 699# flags <a set of r/w flags per ls> 700# args is a list of doublets that controls various things. 701# at this time {showall bool} is defined. 702# WARNNING "list" is passed the URL, not the VFStok. For the VFSglobal to work correctly 703# this NUST be called URL by the VFSlist/VFSlistF handler. 704proc VFSlistF {URL args} { 705 frputs URL showall 706 VFSvars::VFScheckNotMapped 707 LogStatusOnly "Reading VFS directory $URL" 708 set result [::VFSvars::VFS_ReadCache $URL] 709 if {$result != 0} { 710 LogStatusOnly "done (found in cache)" 711 return $result 712 } 713 global ::VFS[set VFSpro]::commands 714 set result [uplevel [list {*}$commands(listF) $URL $args]] 715 ::VFSvars::VFS_WriteCache $URL $result 716 LogStatusOnly "done" 717 return $result 718} 719 720# VFSgetFile URL lfile size ?resume? 721# get Get contents of named URL and put in lfile. 722# size is the expected size (used in progress report) 723# if resume is true and lfile exists, the call gets 724# the remainder of the file. If the get fails it should 725# throw an error. 726proc VFSgetFile {URL lfile size args} { 727 VFSvars::VFScheckNotMapped 728 global ::VFS[set VFSpro]::commands 729 return [uplevel [list {*}$commands(get) $VFStok \ 730 $VFSpath $lfile $size $args]] 731} 732 733 734# VFSputFile URL localFileName size 735# put Creates (optionally) and writes a file. 736# If the "put" fails it should throw an error. 737proc VFSputFile {URL localFileName size} { 738 VFSvars::VFScheckNotMapped 739 ::VFSvars::VFS_InvalidateCache [URL dirname $URL] 740 global ::VFS[set VFSpro]::commands 741 return [uplevel \ 742 [list {*}$commands(put) \ 743 $VFStok $localFileName $VFSpath $size]] 744} 745 746# VFScopy URL fromfile tofile (fromfile may be a list) 747# copy Copy within the VFS. 748# Optional command. Throws error if not supported 749 750proc VFScopy {URL fromFile toFile} { 751 VFSvars::VFScheckNotMapped 752 global ::VFS[set VFSpro]::commands 753 if {![info exists commands(copy)]} { 754 return -code error "VFS $VFStok does not support \"copy\"" 755 } 756 if {[IsVFS $fromFile]} { 757 set fromFile $VFSpath 758 } 759 if {[IsVFS $toFile]} { 760 set toFile $VFSpath 761 } 762 ::VFSvars::VFS_InvalidateCache [URL norm $VFStok/[file dirname $toFile]] 763 return [uplevel [list {*}$commands(copy) $VFStok $fromFile $toFile]] 764} 765 766# VFSlink URL new opt (r or a, relative or absolute) 767# link Creates the symbolic link 'new' pointing to URL. 768 769proc VFSlink {URL new opt} { 770 VFSvars::VFScheckNotMapped 771 ::VFSvars::VFS_InvalidateCache [URL dirname $new] 772 global ::VFS[set VFSpro]::commands 773 return [uplevel \ 774 [list {*}$commands(link) $VFStok $VFSpath $new $opt]] 775} 776 777 778# VFScommand URL command 779# command Execute given command in the given vfs enviroment 780proc VFScommand {URL command} { 781 VFSvars::VFScheckNotMapped 782 global ::VFS[set VFSpro]::commands 783 return [uplevel [list {*}$commands(command) $VFStok $command]] 784} 785 786# VFSclose URL 787# close Disconnect and close the VFS. For things like ftp this just 788# closes the connection. For data containers such as tar or zip 789# if the mount is not read only, this will mean producing the 790# updated container. 791proc VFSclose {URL} { 792 VFSvars::VFScheckNotMapped 793 global ::VFS[set VFSpro]::commands 794 return [uplevel [list {*}$commands(close) $VFStok ]] 795} 796 797# VFSmenu This command (if it exists) should pass back a set of menu 798# entries. This should be a list menu entries to build a menu 799# to access and/or modify various items in the given VFS. When 800# the "Etc" menu button is pressed filerunner makes this call 801# to get items to put in that menu. The list items are used 802# in a <pathname add> command to build the menu entry. 803# Example: -label foois -command VFSfoo::fooiscmd 804# each element in the list is taken as a new add menu item 805# This command is optional. 806 807proc VFSmenu {URL} { 808 VFSvars::VFScheckNotMapped 809 global ::VFS[set VFSpro]::commands 810 return [uplevel [list {*}$commands(menu) $VFStok]] 811} 812 813# VFSsearch URL file (optional, throws error if not supported) 814# search searches for a file named file (with possible wild cards) 815proc VFSsearch {URL file} { 816 VFSvars::VFScheckNotMapped 817 global ::VFS[set VFSpro]::commands 818 if {[info exist commands(search)]} { 819 return [uplevel [list {*}$commands(search) $VFStok $file]] 820 } else { 821 return -code error "Search command not supported by ${VFSpro} VFS" 822 } 823} 824# VFSdebug URL bool 1 sets 0 turns off (optional, ignore if not supported) 825# enable/disenable debug messages 826proc VFSdebug {URL bool} { 827 VFSvars::VFScheckNotMapped 0 828 global ::VFS[set VFSpro]::commands 829 if {[info exist commands(debug)]} { 830 return [uplevel [list {*}$commands(debug) $VFStok $bool]] 831 } 832} 833 834proc VFSRcopyOk {URL} { 835 VFSvars::VFScheckNotMapped 0 836 global ::VFS[set VFSpro]::commands 837 return $commands(RcopyOk) 838} 839 840proc VFSrmdirEmpty {URL} { 841 VFSvars::VFScheckNotMapped 0 842 global ::VFS[set VFSpro]::commands 843 return $commands(rmdirEmpty) 844} 845 846 847# Each vfs will also have its own perconnection data area and should be coded such 848# that, within data limits, as many connections as desired may be opened at the 849# same time. The system (i.e. this code) provides a cache for the List command. 850# 851# Some vfs' will use scratch disc space to spread out components of their containers. 852# This space should be released when the container is Closed/Unmounted. 853 854# Filerunner can distinguish between a display directory and a working directory 855# such that, for example zip://<path>.zip/ is displayed while /temp/zipXYZ/ is used. 856# 857# What is "VFStok"? VFStok is an intersection of a type of VFS and its root address. 858# It is the VFSs URL without the path, and it has exactly that format. 859# 860# Within the filerunner VFS the token is the name of an array with the following 861# entries (some of which may not exist): 862# 863# open if this does not exist the VFS is not mounted or open 864# else, the access path to the VFS. For FTP SFTP and such this will be 865# the same as the "token". For others it may be a tmp area where the 866# local expanded VFS is (or will be) located. 867# other other entries in this array are used by the given 'protocol' to keep 868# track of a given instance of open or mount. 869# 870# The commands for each protocol are kept in an array named: 871# VFS<protocol>::commands 872# For example VFSftp, VFSsftp and so on. 873# Each supported protocol action command will be in this array. Unsupported commands 874# should have no entry at all. (Attempts to use these commands will be trapped 875# and return a standard error.) 876 877# Making a VFS visabile to filerunner. Filerunner uses the "package names" command 878# to find VFS systems. A package named "VFS<protocol>" defines to filerunner that 879# a VFS set of code is available for that <protocol>. When the given package is 880# "required" it should define the array VFS<protocol>::commands. This array should 881# have the following entries: 882# 883# open reopen live cd delete mkdir rmdir rmdirEmpty isdir pwd chmod chown list 884# get put RcopyOk rename link command close and, optionally copy. 885# 886# RcopyOk indicates if the VFS can handle recursive copys of directries. It uses 887# two bits bit 0 for read or get and bit 1 for write or put. Thus: 888# 0 Neither read nor write recursive is supported 889# 1 read recursive is supported, write is not 890# 2 write recursive is supported, read is not 891# 3 both read and write recursive is supported. 892 893# rmdirEmpty should be true if and only if the VFS can rmdir non-empty dirs. 894# 895# of these rmdirEmpty and RcopyOk should be binary (true or false). All the rest 896# should be command names that preform the indicated function. Except for live 897# and reopen, these are defined above by example (see above). 898 899# LINK UP AND RECOVERY CODE 900 901# This file (frVFS.tcl) provides a "link is up" verification when ever a request is 902# made more that "timeout" time after the last one. This is done by calling "live" 903# and if it fails, calling "reopen". For links that are always closed after a 904# transaction, it is recommended that "live" return immeadiately with an up 905# return. In such a case reopen will never be called by this code. 906 907# The "live" routine should take one argument (VFStok) and return <something> if the 908# link is up. If the link is not up, it should either throw an error or return {}. 909# We are defining "live" such that it may be most any access. VFSftp uses the "pwd" 910# command. 911# 912# The "reopen" command also take one argument (VFStok). It will be called if "live" 913# either fails or does not return with in "timeout" time (currently this is 10 914# seconds). 915# Its job is a.) close the given link and attempt to reopen it. This means that open 916# should save what ever is needed to do this reopen. The reopen routine should 917# also recover the current working dir. 918 919# 920 921# In addition, the "package require" should define any of these commands that need 922# defineing (it is possible that some of these commands map to commands outside 923# of the package such as read or write and so do not need defining). 924 925 926 927