Overview
Comment: | Added first draft of kitdll |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: | 029b69f827f562ce8f9e45ac081faba85ed194fc |
User & Date: | rkeene on 2010-09-26 04:50:40 |
Other Links: | manifest | tags |
Context
2010-09-26
| ||
04:50 | Fixed issue with glob of top dir check-in: cc20ec9009 user: rkeene tags: trunk | |
04:50 | Added first draft of kitdll check-in: 029b69f827 user: rkeene tags: trunk | |
04:50 |
Updated to use "/proc/self/exe" rather than "/proc/<pid>/exe"
Updated to check for "/proc/curproc/file" (FreeBSD) check-in: 013d6b36f4 user: rkeene tags: trunk | |
Changes
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