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