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