Version 12 of A collate/broadcast virtual filesystem

Updated 2004-07-19 16:47:36 by SEH

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


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


 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]
        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::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]
                        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::Close $channelID $path $root $relative $actualpath]
                        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]
        if {![catch {vfs::filesystem info $to}]} {
                # unmount old mount
                Unmount $to
        }

        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
        return
 }

 proc Access {path root relative actualpath mode} {
        set modeString [::vfs::accessMode $mode]
        if {$modeString == "F"} {set modeString RWX}
        set modeString [split $modeString {}]
        set fileName [AcquireFile $root $relative]
        if [file readable $fileName] {lappend fileString R}
        if [file writable $fileName] {lappend fileString W}
        if [file executable $fileName] {lappend fileString X}
        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) {
                if [file isfile [file join $path $relative]] {return $path}
        }
        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) {
                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)] {
                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) {
                set globList [glob -directory [file join $path $relative] -nocomplain -types $typeString $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 == "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 fileNameWrite [file join [lindex [$::vfs::template::collate::writeConfig($to)] 0] $relative]
                if ![catch {set fileName [AcquireFile $root $relative]}] {
                        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}}
        fconfigure $channelID -translation binary
        foreach path $::vfs::template::collate::collectConfig($to) {
                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
        }
        fconfigure $channelID -translation auto
        return $channelID
 }

 proc Close {channelID path root relative actualpath} {
 # 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 fileName [file join $path $relative]
        set to [lindex [::vfs::filesystem info $root] end]
        fconfigure $channelID -translation binary
        foreach path $::vfs::template::collate::writeConfig($to) {
                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
        }

        foreach path $::vfs::template::collate::collectConfig($to) {
                if {[lsearch $::vfs::template::collate::writeConfig($to) $path] > -1} {continue}
                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
        }
        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)] {
                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) {
                set fileName [file join $path $relative]
                file atime $fileName $atime
                file mtime $fileName $mtime
        }
 }

 }
 # end namespace eval vfs::template::collate

[ Category VFS ]