SEH As a self-teaching exercise, I wrote a sample virtual filesystem that utilizes as much of the Tclvfs API as possible, although its function is trivially simple. The virtual filesystems included with the Tclvfs distribution are instructive, but they take a lot of shortcuts.
LV Would it be beneficial a) to include this template with tclvfs and b) to upgrade the existing tclvfs examples with the features your template provide?
SEH I would love to have my work incorporated into the tcllib, but I don't think it's my decision.
CMcC With all respect to SEH, whose idea the template vfs is, I would like to suggest that the template vfs either be rewritten in Snit, or a parallel version in Snit written and maintained as part of the same package. I have rewritten Steve's template vfs in Snit, for the reasons I give below (although I'm not suggesting that my version is necessarily the best possible version.)
The reasons to use Snit for template vfs:
Rubbish reasons not to use Snit for vfs:
Real reasons not to use Snit for tclvfs:
Finally, the best reason for using Snit for tclvfs: Much of the need for this Template vfs is that the tclvfs raw interface has some anomalies and some lacks.
The template vfs is really a shim to provide:
Some of the provisions in point 1 can eventually be moved into the tclvfs C core. Doing this over an OO interface is (I believe) easier and less disruptive than doing it over a pure namespace implementation.
Therefore: I would like to argue, passionately, for at least *some* OO interface, and preferably Snit (because it seems to be the ostensive standard for pure tcl OO,) whether or not this is maintained in parallel with or alternative to a pure namespace template tclvfs shim. I would also like to see the existing tclvfs' migrated to whatever system is adopted, and new tclvfs' adhering to whatever that system is.
Addendum: Of course, if it's a choice between a raw namespace template vfs and a no template vfs at all, I would emphatically prefer the namespace template vfs.
SEH - 10/18/04 - My motivation for writing the template vfs was both to teach myself the Tclvfs API, and to verify that the Tclvfs package was in good enough shape to write software tools around, since I have been bitterly disappointed in the past by the gulf between claims of maturity in software and emergent reality. I'm very enthusiastic about the vfs concept, and I think it's a solution looking for problems. But the bottom line is the Tclvfs package is still officially in a beta state, and writing the template vfs did indeed reveal significant issues, some of which it appears will require changes in the core to address. Given that, I find it hard to justify the extra time and effort necessary to increase the sophistication of the vfs's as you suggest. No amount of polish in the vfs code will compensate for the inherent flaws in the underlying package. If the maintainers of the package are willing to commit to bringing it out of beta and fixing the identified issues, I will revisit the possibility of taking the vfs's to the next level. Until then, I'm going to put my available time into solving the problems I face in the present that the Tclvfs package and the vfs's are capable of helping with in their current state.
On the other hand, I was also hoping to spark interest in the Tclvfs package, which seemed to be languishing, so I am heartened by your involvement and advocacy. I hope the friction and noise will help to motivate the maintainers.
P.S. By way of further motivation, I think there are enough bits floating around now to envision, if consolidated, a sophisticated content management/version control/code distribution and installation service that would knock Bitkeeper on its heels and blow the doors off anything offered by any competing scripting technology.
Because it simply mirrors a real filesystem location, I believe this vfs is maximally featureful.
My aim for this vfs is to use it as a template for rapid development of new and more complex filesystems.
The Mount, Unmount and handler procedures are completely generic and should never need customization for new filesystems. Thus the task of creating a new virtual filesystem is reduced to filling in the procedures for handling the eight subcommands of the Tclvfs API, as well as mounting and unmounting specifics.
SEH -- 10/14/04 -- I tidied things up a bit, and added an execution trace to the 'close' command so that it will throw a proper error if an error occurs in the close callback procedure. Not too relevant for this vfs, but for more complex ones built on the template.
I also added a "-volume" option to the Mount command, so you can now do things like:
::vfs::template::Mount -volume $env(HOME) C:/
on Unix, and make pathnames originating on Windows acceptable. Problems syncing cross-platform filesystems solved! Schweet!
package require vfs 1 namespace eval ::vfs::template {} # The template vfs simply mirrors a real directory to a virtual location. # Usage: Mount ?-volume? <real directory> <virtual directory> proc ::vfs::template::Mount {args} { set volume {} if {[lindex $args 0] == "-volume"} {set volume "-volume"} set pathto [eval MountProcedure $args] set path [lindex $pathto 0] set to [lindex $pathto 1] eval ::vfs::filesystem mount $volume \$to \[list ::vfs::template::handler \$path\] ::vfs::RegisterMount $to [list ::vfs::template::Unmount] if {[trace info execution close] == {}} { trace add execution close leave ::vfs::template::CloseTrace } return $to } proc ::vfs::template::Unmount {to} { set to [file normalize $to] set path [lindex [::vfs::filesystem info $to] end] UnmountProcedure $path $to ::vfs::filesystem unmount $to } proc ::vfs::template::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::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 $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 { proc MountProcedure {args} { if {[lindex $args 0] == "-volume"} { set args [lrange $args 1 end] set to [lindex $args 1] } else { set to [file normalize [lindex $args 1]] } set path [file normalize [lindex $args 0]] if [info exists ::vfs::_unmountCmd($to)] {::vfs::unmount $to} file mkdir $path lappend pathto $path lappend pathto $to return $pathto } proc UnmountProcedure {path 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 [file join $path $relative] set fileString {} 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 CreateDirectory {path root relative actualpath} { file mkdir [file join $path $relative] } proc DeleteFile {path root relative actualpath} { set fileName [file join $path $relative] file delete $fileName } proc FileAttributes {path root relative actualpath} { set fileName [file join $path $relative] file attributes $fileName } proc FileAttributesSet {path root relative actualpath attribute value} { set fileName [file join $path $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} if [::vfs::matchFiles $types] {lappend typeString f} set globList [glob -directory [file join $path $relative] -nocomplain -types $typeString $pattern] set pathLength [expr [string length $path] - 1] set newGlobList {} foreach gL $globList { set gL [string replace $gL 0 $pathLength $root] lappend newGlobList $gL } return $newGlobList } proc Open {path root relative actualpath mode permissions} { set fileName [file join $path $relative] 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 return } proc RemoveDirectory {path root relative actualpath} { file delete -force [file join $path $relative] } proc Stat {path root relative actualpath} { file stat [file join $path $relative] fs return [list dev $fs(dev) ino $fs(ino) mode $fs(mode) nlink $fs(nlink) uid $fs(uid) gid $fs(gid) size $fs(size) atime $fs(atime) mtime $fs(mtime) ctime $fs(ctime) type $fs(type)] } proc Utime {path root relative actualpath atime mtime} { set fileName [file join $path $relative] file atime $fileName $atime file mtime $fileName $mtime } } # end namespace eval ::vfs::template
20040720 CMcC: I just saw a real use for this - a trace fs. Someone was trying to work out why copy -force was failing, it would have been nice to be able to say to them: mount this on your directory and look at the log. Trivial addition to this template - log each argument to, and result from, underlying file system.
snitvfs has a reimplementation of this, in Snit.
[ Category Example | Category VFS ]