SEH A collate/broadcast/collect virtual filesystem.
Usage: ::vfs::template::collate::Mount <list of read directories> <list of write directories> <list of collect directories> <virtual mount point>
Collate: reads from multiple specified directories and presents the results as one at the mount location.
Broadcast: applies all writes in the mount location to multiple specified directories.
Collect: copies any file read from or written to any of the above locations to specified directories.
The lists of specified read, write and collect locations are independent; they can overlap or not as desired.
For file read access, each respective location in the read list is searched for the requested file, and the first instance of the file found is read.
Write and create commands are applied to each respective write location.
Directory listings are aggregates of all respective directory contents in all read locations.
Collect locations are not included in file or directory listings, and are not searched for read access.
Any of the read, write or collect lists can be an empty string.
Example use: specify parallel locations on a hard drive, on a CD-ROM mount and an ftp vfs as the read list. Files will be read first from the hard drive, if not found there the CD-ROM and ftp site will be searched in turn. The hard drive can be specified as the single write location, and no writes to the CD-ROM or ftp site will ever be attempted.
Example collect location use: specify a single hard drive location as a read, write and collect directory. Specify an ftp vfs as a secondary read directory. As ftp files are downloaded they are copied to the collect directory; the local copies are accessed first on subsequent reads and writes: hence the collect specification produces a self-generating local cache.
Based on a template virtual filesystem
SEH 7 Dec 04: Posted my latest code, which takes care of some issues and adds a feature: now you can use variables in the pathnames of the directories in the lists specified on the command line; so, for example, you could have "$::env(HOME)/files" as one of the read directories in a startup script containing the mount command, and anyone using the script would have their own home directory referenced.
NEM: Interesting idea. The description of file reads reminded me somewhat of inheritance in Object Oriented languages, with the directories representing classes and files representing instance data.
SEH 14 Jul 04: I added a "collect" option to the filesystem. See above.
19 Jul 04: Fixed problems pointed out by CMcC
03 Nov 04: Brian Theado - I found that [cd] to a any virtual directory didn't work and [file stat] only worked for files and not directories. See change to AcquireFile below (please review my change). I also found an extra set of square braces in the else clause in the Open command. See fix below
SEH 7 Dec 04: Fixes incorporated into latest code below. Thanks!
04Dec04: CMcC - It would be useful to be able to specify an additive directory, which is overlayed on every directory within a vfs, such that a file present in the additive directory would be present in every directory of the collate vfs. It would be like an additional read set, extending each element of the read set.
SEH 7 Dec 04: If you were to take the template virutal filesystem and make "set relative ." the first line of the handler procedure, then you should have a virtual filesystem where the files in the root directory of the virtual mount appear to exist in every subdirectory queried. Then you could put that virtual location into the read list of this virtual filesystem, and you should have the behavior you're after.
package require Tcl 8.4
package require vfs 1
namespace eval ::vfs::template::collate {}
proc ::vfs::template::collate::Mount {args} {
set pathto [eval MountProcedure $args]
set path [lindex $pathto 0]
set to [lindex $pathto 1]
::vfs::filesystem mount $to [list ::vfs::template::collate::handler $path]
::vfs::RegisterMount $to [list ::vfs::template::collate::Unmount]
if {[trace info execution close] == {}} {
trace add execution close leave ::vfs::template::collate::CloseTrace
}
return $to
}
proc ::vfs::template::collate::Unmount {to} {
set path [lindex [::vfs::filesystem info $to] end]
UnmountProcedure $path $to
::vfs::filesystem unmount $to
}
proc ::vfs::template::collate::CloseTrace {commandString code result op} {
set errorCode $::errorCode
set errorInfo $::errorInfo
set channelID [lindex $commandString 1]
if [regexp {::Close ([^ ]+?) } $errorInfo trash errorChannelID] {
if [string equal $channelID $errorChannelID] {
if {[lindex $errorCode 0] == "POSIX"} {
set pError [lindex $errorCode 1]
::vfs::filesystem posixerror $::vfs::posix($pError) ; return -code error $::vfs::posix($pError)
}
set message [lindex [split $errorInfo \n] 0]
error $message $errorInfo $errorCode
}
}
}
proc ::vfs::template::collate::handler {path cmd root relative actualpath args} {
switch -- $cmd {
access {
set mode [lindex $args 0]
set error [catch {Access $path $root $relative $actualpath $mode}]
if $error {vfs::filesystem posixerror $::vfs::posix(EACCES) ; return -code error $::vfs::posix(EACCES)}
}
createdirectory {
CreateDirectory $path $root $relative $actualpath
}
deletefile {
DeleteFile $path $root $relative $actualpath
}
fileattributes {
set index [lindex $args 0]
set value [lindex $args 1]
array set attributes [FileAttributes $path $root $relative $actualpath]
if {$index == {}} {
return [lsort [array names attributes]]
}
set attribute [lindex [lsort [array names attributes]] $index]
if {$value == {}} {
return $attributes($attribute)
}
FileAttributesSet $path $root $relative $actualpath $attribute $value
}
matchindirectory {
set pattern [lindex $args 0]
set types [lindex $args 1]
return [MatchInDirectory $path $root $relative $actualpath $pattern $types]
} open {
set mode [lindex $args 0]
if {$mode == {}} {set mode r}
set permissions [lindex $args 1]
set channelID [Open $path $root $relative $actualpath $mode $permissions]
fconfigure $channelID -translation auto
switch -glob -- $mode {
"" -
"r*" -
"w*" {
seek $channelID 0
}
"a*" {
seek $channelID 0 end
}
default {
::vfs::filesystem posixerror $::vfs::posix(EINVAL)
return -code error $::vfs::posix(EINVAL)
}
}
set result $channelID
lappend result [list ::vfs::template::collate::Close $channelID $path $root $relative $actualpath $mode]
return $result
}
removedirectory {
set recursive [lindex $args 0]
if !$recursive {
if {[MatchInDirectory $path $root $relative $actualpath * 0] != {}} {
::vfs::filesystem posixerror $::vfs::posix(EEXIST)
return -code error $::vfs::posix(EEXIST)
}
}
RemoveDirectory $path $root $relative $actualpath
}
stat {
return [Stat $path $root $relative $actualpath]
}
utime {
set atime [lindex $args 0]
set mtime [lindex $args 1]
Utime $path $root $relative $actualpath $atime $mtime
}
}
}
namespace eval ::vfs::template::collate {
proc MountProcedure {args} {
set to [lindex $args end]
set args [lrange $args 0 end-1]
set readList [lindex $args 0]
set writeList [lindex $args 1]
set collectList [lindex $args 2]
catch {::vfs::unmount $to} result
foreach path [concat $readList $writeList $collectList] {
file mkdir $path
}
lappend arrayadd $to ; lappend arrayadd $readList
array set ::vfs::template::collate::readConfig $arrayadd
unset arrayadd
lappend arrayadd $to ; lappend arrayadd $writeList
array set ::vfs::template::collate::writeConfig $arrayadd
unset arrayadd
lappend arrayadd $to ; lappend arrayadd $collectList
array set ::vfs::template::collate::collectConfig $arrayadd
lappend pathto $to
lappend pathto $to
return $pathto
}
proc UnmountProcedure {path to} {
array unset ::vfs::template::collate::readConfig $to
array unset ::vfs::template::collate::writeConfig $to
array unset ::vfs::template::collate::collectConfig $to
array unset ::vfs::_unmountCmd $to
return
}
proc Access {path root relative actualpath mode} {
set fileName [AcquireFile $root $relative]
set modeString [::vfs::accessMode $mode]
if {$modeString == "F"} {
if [file exists $fileName] {return}
error "no such file or directory"
}
set modeString [split $modeString {}]
set fileString {}
if {[string equal $modeString "R"] && [file readable $fileName]} {return}
if {[string equal $modeString "W"] && [file writable $fileName]} {return}
if {[string equal $modeString "X"] && [file executable $fileName]} {return}
file stat $fileName stat
foreach { mask pairs } {
00400 { 00400 r }
00200 { 00200 w }
04100 { 04100 s 04000 S 00100 x }
00040 { 00040 r }
00020 { 00020 w }
02010 { 02010 s 02000 S 00010 x }
00004 { 00004 r }
00002 { 00002 w }
01001 { 01001 t 01000 T 00001 x }
} {
set value [expr $stat(mode) & $mask]
set bit -
foreach { x b } $pairs {
if { $value == $x } {
set bit $b
}
}
append bitString $bit
}
set readable [regexp -all "r" $bitString]
set writable [regexp -all "w" $bitString]
set executable [regexp -all "x" $bitString]
foreach {mode count} "R $readable W $writable X $executable" {
if {([string first $mode $modeString] > -1) && !$count} {error "$mode access not allowed"}
}
if [string equal $modeString "X W"] {
if {($writable == 3) && ($executable == 3)} {
return
} elseif [file writable $fileName] {
if {[regexp -all "wx" $bitString] == $writable} {
return
} elseif [file executable $fileName] {
return
}
}
}
if [string equal $modeString "R W"] {
if {($writable == 3) && ($readable == 3)} {
return
} elseif [file writable $fileName] {
if {[regexp -all "rw" $bitString] == $writable} {
return
} elseif [file readable $fileName] {
return
}
}
}
if [string equal $modeString "R X"] {
if {($readable == 3) && ($executable == 3)} {
return
} elseif [file executable $fileName] {
if {[regexp -all {r[w-]x} $bitString] == $executable} {
return
} elseif [file readable $fileName] {
return
}
}
}
foreach mS $modeString {
set errorMessage "not [string map {R readable W writable X executable} $mS]"
if {[lsearch $fileString $mS] == -1} {error $errorMessage}
}
}
proc AcquireFile {root relative} {
set to [lindex [::vfs::filesystem info $root] end]
foreach path $::vfs::template::collate::readConfig($to) {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
if [file exists [file join $path $relative]] {return [file join $path $relative]}
}
vfs::filesystem posixerror $::vfs::posix(ENOENT) ; return -code error $::vfs::posix(ENOENT)
}
proc CreateDirectory {path root relative actualpath} {
set to [lindex [::vfs::filesystem info $root] end]
foreach path $::vfs::template::collate::writeConfig($to) {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
file mkdir [file join $path $relative]
}
}
proc DeleteFile {path root relative actualpath} {
set to [lindex [::vfs::filesystem info $root] end]
foreach path [concat $::vfs::template::collate::writeConfig($to) $::vfs::template::collate::collectConfig($to)] {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
file delete [file join $path $relative]
}
}
proc FileAttributes {path root relative actualpath} {
set fileName [AcquireFile $root $relative]
file attributes $fileName
}
proc FileAttributesSet {path root relative actualpath attribute value} {
set fileName [AcquireFile $root $relative]
file attributes $fileName $attribute $value
}
proc MatchInDirectory {path root relative actualpath pattern types} {
if [::vfs::matchDirectories $types] {lappend typeString d}
if [::vfs::matchFiles $types] {lappend typeString f}
set newGlobList {}
set to [lindex [::vfs::filesystem info $root] end]
foreach path $::vfs::template::collate::readConfig($to) {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
set globList "[glob -directory [file join $path $relative] -nocomplain -types $typeString $pattern] [glob -directory [file join $path $relative] -nocomplain -types "$typeString hidden" $pattern]"
set pathLength [expr [string length $path] - 1]
foreach gL $globList {
set gL [string replace $gL 0 $pathLength $root]
lappend newGlobList $gL
}
}
set newGlobList [lsort -unique $newGlobList]
return $newGlobList
}
proc Open {path root relative actualpath mode permissions} {
set to [lindex [::vfs::filesystem info $root] end]
if {$mode == "w"} {set mode w+}
if {$mode == "r"} {
set fileName [AcquireFile $root $relative]
} elseif {$::vfs::template::collate::writeConfig($to) == {}} {
vfs::filesystem posixerror $::vfs::posix(EROFS) ; return -code error $::vfs::posix(EROFS)
} else {
set path [lindex $::vfs::template::collate::writeConfig($to) 0]
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
set fileNameWrite [file join $path $relative]
if ![catch {set fileName [AcquireFile $root $relative]}] {
if ![string equal $fileName $fileNameWrite] {
catch {file copy -force $fileName $fileNameWrite}
}
}
set fileName $fileNameWrite
}
set newFile 0
if ![file exists $fileName] {set newFile 1}
set channelID [open $fileName $mode]
if $newFile {catch {file attributes $fileName -permissions $permissions}}
return $channelID
}
proc Close {channelID path root relative actualpath mode} {
# Do not close the channel in the close callback!
# It will crash Tcl! Honest!
# The core will close the channel after you've taken what info you need from it.
# close $channelID
set to [lindex [::vfs::filesystem info $root] end]
set path [lindex $::vfs::template::collate::writeConfig($to) 0]
set fileName [file join $path $relative]
foreach path $::vfs::template::collate::collectConfig($to) {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
if {[file normalize [file join $path $relative]] == [file normalize $fileName]} {continue}
seek $channelID 0
file mkdir [file dirname [file join $path $relative]]
set f [open [file join $path $relative] w]
fconfigure $f -translation binary
fcopy $channelID $f
close $f
}
if {$mode == "r"} {return}
foreach path $::vfs::template::collate::writeConfig($to) {
if {[lsearch $::vfs::template::collate::collectConfig($to) $path] > -1} {continue}
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
if {[file normalize [file join $path $relative]] == [file normalize $fileName]} {continue}
seek $channelID 0
set channelContents [read $channelID]
file mkdir [file dirname [file join $path $relative]]
set f [open [file join $path $relative] w]
fconfigure $f -translation binary
# fcopy $channelID $f
puts $f $channelContents
close $f
}
return
}
proc RemoveDirectory {path root relative actualpath} {
set to [lindex [::vfs::filesystem info $root] end]
foreach path [concat $::vfs::template::collate::writeConfig($to) $::vfs::template::collate::collectConfig($to)] {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
file delete -force [file join $path $relative]
}
}
proc Stat {path root relative actualpath} {
set fileName [AcquireFile $root $relative]
file stat $fileName fs
return [array get fs]
}
proc Utime {path root relative actualpath atime mtime} {
set to [lindex [::vfs::filesystem info $root] end]
foreach path $::vfs::template::collate::writeConfig($to) {
catch {set path [namespace eval ::vfs::template::collate {subst -nocommand -nobackslash $path}]}
set fileName [file join $path $relative]
file atime $fileName $atime
file mtime $fileName $mtime
}
}
}
# end namespace eval vfs::template::collateCMcC: This is a really important VFS, because it allows very flexible stacking of file systems, which gives you the ability to functionally compose file systems in a flexible manner.
jcw - Came late to the show, but I agree! SEH's VFS collection is starting to become a phenomenal toolbox, though I suspect that the implications will only become clear in actual use (or demo's of such). It does bring up another issue, which IMO deserves a page of its own: Array vs. VFS.
[ Category VFS ]