1if 0 { 2######################## 3 4deltavfs.tcl -- 5 6Written by Stephen Huntley (stephen.huntley@alum.mit.edu) 7License: Tcl license 8Version 1.5.2 9 10A delta virtual filesystem. Requires the template vfs in templatevfs.tcl. 11 12Mount the delta vfs first, then mount the versioning vfs using the virtual location created by the 13delta vfs as its existing directory. 14 15As the versioning filesystem generates a new separate file for every file edit, this filesystem will 16invisibly generate and manage deltas of the separate versions to save space. 17 18 19Usage: mount <existing directory> <virtual directory> 20 21 22The delta vfs inherits the -cache and -volume options of the template vfs. 23 24######################## 25} 26 27package require vfs::template 1.5 28package require vfs::template::version 1.5 29 30package provide vfs::template::version::delta 1.5.2 31 32namespace eval ::vfs::template::version::delta { 33 34# read template procedures into current namespace. Do not edit: 35foreach templateProc [namespace eval ::vfs::template {info procs}] { 36 set infoArgs [info args ::vfs::template::$templateProc] 37 set infoBody [info body ::vfs::template::$templateProc] 38 proc $templateProc $infoArgs $infoBody 39} 40 41# edit following procedures: 42proc close_ {channel} { 43 upvar path path relative relative 44 set file [file join $path $relative] 45 set fileName $file 46 set f [open $fileName w] 47 fconfigure $f -translation binary 48 seek $f 0 49 seek $channel 0 50 fcopy $channel $f 51 close $f 52 Delta $fileName 53 return 54} 55proc file_atime {file time} { 56 set file [GetFileName $file] 57 file atime $file $time 58} 59proc file_mtime {file time} { 60 set file [GetFileName $file] 61 file mtime $file $time 62} 63proc file_attributes {file {attribute {}} args} { 64 set file [GetFileName $file] 65 eval file attributes \$file $attribute $args 66} 67proc file_delete {file} { 68 if [file isdirectory $file] {catch {file delete $file}} 69 70 set fileName [GetFileName $file] 71 set timeStamp [lindex [split [file tail $fileName] \;] 1] 72 if [string equal $timeStamp {}] { 73 catch {file delete $fileName} result 74 return 75 } 76 set targetFile [Reconstitute $fileName] 77 set referenceFiles [glob -directory [file dirname $fileName] -nocomplain *vfs&delta$timeStamp] 78 if {[lindex [file system $fileName] 0] != "tclvfs"} {append referenceFiles " [glob -directory [file dirname $fileName] -nocomplain -type hidden *vfs&delta$timeStamp]"} 79 foreach referenceFile $referenceFiles { 80 regsub {\;vfs&delta[0-9]*$} $referenceFile "" reconFile] 81 set f [open $referenceFile r] 82 fconfigure $f -translation binary 83 set signature [read $f] 84 close $f 85 tpatch $targetFile $signature $reconFile 86 file delete $referenceFile 87 } 88 close $targetFile 89 90 file delete -force -- $fileName 91} 92proc file_executable {file} { 93 set file [GetFileName $file] 94 file executable $file 95} 96proc file_exists {file} { 97 set file [GetFileName $file] 98 file exists $file 99} 100proc file_mkdir {file} {file mkdir $file} 101proc file_readable {file} { 102 set file [GetFileName $file] 103 file readable $file 104} 105proc file_stat {file array} { 106 upvar $array fs 107 set fileName [GetFileName $file] 108 109 set endtag [lindex [split $fileName \;] end] 110 if {[string first "vfs&delta" $endtag] || [string equal "vfs&delta" $endtag]} {file stat $fileName fs ; return} 111 set f [open $fileName r] 112 fconfigure $f -translation binary 113 set copyinstructions [read $f] 114 close $f 115 array set fileStats [lindex $copyinstructions 3] 116 unset copyinstructions 117 set size $fileStats(size) 118 file stat $fileName fs 119 set fs(size) $size 120 return 121} 122proc file_writable {file} { 123 set file [GetFileName $file] 124 file writable $file 125} 126proc glob_ {directory dir nocomplain tails types typeString dashes pattern} { 127 set globList [glob -directory $dir -nocomplain -tails -types $typeString -- $pattern] 128 set newGlobList {} 129 foreach gL $globList { 130 regsub {\;vfs&delta.*$} $gL "" gL 131 lappend newGlobList $gL 132 } 133 return $newGlobList 134} 135proc open_ {file mode} { 136 set fileName [GetFileName $file] 137 138 set newFile 0 139 if ![file exists $fileName] {set newFile 1} 140 set fileName $file 141 set channelID [Reconstitute $fileName] 142 if [string equal $channelID {}] {set channelID [open $fileName $mode] ; close $channelID ; set channelID [memchan]} 143 if $newFile {catch {file attributes $fileName -permissions $permissions}} 144 return $channelID 145} 146 147 148proc MountProcedure {args} { 149 upvar volume volume 150 151# take real and virtual directories from command line args. 152 set to [lindex $args end] 153 if [string equal $volume {}] {set to [::file normalize $to]} 154 set path [::file normalize [lindex $args end-1]] 155 156# make sure mount location exists: 157 ::file mkdir $path 158 159# add custom handling for new vfs args here. 160 package require trsync 161 namespace import -force ::trsync::tdelta ::trsync::tpatch 162 163# return two-item list consisting of real and virtual locations. 164 lappend pathto $path 165 lappend pathto $to 166 return $pathto 167} 168 169 170proc UnmountProcedure {path to} { 171# add custom unmount handling of new vfs elements here. 172 173 return 174} 175 176proc Delta {filename} { 177 set fileRoot [lindex [split [file tail $filename] \;] 0] 178 set fileNames [glob -nocomplain -path [file join [file dirname $filename] $fileRoot] *] 179 if {[lindex [file system $filename] 0] != "tclvfs"} {append fileNames " [glob -nocomplain -path [file join [file dirname $filename] $fileRoot] -type hidden *]"} 180 set nonDeltas {} 181 foreach fn $fileNames { 182 set endtag [lindex [split $fn \;] end] 183 if ![string first "vfs&delta" $endtag] {continue} 184 lappend nonDeltas $fn 185 set atimes($fn) [file atime $fn] 186 } 187 if {[set deltaIndex [llength $nonDeltas]] < 2} {return} 188 set nonDeltas [lsort -dictionary $nonDeltas] 189 incr deltaIndex -1 190 set i 0 191 while {$i < $deltaIndex} { 192 set referenceFile [lindex $nonDeltas $i] 193 set targetFile [lindex $nonDeltas [incr i]] 194 set signature [tdelta $referenceFile $targetFile $::trsync::blockSize 1 1] 195 set targetTimeStamp [lindex [split $targetFile \;] 1] 196 197 file stat $referenceFile fileStats 198 set signatureSize [string length $signature] 199 if {$signatureSize > $fileStats(size)} { 200 set fileName $referenceFile\;vfs&delta 201 file rename $referenceFile $fileName 202 continue 203 } 204 205 array set fileStats [file attributes $referenceFile] 206 207 set fileName $referenceFile\;vfs&delta$targetTimeStamp 208 set f [open $fileName w] 209 fconfigure $f -translation binary 210 puts -nonewline $f $signature 211 close $f 212 file delete $referenceFile 213 array set fileAttributes [file attributes $fileName] 214 if [info exists fileAttributes(-readonly)] {catch {file attributes $fileName -readonly 0}} 215 if [info exists fileAttributes(-permissions)] {catch {file attributes $fileName -permissions rw-rw-rw-}} 216 catch {file attributes $fileName -owner $fileStats(uid)} 217 catch {file attributes $fileName -group $fileStats(gid)} 218 219 catch {file mtime $fileName $fileStats(mtime)} 220 catch {file atime $fileName $fileStats(atime)} 221 222 foreach attr [array names fileStats] { 223 if [string first "-" $attr] {continue} 224 if [string equal [array get fileStats $attr] [array get fileAttributes $attr]] {continue} 225 if [string equal "-permissions" $attr] {continue} 226 catch {file attributes $fileName $attr $fileStats($attr)} 227 } 228 catch {file attributes $fileName -permissions $fileStats(mode)} 229 catch {file attributes $fileName -readonly $fileStats(-readonly)} 230 } 231 foreach fn [array names atimes] { 232 if ![file exists $fn] {continue} 233 file atime $fn $atimes($fn) 234 } 235} 236 237proc GetFileName {file} { 238 set isdir 0 239 if {([string first \; $file] == -1) && ![set isdir [file isdirectory $file]]} {return {}} 240 if $isdir {return $file} 241 set fileNames [glob -nocomplain -path $file *] 242 if {[lindex [file system $file] 0] != "tclvfs"} {append fileNames " [glob -nocomplain -path $file -type hidden *]"} 243 set fileName [lindex $fileNames 0] 244 if [set i [expr [lsearch -exact $fileNames $file] + 1]] {set fileName [lindex $fileNames [incr i -1]]} 245 return $fileName 246} 247 248proc Reconstitute {fileName} { 249 if ![catch {set channelID [open $fileName r]}] {return $channelID} 250 if ![catch {set channelID [open $fileName\;vfs&delta r]}] {return $channelID} 251 set targetFiles [glob -nocomplain -path $fileName *] 252 if {[lindex [file system $fileName] 0] != "tclvfs"} {append targetFiles " [glob -nocomplain -path $fileName -type hidden *]"} 253 set targetFile [lindex $targetFiles 0] 254 255 set targetFile [string trim $targetFile] 256 if [string equal $targetFile {}] {return} 257 set fileStack {} 258 while {[string first "\;vfs&delta" $targetFile] > -1} { 259 if ![regexp {\;vfs&delta([0-9]+)$} $targetFile trash targetTime] {break} 260 set fileStack "[list $targetFile] $fileStack" 261 set targetFiles [glob -directory [file dirname $fileName] *\;$targetTime*] 262 if {[lindex [file system $fileName] 0] != "tclvfs"} {append targetFiles " [glob -directory [file dirname $fileName] -nocomplain -type hidden *\;$targetTime*]"} 263 set targetFile [lindex $targetFiles 0] 264 265 set atimes($targetFile) [file atime $targetFile] 266 } 267 set targetFile [open $targetFile r] 268 foreach fs $fileStack { 269 set f [open $fs r] 270 fconfigure $f -translation binary 271 set copyInstructions [read $f] 272 close $f 273 set fileToConstruct [memchan] 274 tpatch $targetFile $copyInstructions $fileToConstruct 275 catch {close $targetFile} 276 set targetFile $fileToConstruct 277 } 278 foreach fn [array names atimes] { 279 file atime $fn $atimes($fn) 280 } 281 fconfigure $targetFile -translation auto 282 seek $targetFile 0 283 return $targetFile 284} 285 286} 287# end namespace ::vfs::template::version::delta 288 289