1if 0 {
2########################
3
4collatevfs.tcl --
5
6Written by Stephen Huntley (stephen.huntley@alum.mit.edu)
7License: Tcl license
8Version 1.5.3
9
10A collate/broadcast/collect/catchup virtual filesystem.  Requires the template vfs in templatevfs.tcl.
11
12Collate: reads from multiple specified directories and presents the results as one at the mount location.
13
14Broadcast: applies all writes in the mount location to multiple specified directories.
15
16Collect: copies any file read from or written to any of the above locations to specified directories.
17
18Catchup: If any specified directory is not available during any write action, the action is recorded in
19a catchup queue.  With each subsequent write action, the queue is examined, and if any directory has
20become available, the action is performed, allowing offline directories to "catch up."
21
22Usage: mount ?-read <directories> -write <directories> -collect <directories> -catchup <directories>? <virtual directory>
23
24Each pathname in <directories> is meant to stand individually, the <directories> symbol is not meant to indicate a
25Tcl list.  The sets of specified locations are independent; they can overlap or not as desired.  Note each
26option flag is optional, one could for example use only the -read flag to create a read-only directory.  Directories
27do not have to exist and may go missing after mount, non-reachable locations will be ignored.
28
29Options:
30
31-read
32When an individual file is opened for reading, each of the directories specified is searched in
33order for the file; the first file found with the appropriate name is opened.  When a subdirectory listing is
34generated, the combined files of the corresponding subdirectory of all specified directories are listed together.
35
36-write
37When an individual file is opened for writing, each of the directories specified is searched in
38order for the file; the first file found with the appropriate name is opened.  If the file doesn't exist,
39it is created in the first specified write location.  When the file is closed, a copy of it is distributed to
40each specified write directory.
41
42-collect
43Auto-generates one or more file caches; a copy of any file opened for reading or writing in any of the above
44specified directories is made to each directory specified with the -collect flag.  Collect locations are
45not included in file or directory listings, and are not searched for read access; so in order to make an
46active read cache, for example, one would have to include one directory location in both the -read and -collect sets.
47
48-catchup
49If this flag is included, the catchup function is activated, and a copy of the catchup queue is stored in a
50file in each of the specified directories.  File writes, directory creations and file/directory deletes are
51stored in the catchup queue if any write location is offline; at the next write/creation/delete the queue is
52examined, and if any skipped action can be completed due to a location becoming available again, it
53will be.  A catchup attempt will be made at mount time if this flag is included.
54
55The values of each option can be changed dynamically after mount by using the "file attributes" command on the
56mount virtual directory. Each option is editable as an attribute; i.e., "file attributes C:/collate -write C:/tmp"
57
58The collate vfs inherits the -cache and -volume options of the template vfs.
59
60
61Example use: specify parallel locations on a hard drive, on a CD-ROM mount and an ftp vfs as the read list.
62Files will be read first from the hard drive, if not found there the CD-ROM and ftp site will be searched in turn.
63The hard drive can be specified as the single write location, and no writes to the CD-ROM or
64ftp site will ever be attempted:
65
66mount -read C:/install/package/docs CDROM:/package/docs FTP:/pub/releases/package/docs -write C:/install/package/docs C:/collate/docs
67
68
69Example collect location use: specify a single hard drive location as a read and collect directory.
70Specify a ftp vfs as a secondary read directory.  As ftp files are downloaded they are copied to the
71collect directory; the local copies are accessed first on subsequent reads: hence the collect
72specification produces a self-generating local cache:
73
74mount -read C:/install/package/images FTP:/pub/releases/package/images -collect C:/install/package/images C:/collate/images
75
76
77########################
78}
79
80package require vfs::template 1.5
81
82namespace eval ::vfs::template::collate {
83
84# read template procedures into current namespace. Do not edit:
85foreach templateProc [namespace eval ::vfs::template {info procs}] {
86	set infoArgs [info args ::vfs::template::$templateProc]
87	set infoBody [info body ::vfs::template::$templateProc]
88	proc $templateProc $infoArgs $infoBody
89}
90
91# edit following procedures:
92proc close_ {channel} {
93	upvar root root relative relative
94	foreach file [lrange [WriteFile $root $relative close] 1 end] {
95		if ![WriteTest $file] {continue}
96		file mkdir [file dirname $file]
97		set f [open $file w]
98		fconfigure $f -translation binary
99		seek $channel 0
100		fcopy $channel $f
101		close $f
102	}
103	return
104}
105proc file_atime {file time} {
106	upvar root root relative relative
107	foreach file [WriteFile $root $relative open] {
108		file atime $file $time
109	}
110}
111proc file_mtime {file time} {
112	upvar root root relative relative
113	foreach file [WriteFile $root $relative open] {
114		file mtime $file $time
115	}
116}
117proc file_attributes {file {attribute {}} args} {
118	upvar root root relative relative
119	if {($relative == {}) && ([string map {-read 1 -write 1 -collect 1 -catchup 1} $attribute] == 1)} {
120		set attribute [string range $attribute 1 end]
121		if {$args == {}} {eval return \$::vfs::template::collate::${attribute}(\$root)}
122		set ::vfs::template::collate::${attribute}($root) [lindex $args 0]
123		set ::vfs::template::collate::catchup [file isdirectory [lindex $::vfs::template::collate::catchupstore 0]]
124		return
125	}
126	if {$args != {}} {
127		foreach file [WriteFile $root $relative open] {
128			file attributes $file $attribute $args
129		}
130		return
131	}
132	set file [AcquireFile $root $relative]
133	set returnValue [eval file attributes \$file $attribute $args]
134	if {($relative == {}) && ($attribute == {})} {set returnValue [concat $returnValue [list -read $::vfs::template::collate::read($root) -write $::vfs::template::collate::write($root) -collect $::vfs::template::collate::collect($root) -catchup $::vfs::template::collate::catchupstore($root)]]}
135	return $returnValue
136}
137proc file_delete {file} {
138	upvar root root relative relative
139	foreach file [WriteFile $root $relative delete] {
140		file delete -force -- $file
141	}
142}
143proc file_executable {file} {
144	upvar root root relative relative
145	set file [AcquireFile $root $relative]
146	file executable $file
147}
148proc file_exists {file} {
149	upvar root root relative relative
150	expr ![catch {AcquireFile $root $relative}]
151}
152proc file_mkdir {file} {
153	upvar root root relative relative
154	foreach file [WriteFile $root $relative mkdir] {
155		file mkdir $file
156	}
157}
158proc file_readable {file} {
159	upvar root root relative relative
160	set file [AcquireFile $root $relative]
161	file readable $file
162}
163proc file_stat {file array} {
164	upvar root root relative relative
165	set file [AcquireFile $root $relative]
166	upvar $array fs ; file stat $file fs
167}
168proc file_writable {file} {
169	upvar root root relative relative
170	expr ![catch {WriteFile $root $relative open}]
171}
172proc glob_ {directory dir nocomplain tails types typeString dashes pattern} {
173	upvar root root relative relative
174	set allFiles {}
175	set newFiles {}
176	foreach path $::vfs::template::collate::read($root) {
177		if ![file exists $path] {continue}
178		set allFiles [concat $allFiles [glob -directory [file join $path $relative] -nocomplain -tails -types $typeString -- $pattern]]
179	}
180	set allFiles [lsort -unique $allFiles]
181	return $allFiles
182}
183proc open_ {file mode} {
184	upvar root root relative relative
185	if [string match w* $mode] {
186		set file [lindex [WriteFile $root $relative open] 0]
187		file mkdir [file dirname $file]
188		return [open $file $mode]
189	}
190	if [string match r* $mode] {
191		set file [AcquireFile $root $relative]
192		if {$mode == "r"} {
193			foreach cpath $::vfs::template::collate::collect($root) {
194				set cfile [file join $cpath $relative]
195				if {$file == $cfile} {continue}
196				if ![file exists $cpath] {continue}
197				file mkdir [::file dirname $cfile]
198				file copy -force -- $file $cfile
199			}
200			return [open $file r]
201		}
202		set wfile [lindex [WriteFile $root $relative open] 0]
203		file mkdir [file dirname $wfile]
204		if {$wfile != $file} {file copy -force -- $file $wfile}
205		return [open $wfile $mode]
206	}
207	if [string match a* $mode] {
208		set wfile [lindex [WriteFile $root $relative open] 0]
209		file mkdir [file dirname $wfile]
210		if ![catch {set file [AcquireFile $root $relative]}] {
211			if {$wfile != $file} {file copy -force -- $file $wfile}
212		}
213		return [open $wfile $mode]
214	}
215}
216
217proc MountProcedure {args} {
218	upvar volume volume
219
220# take real and virtual directories from command line args.
221	set to [lindex $args end]
222	if [string equal $volume {}] {set to [::file normalize $to]}
223
224# add custom handling for new vfs args here.
225
226	set ::vfs::template::collate::catchup($to) 0
227	set ::vfs::template::collate::read($to) {}
228	set ::vfs::template::collate::write($to) {}
229	set ::vfs::template::collate::collect($to) {}
230	set ::vfs::template::collate::catchupstore($to) {}
231
232	set args [lrange $args 0 end-1]
233	set argsIndex [llength $args]
234	for {set i 0} {$i < $argsIndex} {incr i} {
235		set arg [lindex $args $i]
236
237		switch -- $arg {
238			-read {
239				set type read
240			}
241			-write {
242				set type write
243			}
244			-collect {
245				set type collect
246			}
247			-catchup {
248				set ::vfs::template::collate::catchup($to) 1
249				set type catchupstore
250			}
251			default {
252				eval lappend ::vfs::template::collate::${type}(\$to) \[::file normalize \$arg\]
253			}
254		}
255	}
256
257	WriteFile $to {} mkdir
258
259# return two-item list consisting of real and virtual locations.
260	lappend pathto {}
261	lappend pathto $to
262	return $pathto
263}
264
265proc UnmountProcedure {path to} {
266# add custom unmount handling of new vfs elements here.
267	unset -nocomplain ::vfs::template::collate::read($to)
268	unset -nocomplain ::vfs::template::collate::write($to)
269	unset -nocomplain ::vfs::template::collate::collect($to)
270	unset -nocomplain ::vfs::template::collate::catchup($to)
271	unset -nocomplain ::vfs::template::collate::catchupstore($to)
272	return
273}
274
275proc AcquireFile {root relative} {
276	foreach path $::vfs::template::collate::read($root) {
277		set file [::file join $path $relative]
278		if [::file exists $file] {
279			return $file
280		}
281	}
282	vfs::filesystem posixerror $::vfs::posix(ENOENT) ; return -code error $::vfs::posix(ENOENT)
283}
284
285proc WriteFile {root relative action} {
286	set allWriteLocations {}
287	foreach awl [concat $::vfs::template::collate::write($root) $::vfs::template::collate::collect($root)] {
288		if {[lsearch $allWriteLocations $awl] < 0} {lappend allWriteLocations $awl}
289	}
290	if ![llength $allWriteLocations] {
291		vfs::filesystem posixerror $::vfs::posix(EROFS) ; return -code error $::vfs::posix(EROFS)
292	}
293	if {$vfs::template::collate::catchup($root) && ([file tail $relative] != ".vfs_catchup") && ($action != "open")} {
294		set catchupActivate 1
295		set addCatchup {}
296		set newCatchup {}
297	} else {
298		set catchupActivate 0
299	}
300	set returnValue {}
301	foreach path $allWriteLocations  {
302		if {$catchupActivate && ![file exists $path]} {
303			append addCatchup "[list $action $path $relative]\n"
304			continue
305		}
306		set rvfile [file join $path $relative]
307		if {[lsearch $returnValue $rvfile] == -1} {lappend returnValue $rvfile}
308	}
309	if {$returnValue == {}} {vfs::filesystem posixerror $::vfs::posix(EROFS) ; return -code error $::vfs::posix(EROFS)}
310	if $catchupActivate {
311		set catchup {}
312		set ::vfs::template::vfs_retrieve 1
313
314		foreach store $::vfs::template::collate::catchupstore($root) {
315			set store [file join $store ".vfs_catchup"]
316			if [file readable $store] {
317				set f [open $store r]
318				unset ::vfs::template::vfs_retrieve
319				seek $f 0
320				set catchup [read $f]
321				close $f
322				break
323			}
324		}
325		catch {set currentRead [AcquireFile $root {}]} result
326		foreach {action path rel} $catchup {
327			if {$relative == $rel} {continue}
328			if ![file exists $path] {append newCatchup "[list $action $path $rel]\n" ; continue}
329			if {[lsearch $allWriteLocations  $path] < 0} {continue}
330			switch -- $action {
331				close {
332					if {![info exists currentRead] || ([set source [file join $currentRead $rel]] == [set target [file join $path $rel]])} {
333						append newCatchup "[list $action $path $rel]\n" ; continue
334					}
335					if ![file exists $source] {continue}
336					file mkdir [file dirname $target]
337					file copy -force -- $source $target
338				}
339				delete {
340					file delete -force -- [file join $path $rel]
341				}
342				mkdir {
343					file mkdir [file join $path $rel]
344				}
345			}
346		}
347		append newCatchup $addCatchup
348		foreach path $::vfs::template::collate::catchupstore($root) {
349			set vfscatchup [file join $path ".vfs_catchup"]
350			set ::vfs::template::vfs_retrieve 1
351			set err [catch {
352				if {$newCatchup != {}} {
353					set f [open $vfscatchup w]
354					puts $f $newCatchup
355					close $f
356				} else {
357					file delete $vfscatchup
358				}
359			} result]
360			unset ::vfs::template::vfs_retrieve
361		}
362	}
363	return $returnValue
364}
365
366proc WriteTest {args} {
367	return 1
368}
369
370}
371# end namespace ::vfs::template::collate
372