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