Added kitdll/buildsrc/kitdll-0.0/cvfs.tcl version [0556808912].

            1  +#! /usr/bin/env tcl
            2  +
            3  +package require vfs
            4  +#package require kitdll
            5  +
            6  +namespace eval ::vfs::kitdll {}
            7  +
            8  +# Convience functions
            9  +proc ::vfs::kitdll::Mount {hashkey local} {
           10  +	vfs::filesystem mount $local [list ::vfs::kitdll::vfshandler $hashkey]
           11  +	vfs::RegisterMount $local [list ::vfs::kitdll::Unmount]
           12  +}
           13  +
           14  +proc ::vfs::kitdll::Unmount {local} {
           15  +	vfs::filesystem unmount $local
           16  +}
           17  +
           18  +# Implementation
           19  +
           20  +## Filesystem Data
           21  +namespace eval ::vfs::kitdll::data {}
           22  +set ::vfs::kitdll::data(joe) "Test\n"
           23  +set {::vfs::kitdll::metadata()} [list type directory ino 0 mode 0555 nlink 2 uid 0 gid 0 size 0 atime 0 mtime 0 ctime 0]
           24  +set ::vfs::kitdll::metadata(joe) [list type file ino 1 mode 0444 nlink 1 uid 0 gid 0 size 5 atime 0 mtime 0 ctime 0]
           25  +set ::vfs::kitdll::metadata(sub) [list type directory ino 2 mode 0555 nlink 1 uid 0 gid 0 size 0 atime 0 mtime 0 ctime 0]
           26  +set ::vfs::kitdll::metadata(sub/sub2) [list type directory ino 3 mode 0555 nlink 1 uid 0 gid 0 size 0 atime 0 mtime 0 ctime 0]
           27  +
           28  +proc ::vfs::kitdll::data::getData {hashkey file {start 0} {end "end"}} {
           29  +	if {![info exists ::vfs::kitdll::data($file)]} {
           30  +		return -code error "Invalid operation"
           31  +	}
           32  +
           33  +	return [string range $::vfs::kitdll::data($file) $start $end]
           34  +}
           35  +
           36  +proc ::vfs::kitdll::data::getMetadata {hashkey file} {
           37  +	if {![info exists ::vfs::kitdll::metadata($file)]} {
           38  +		return -code error "No such file"
           39  +	}
           40  +
           41  +	return $::vfs::kitdll::metadata($file)
           42  +}
           43  +
           44  +proc ::vfs::kitdll::data::getChildren {hashkey directory} {
           45  +	set pattern [file join $directory {[^/]*}]
           46  +
           47  +	set children [array names ::vfs::kitdll::metadata -regexp "^${pattern}\$"]
           48  +
           49  +	set newchildren [list]
           50  +	foreach child $children {
           51  +		if {$child == ""} {
           52  +			continue
           53  +		}
           54  +
           55  +		set tail [lindex [split $child /] end]
           56  +
           57  +		lappend newchildren $tail
           58  +	}
           59  +
           60  +	return $newchildren
           61  +}
           62  +
           63  +## VFS
           64  +### Helpers
           65  +namespace eval ::vfs::kitdll::vfsdata {}
           66  +set ::vfs::kitdll::vfsdata::fileidx -1
           67  +
           68  +### Implemented
           69  +#### Single Handler
           70  +proc ::vfs::kitdll::vfshandler {hashkey subcmd args} {
           71  +	set cmd $args
           72  +	set cmd [linsert $cmd 0 "::vfs::kitdll::vfsop_${subcmd}" $hashkey]
           73  +
           74  +	return [eval $cmd]
           75  +}
           76  +
           77  +proc ::vfs::kitdll::chanhandler {hashkey subcmd args} {
           78  +	set cmd $args
           79  +	set cmd [linsert $cmd 0 "::vfs::kitdll::chanop_${subcmd}" $hashkey]
           80  +
           81  +	return [eval $cmd]
           82  +}
           83  +
           84  +#### Actual handlers
           85  +##### Finished
           86  +proc ::vfs::kitdll::vfsop_stat {hashkey root relative actualpath} {
           87  +	catch {
           88  +		set ret [::vfs::kitdll::data::getMetadata $hashkey $relative]
           89  +	}
           90  +
           91  +	if {![info exists ret]} {
           92  +		vfs::filesystem posixerror $::vfs::posix(ENOENT)
           93  +	}
           94  +
           95  +	return $ret
           96  +}
           97  +
           98  +proc ::vfs::kitdll::vfsop_access {hashkey root relative actualpath mode} {
           99  +	set ret [::vfs::kitdll::data::getMetadata $hashkey $relative]
          100  +
          101  +	if {$mode & 0x2} {
          102  +		vfs::filesystem posixerror $::vfs::posix(EROFS)
          103  +	}
          104  +
          105  +	return 1
          106  +}
          107  +
          108  +proc ::vfs::kitdll::vfsop_matchindirectory {hashkey root relative actualpath pattern types} {
          109  +	set ret [list]
          110  +
          111  +	if {$pattern == ""} {
          112  +		catch {
          113  +			set test [::vfs::kitdll::data::getMetadata $hashkey $relative]
          114  +		}
          115  +
          116  +		if {![info exists test]} {
          117  +			set children [list]
          118  +		}
          119  +
          120  +		set children [list $root]
          121  +	} else {
          122  +		set children [::vfs::kitdll::data::getChildren $hashkey $relative]
          123  +	}
          124  +
          125  +	foreach child $children {
          126  +		if {![string match $pattern $child]} {
          127  +			continue
          128  +		}
          129  +
          130  +		unset -nocomplain metadata
          131  +		catch {
          132  +			array set metadata [::vfs::kitdll::data::getMetadata $hashkey $child]
          133  +		}
          134  +
          135  +		if {[string index $actualpath end] == "/"} {
          136  +			set child "${actualpath}${child}"
          137  +		} else {
          138  +			set child "${actualpath}/${child}"
          139  +		}
          140  +
          141  +		if {![info exists metadata(type)]} {
          142  +			continue
          143  +		}
          144  +
          145  +		set filetype 0
          146  +		switch -- $metadata(type) {
          147  +			"directory" {
          148  +				set filetype [expr {$filetype | 0x04}]
          149  +			}
          150  +			"file" {
          151  +				set filetype [expr {$filetype | 0x10}]
          152  +			}
          153  +			default {
          154  +				continue
          155  +			}
          156  +		}
          157  +
          158  +		if {($filetype & $types) != $types} {
          159  +			continue
          160  +		}
          161  +
          162  +		lappend ret $child
          163  +	}
          164  +
          165  +	return $ret
          166  +}
          167  +
          168  +proc ::vfs::kitdll::vfsop_fileattributes {hashkey root relative actualpath {index -1} {value ""}} {
          169  +	set attrs [list -owner -group -permissions]
          170  +
          171  +	if {$value != ""} {
          172  +		vfs::filesystem posixerror $::vfs::posix(EROFS)
          173  +	}
          174  +
          175  +	if {$index == -1} {
          176  +		return $attrs
          177  +	}
          178  +
          179  +	array set metadata [::vfs::kitdll::data::getMetadata $hashkey $relative]
          180  +
          181  +	set attr [lindex $attrs $index]
          182  +
          183  +	switch -- $attr {
          184  +		"-owner" {
          185  +			return $metadata(uid)
          186  +		}
          187  +		"-group" {
          188  +			return $metadata(gid)
          189  +		}
          190  +		"-permissions" {
          191  +			if {$metadata(type) == "directory"} {
          192  +				set metadata(mode) [expr {$metadata(mode) | 040000}]
          193  +			}
          194  +
          195  +			return [format {0%o} $metadata(mode)]
          196  +		}
          197  +	}
          198  +
          199  +	return -code error "Invalid index"
          200  +}
          201  +
          202  +proc ::vfs::kitdll::chanop_initialize {hashkey chanId mode} {
          203  +	return [list initialize finalize watch read seek]
          204  +}
          205  +
          206  +proc ::vfs::kitdll::chanop_finalize {hashkey chanId} {
          207  +	unset -nocomplain ::vfs::kitdll::chandata([list $hashkey $chanId])
          208  +
          209  +	return
          210  +}
          211  +
          212  +proc ::vfs::kitdll::chanop_watch {hashkey chanId eventSpec} {
          213  +	array set chaninfo $::vfs::kitdll::chandata([list $hashkey $chanId])
          214  +
          215  +	set chaninfo(watching) $eventSpec
          216  +
          217  +	set ::vfs::kitdll::chandata([list $hashkey $chanId]) [array get chaninfo]
          218  +
          219  +	if {[lsearch -exact $chaninfo(watching) "read"] != -1} {
          220  +		after 0 [list catch "chan postevent $chanId [list {read}]"]
          221  +	}
          222  +
          223  +	return
          224  +}
          225  +
          226  +proc ::vfs::kitdll::chanop_read {hashkey chanId bytes} {
          227  +	array set chaninfo $::vfs::kitdll::chandata([list $hashkey $chanId])
          228  +
          229  +	set pos $chaninfo(pos)
          230  +	set len $chaninfo(len)
          231  +
          232  +	if {[lsearch -exact $chaninfo(watching) "read"] != -1} {
          233  +		after 0 [list catch "chan postevent $chanId [list {read}]"]
          234  +	}
          235  +
          236  +	if {$pos == $len} {
          237  +		return ""
          238  +	}
          239  +
          240  +	set end [expr {$pos + $bytes}]
          241  +	if {$end > $len} {
          242  +		set end $len
          243  +	}
          244  +
          245  +	set data [::vfs::kitdll::data::getData $hashkey $chaninfo(file) $pos $end]
          246  +
          247  +	set dataLen [string length $data]
          248  +	incr pos $dataLen
          249  +
          250  +	set chaninfo(pos) $pos
          251  +
          252  +	set ::vfs::kitdll::chandata([list $hashkey $chanId]) [array get chaninfo]
          253  +
          254  +	return $data
          255  +}
          256  +
          257  +proc ::vfs::kitdll::vfsop_open {hashkey root relative actualpath mode permissions} {
          258  +	if {$mode != "" && $mode != "r"} {
          259  +		vfs::filesystem posixerror $::vfs::posix(EROFS)
          260  +	}
          261  +
          262  +	catch {
          263  +		array set metadata [::vfs::kitdll::data::getMetadata $hashkey $relative]
          264  +	}
          265  +
          266  +	if {![info exists metadata]} {
          267  +		vfs::filesystem posixerror $::vfs::posix(ENOENT)
          268  +	}
          269  +
          270  +	if {$metadata(type) == "directory"} {
          271  +		vfs::filesystem posixerror $::vfs::posix(EISDIR)
          272  +	}
          273  +
          274  +	if {[info command chan] != ""} {
          275  +		set chan [chan create [list "read"] [list ::vfs::kitdll::chanhandler $hashkey]]
          276  +
          277  +		set ::vfs::kitdll::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""]
          278  +
          279  +		return [list $chan]
          280  +	}
          281  +
          282  +	if {[info command rechan] == ""} {
          283  +		catch {
          284  +			package require rechan
          285  +		}
          286  +	}
          287  +
          288  +	if {[info command rechan] != ""} {
          289  +		set chan [rechan [list ::vfs::kitdll::chanhandler $hashkey] 2]
          290  +
          291  +		set ::vfs::kitdll::chandata([list $hashkey $chan]) [list file $relative pos 0 len $metadata(size) watching ""]
          292  +
          293  +		return [list $chan]
          294  +	}
          295  +
          296  +	return -code error "No way to generate a channel, need either Tcl 8.5+, \"rechan\""
          297  +}
          298  +
          299  +### No-Ops since we are a readonly filesystem
          300  +proc ::vfs::kitdll::vfsop_createdirectory {args} {
          301  +	vfs::filesystem posixerror $::vfs::posix(EROFS)
          302  +}
          303  +proc ::vfs::kitdll::vfsop_deletefile {args} {
          304  +	vfs::filesystem posixerror $::vfs::posix(EROFS)
          305  +}
          306  +proc ::vfs::kitdll::vfsop_removedirectory {args} {
          307  +	vfs::filesystem posixerror $::vfs::posix(EROFS)
          308  +}
          309  +proc ::vfs::kitdll::vfsop_utime {} {
          310  +	vfs::filesystem posixerror $::vfs::posix(EROFS)
          311  +}
          312  +
          313  +package provide vfs::kitdll 1.0