[WK] The following is a sample code that uses memchan to mount a VFS that saves everything in RAM. I wrote this because some code (like tclcompiler) needs to write to a file, so it's easier to put it on a dummy VFS than in a temporary file. Enjoy. package provide vfs::ram 0.5 # This works for basic operations, but has not been very debugged. namespace eval vfs::ram {} proc vfs::ram::Mount {domain local} { if {![catch {vfs::filesystem info $domain}]} { vfs::unmount $domain } vfs::filesystem mount $local [list vfs::ram::handler $domain] # Register command to unmount vfs::RegisterMount $local [list ::vfs::ram::Unmount $domain] return $domain } proc vfs::ram::Unmount {domain local} { vfs::filesystem unmount $local } proc vfs::ram::handler {dirurl cmd root relative actualpath args} { if {$cmd == "matchindirectory"} { eval [list $cmd $dirurl $relative $actualpath] $args } else { eval [list $cmd $dirurl $relative] $args } } # If we implement the commands below, we will have a perfect # virtual file system for remote http sites. proc vfs::ram::stat {dirurl name} { ::vfs::log "stat $name" if {[catch {_file_size $dirurl$name} size]} { vfs::filesystem posixerror $::vfs::posix(ENOENT) return } lappend res type file set mtime 0 lappend res dev -1 uid -1 gid -1 nlink 1 depth 0 \ atime $mtime ctime $mtime mtime $mtime mode 0777 size $size return $res } proc vfs::ram::access {dirurl name mode} { ::vfs::log "access $name $mode" vfs::filesystem posixerror $::vfs::posix(EROFS) return 1 } # We've chosen to implement these channels by using a memchan. # The alternative would be to use temporary files. proc vfs::ram::open {dirurl name mode permissions} { ::vfs::log "open $name $mode $permissions" # return a list of two elements: # 1. first element is the Tcl channel name which has been opened # 2. second element (optional) is a command to evaluate when # the channel is closed. set filed [vfs::memchan] vfs::ram::_onopen $mode $dirurl$name $filed return [list $filed [list vfs::ram::_onclose $mode $dirurl$name $filed]] } proc vfs::ram::matchindirectory {dirurl path actualpath pattern type} { ::vfs::log "matchindirectory $path $pattern $type" set res [list] return $res } proc vfs::ram::createdirectory {dirurl name} { ::vfs::log "createdirectory $name" vfs::filesystem posixerror $::vfs::posix(EROFS) } proc vfs::ram::removedirectory {dirurl name recursive} { ::vfs::log "removedirectory $name" vfs::filesystem posixerror $::vfs::posix(EROFS) } proc vfs::ram::deletefile {dirurl name} { ::vfs::log "deletefile $dirurl$name" if {[catch {_delete $dirurl$name}]} { vfs::filesystem posixerror $::vfs::posix(ENOENT) } } proc vfs::ram::fileattributes {dirurl path args} { ::vfs::log "fileattributes $args" switch -- [llength $args] { 0 { # list strings return [list] } 1 { # get value vfs::filesystem posixerror $::vfs::posix(EROFS) } 2 { # set value vfs::filesystem posixerror $::vfs::posix(EROFS) } } } proc vfs::ram::utime {dirurl path actime mtime} { vfs::filesystem posixerror $::vfs::posix(EROFS) } proc vfs::ram::_onopen {mode filename filed} { if {![catch {_file_get $filename} data]} { fconfigure $filed -translation binary puts -nonewline $filed $data seek $filed 0 fconfigure $filed -translation auto } } proc vfs::ram::_onclose {mode filename filed} { variable filedata fconfigure $filed -translation binary seek $filed 0 set data [read $filed] _file_set $filename $data } if {[info exists ::tcl_platform(threaded)]&&$::tcl_platform(threaded)} { package require Thread proc vfs::ram::_delete {filename} { tsv::unset VfsRam $filename } proc vfs::ram::_file_get {filename} { variable filedata return [tsv::get VfsRam $filename] } proc vfs::ram::_file_set {filename data} { variable filedata tsv::set VfsRam $filename $data } } else { proc vfs::ram::_delete {filename} { variable filedata unset filedata($filename) } proc vfs::ram::_file_get {filename} { variable filedata return $filedata($filename) } proc vfs::ram::_file_set {filename data} { variable filedata set filedata($filename) $data } } proc vfs::ram::_file_size {filename} { variable filedata return [string length [_file_get $filename]] }