#----------------------------------------------------------------------
# Virtual File System for Verision Control Systems
#
# Copyright (c) 2014, Peter Spjuth
#
# License for vcsvfs package: Same as for Tcl
#----------------------------------------------------------------------
package require vfs
package provide vcsvfs 0.1
namespace eval vcsvfs {
variable DataRefChan
namespace eval fossil {
variable mpoints {}
}
}
# Create a Virtual File System showing a revision of a fossil checkout
#
# dir: Directory in a fossil checkout
# rev: Revision to mount
#
# Returns: path to the generated VFS
proc vcsvfs::fossil::mount {dir rev} {
variable mpoints
set dir [file normalize $dir]
# Fossil command must be run within the dir, so temporarily change pwd
set oldpwd [pwd]
cd $dir
# The mount point will always be at the fossil root, even if
# a sub directory was given.
# Locate fossil root for the given directory.
set info [exec fossil info]
regexp -line {local-root:\s*(\S.*)} $info -> root
set root [file normalize $root]
cd $root
# Getting files via ls
set allfiles [exec fossil ls --age $rev .]
foreach line [split $allfiles \n] {
# Expected format in a line:
# 2012-08-21 20:38:19 tests/rev.test
regexp {(\S+ \S+)\s+(.+)} $line -> fDate fName
dict set finfo $fName mtimestr $fDate
dict set finfo $fName isfile 1
dict set finfo $fName isdir 0
# Mark all known directory paths and build up file tree info
set parentStr ""
foreach dirPath [file split $fName] {
dict set finfo $parentStr child $dirPath 1
dict set finfo $parentStr isfile 0
dict set finfo $parentStr isdir 1
set parentStr [file join $parentStr $dirPath]
}
}
# Getting files via artifact
set artifact [exec fossil artifact $rev]
foreach line [split $artifact \n] {
# Expected format in a line:
# F tests/left.txt c1572b3809a1ba6ab2de9307c96b1cfeefdcf0ba
if {[regexp {F (\S+) (\S+)} $line -> fName fSha]} {
# File names can have spaces, coded with \s
set fName [string map {\\s " "} $fName]
dict set finfo $fName sha $fSha
# TBD: Delay calling whatis until size is needed
# Expected format in a line:
# size: 629 bytes
set whatis [exec fossil whatis $fSha]
regexp {size:\s+(\d+)} $whatis -> fSize
dict set finfo $fName size $fSize
}
}
cd $oldpwd
# Generate a mount point.
set tail [string range $dir [string length $root] end]
set mountpoint "${root} ($rev)"
dict set mpoints $mountpoint finfo $finfo
dict set mpoints $mountpoint origroot $root
dict set mpoints $mountpoint rev $rev
vfs::filesystem mount $mountpoint [list vcsvfs::fossil::Vfs]
set result $mountpoint$tail
#puts $result
#puts [dict size $finfo]
#puts [dict get $finfo [lindex $finfo 0]]
return $result
}
proc vcsvfs::fossil::unmount {dir} {
variable mpoints
# TBD: Find the mountpoint
#dict unset mpoints $mountpoint
#vfs::filesystem unmount $mountpoint
}
# Handler for Reflected Channel
proc vcsvfs::DataRefChan {id cmd chId args} {
variable DataRefChan
switch $cmd {
initialize {
set mode [lindex $args 0]
return "initialize finalize watch read"
}
finalize {
unset DataRefChan($id,data)
return
}
watch {
#set eventSpec [lindex $args 0]
return
}
read {
set count [lindex $args 0]
set si $DataRefChan($id,ptr)
set newPtr [expr {$si + $count}]
set ei [expr {$newPtr - 1}]
set data [string range $DataRefChan($id,data) $si $ei]
set DataRefChan($id,ptr) $newPtr
return $data
}
}
}
# Set up a Reflected Channel which reads the provided data
proc vcsvfs::CreateDataRefChan {data} {
variable DataRefChan
set t 0
while {[info exists DataRefChan($t,data)]} {
incr t
}
set DataRefChan($t,data) $data
set DataRefChan($t,ptr) 0
set chId [chan create r [list vcsvfs::DataRefChan $t]]
return $chId
}
# Helper for glob matching in directory
proc vcsvfs::MatchInDirectory {finfo relative actual args} {
set pattern [lindex $args 0]
set types [lindex $args 1]
set allowFile 0
set allowDir 0
if {[::vfs::matchDirectories $types]} {set allowDir 1}
if {[::vfs::matchFiles $types]} {set allowFile 1}
set result {}
foreach child [dict keys [dict get $finfo $relative child]] {
if {![string match $pattern $child]} continue
set local [file join $relative $child]
if {[dict get $finfo $local isfile] && !$allowFile} continue
if {[dict get $finfo $local isdir] && !$allowDir} continue
lappend result [file join $actual $child]
}
return $result
}
# The handler for the mounted VFS
proc vcsvfs::fossil::Vfs {subcmd root relative actual args} {
variable mpoints
#puts "\nfossilVfs called:"
#puts " Su $subcmd"
#puts " Ro $root"
#puts " Re $relative"
#puts " Ac $actual"
#puts " Ar $args"
set origroot [dict get $mpoints $root origroot]
set finfo [dict get $mpoints $root finfo]
if {![dict exists $finfo $relative]} {
# Unknown path
vfs::filesystem posixerror $::vfs::posix(EACCES)
return -code error $::vfs::posix(EACCES)
}
set finfor [dict get $finfo $relative]
#puts " $finfor"
switch $subcmd {
access {
set mode [vfs::accessMode [lindex $args 0]]
# Only read supported
if {$mode ne "R"} {
vfs::filesystem posixerror $::vfs::posix(EACCES)
return -code error $::vfs::posix(EACCES)
}
return
}
fileattributes {
#set index [lindex $args 0]
#set value [lindex $args 1]
return
}
matchindirectory {
return [vcsvfs::MatchInDirectory $finfo $relative $actual {*}$args]
}
open {
set mode [lindex $args 0]
if {$mode == {}} {set mode r}
#set permissions [lindex $args 1]
if {$mode ne "r"} {
# Read only
vfs::filesystem posixerror $::vfs::posix(EACCES)
return -code error $::vfs::posix(EACCES)
}
set oldpwd [pwd]
cd [dict get $mpoints $root origroot]
set rev [dict get $mpoints $root rev]
set data [exec fossil cat $relative -r $rev]
cd $oldpwd
set chId [vcsvfs::CreateDataRefChan $data]
return [list $chId ""]
}
stat {
set res [dict create dev 0 ino 0 mode 0 nlink 0 uid 0 gid 0 \
size 0 atime 0 mtime 0 ctime 0 type file]
if {[dict get $finfor isdir]} {
# TBD, fake mtime etc. for directory?
dict set res type directory
} else {
if {![dict exists $finfor mtime]} {
set str [dict get $finfor mtimestr]
# TBD parse to mtime correct?
set mtime [clock scan $str -gmt 1]
dict set finfor mtime $mtime
# Cache in main dictionary too
dict set mpoints $root finfo $relative mtime $mtime
}
dict set res mtime [dict get $finfor mtime]
dict set res size [dict get $finfor size]
}
return $res
}
createdirectory - deletefile - removedirectory - utime {
# Read-only, always error
}
}
vfs::filesystem posixerror $::vfs::posix(EACCES)
return -code error $::vfs::posix(EACCES)
}
##################################################################
# Test structure
##################################################################
if 0 {
# File traversing stuff from wiki...
proc ftw_1 {{dirs .}} {
while {[llength $dirs]} {
set dirs [lassign $dirs name]
lappend dirs {*}[glob -nocomplain -directory $name -type d *]
puts $name
}
}
proc ls-l { dir } {
# Get the current year, because the date format depends on it.
set thisYear [clock format [clock seconds] -format %Y]
# Walk the files in the given directory, accumulating lines
# in $retval
set retval {}
set sep {}
# In Tcl older than 8.3 use 'glob [file join $dir *]'
foreach fileName [lsort [glob -dir $dir *]] {
append retval $sep
set sep \n
# Get status of the file
#file stat $fileName stat
# use 'file lstat' instead: if the file is a symbolic link we don't want info about its target
file lstat $fileName stat
# Put in one character for file type. Use - for a plain file.
set type -
if { [info exists stat(type)]
&& [string compare file $stat(type)] } {
set type [string index $stat(type) 0]
}
append retval $type
# Decode $stat(mode) into permissions the way that ls does it.
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 retval $bit
}
# Put in link count, user ID, and size. Note that the UID
# will be numeric. If you know how to back-translate this
# from Tcl, please feel free to edit it in!
# LV writes - use file userid and file groupid to convert the numbers back to names.
# I don't know what version of Tcl added those commands...
append retval [format %4d $stat(nlink)] { }
array set attribs [file attributes $fileName]
if {[info exists attribs(-owner)]} {
append retval [format %-8s $attribs(-owner)]
append retval [format %-8s $attribs(-group)]
} else {
append retval [format %8d $stat(uid)]
append retval [format %8d $stat(gid)]
}
append retval [format %9d $stat(size)]
# Put in the date. The current year is formatted differently
# from prior years.
set year [clock format $stat(mtime) -format "%Y"]
if { $year == $thisYear } {
set modified [clock format $stat(mtime) -format "%h %e %H:%M"]
} else {
set modified [clock format $stat(mtime) -format "%h %e %Y"]
}
# glennj: see note below
append retval { } $modified { }
# Finally, put in the file name, stripping off the directory.
append retval [file tail $fileName]
if {[string compare $stat(type) link] == 0} {
append retval " -> [file readlink $fileName]"
}
if {$type eq "-"} {
set ch [open $fileName]
set x [read $ch]
set x [string range $x 0 4]
close $ch
append retval " = '$x'"
}
unset stat attribs
}
return $retval
}
set d [vcsvfs::fossil::mount ~/src/eskil f96b0fd915]
puts "------------- GLOB:"
puts [join [glob -dir $d *] \n]
puts "------------- FTW:"
ftw_1 [list $d]
puts "------------- LS:"
puts [ls-l $d]
}