1if 0 { 2######################## 3 4quotavfs.tcl -- 5 6Written by Stephen Huntley (stephen.huntley@alum.mit.edu) 7License: Tcl license 8Version 1.5.2 9 10A quota-enforcing virtual filesystem. Requires the template vfs in templatevfs.tcl. 11 12Quotas can be set on any quantity returned by "file stat" or "file attributes", 13plus the attribute "filename", which is the fully normalized pathname of the file. 14 15Two types of quota can be set: an incremented count of files matching a certain criterion, and 16a running total of a certain quantity. Each quota is defined by a set of switches composing 17a "quota group," any number of quota groups can be defined. A file must fit within all quotas defined 18to avoid triggering quota enforcement. 19 20The quotas are enforced as a FIFO stack of files; that is, if a new file is copied to the vfs whose 21attributes exceed a quota, the file is not rejected, rather, the already present files with 22the oldest access times that contribute to the quota are deleted until there is room within 23the quota limit for the addition of the new file. 24 25The exception for the running total variety is if the file's attribute is large enough to 26exceed the quota by itself, it is barred without first deleting all other files contributing to 27the quota. 28 29At mount time, all files in the existing directory are examined and quotas calculated. Files may be 30deleted to keep quotas under their defined limits. After mount, when a new file is moved into the 31virtual directory or an existing file edited, its properties are examined with respect to the defined 32quotas; if no room can be made for it, the move or edit is rejected. 33 34Usage: mount <quota group> ?<quota group>... ? <existing directory> <virtual directory> 35 36Quota group definition: 37 38-<quantity> <rule> -[quota|ruletotal] <quota number> 39or 40-<quantity> -total <quota number> 41 42Options: 43 44-<quantity> 45Where <quantity> is any item returned by the "file stat" or "file attributes" commands, with the dash 46prepended as needed, for example: -archive, -permissions, -size, -mtime etc. The attribute "filename" 47is assumed to exist as well, defined as the file's full pathname. The quantity need not exist, so the 48same command line could be used on Unix or Windows, for example. Nonexistent quantities have no effect 49and are ignored. 50 51<rule> 52The rule is the criterion a file must meet to have the quota applied to it. It may take the form of a 53list of glob patterns as used by the "string match" command: if the quantity value matches all the 54patterns, the quota is applied. The rule may be Tcl code, to which the quantity value will be 55appended and then evaluated. The code should return 1 if the file is judged to meet the 56quota criterion, or 0 if not. If glob patterns are used, each pattern in the list may, in 57addition to symbols used by "string match", have a "!" prepended to it, which will negate the 58sense of the match. 59 60-quota 61If the quota group contains this switch, then the vfs will keep a running count of all files that satisfy 62the quota group's rule. It will not allow more than the number of files specified in <quota number> to 63exist in the virtual file space. 64 65-total 66If the quota group contains this switch, then the vfs will track the sum of the values of the specified 67quantity of all files. It will not allow the sum specified in <quota number> to 68be exceeded in the virtual file space. 69 70-ruletotal 71Like -total, but a rule is defined, and only files satisfying the rule have their values added to the quota sum. 72 73The quota vfs inherits the -cache and -volume options of the template vfs. 74 75 76Examples -- to set a 10 MB size limit on your ftp upload directory: 77mount -size -total 10000000 C:/temp/upload C:/vfs/ftp/pub 78 79To allow only PNG or JPEG files in a photo collection: 80mount -filename {!*.png !*.jpg !*.jpeg} -quota 0 /home/shuntley/photos /vfs/photo 81 82To ban GIF files from your web site images subdirectory: 83mount -filename {C:/Program Files/Apache/htdocs/images/*.gif} -quota 0 {C:/Program Files/Apache/htdocs} /docroot 84 85To disallow creation of subdirectories: 86mount -type directory -quota 0 /ftp/upload /intake 87 88Use a rule to allow only 1 MB of files greater than 10kB in size: 89mount -size {expr 10000 <} -ruletotal 1000000 /tmp /vfs/dump 90 91Use two quota groups to allow only log files and keep only 1 more than one week: 92mount -filename !*.log -quota 0 -mtime {expr [clock scan {7 days ago}] >} -quota 1 /var/log /vfs/history 93 94######################## 95} 96 97package require vfs::template 1.5 98package require fileutil::globfind 99 100package provide vfs::template::quota 1.5.2 101 102namespace eval ::vfs::template::quota { 103 104# read template procedures into current namespace. Do not edit: 105foreach templateProc [namespace eval ::vfs::template {info procs}] { 106 set infoArgs [info args ::vfs::template::$templateProc] 107 set infoBody [info body ::vfs::template::$templateProc] 108 proc $templateProc $infoArgs $infoBody 109} 110 111# edit following procedures: 112proc close_ {channel} { 113 upvar path path root root relative relative 114 fconfigure $channel -translation binary 115 seek $channel 0 end 116 set quotaSize [tell $channel] 117 seek $channel 0 118 set filechannel [lindex $::vfs::template::quota::channels($channel) 0] 119 set newFile [lindex $::vfs::template::quota::channels($channel) 1] 120 unset ::vfs::template::quota::channels($channel) 121 set file [file join $path $relative] 122 123# Check if edited size violates any size quotas before allowing commit: 124 if [catch {QuotaAdd $file}] { 125 close $filechannel 126 if $newFile {catch {file delete -force $file}} 127 error "Disk quota exceeded" 128 } 129 seek $filechannel 0 130 fcopy $channel $filechannel 131 close $filechannel 132 return 133} 134proc file_atime {file time} { 135 upvar root root 136 file atime $file $time 137 append ::vfs::template::quota::atimes($root) " $time [list $file]" 138 if {$::vfs::template::quota::files($file) < $time} {set ::vfs::template::quota::files($file) $time ; return} 139 set ::vfs::template::quota::files($file) $time 140 set aList {} 141 foreach {atime afile} $::vfs::template::quota::atimes($root) { 142 lappend aList "$atime [list $afile]" 143 } 144 set atimes {} 145 foreach aset [lsort -dictionary $aList] { 146 set atime [lindex $aset 0] 147 set afile [lindex $aset 1] 148 append atimes " $atime [list $afile]" 149 } 150 set ::vfs::template::quota::atimes($root) $atimes 151} 152proc file_mtime {file time} {file mtime $file $time} 153proc file_attributes {file {attribute {}} args} {eval file attributes \$file $attribute $args} 154proc file_delete {file} { 155 upvar root root 156 array set quotaArray $::vfs::template::quota::quota($root) 157 QuotaDelete $file 158 set ::vfs::template::quota::quota($root) [array get quotaArray] 159 return 160} 161proc file_executable {file} {file executable $file} 162proc file_exists {file} {file exists $file} 163proc file_mkdir {file} { 164 upvar root root 165 file mkdir $file 166 globfind $file QuotaAdd 167 return 168} 169proc file_readable {file} {file readable $file} 170proc file_stat {file array} {upvar $array fs ; ::file stat $file fs} 171proc file_writable {file} {file writable $file} 172proc glob_ {directory dir nocomplain tails types typeString dashes pattern} {glob -directory $dir -nocomplain -tails -types $typeString -- $pattern} 173proc open_ {file mode} { 174 upvar root root permissions permissions 175 upvar newFile newFile 176 if {$mode == "r"} { 177 set atime [clock seconds] 178 append ::vfs::template::quota::atimes($root) " $atime [list $file]" 179 set ::vfs::template::quota::files($file) $atime 180 return [open $file r] 181 } 182 183if $newFile { 184 set now [clock seconds] 185 set fstat "mtime $now atime $now mode $permissions type file ctime $now size 0" 186 QuotaAdd $file 187} 188 set channel [open $file $mode] 189 190# Check if new file violates any quotas by adding it to quota tallies: 191# if $newFile { 192# set err [catch {QuotaAdd $file} result] 193# if $err { 194# close $channel 195# file delete -force -- $file 196# vfs::filesystem posixerror $::vfs::posix(EDQUOT) 197# error "Disk quota exceeded" 198# } 199# } 200# remove file from quota tallies until channel is closed: 201 array set quotaArray $::vfs::template::quota::quota($root) 202 QuotaDelete $file 0 203 set ::vfs::template::quota::quota($root) [array get quotaArray] 204 205# Use memchan to store edits so edit can be rejected if it violates size quotas: 206 set memchannel [memchan] 207 fconfigure $channel -translation binary 208 fconfigure $memchannel -translation binary 209 seek $channel 0 210 fcopy $channel $memchannel 211 set [namespace current]::channels($memchannel) "$channel $newFile" 212 return $memchannel 213} 214 215proc MountProcedure {args} { 216 upvar volume volume 217 218# take real and virtual directories from command line args. 219 set to [lindex $args end] 220 if [string equal $volume {}] {set to [::file normalize $to]} 221 set path [::file normalize [lindex $args end-1]] 222 223# make sure mount location exists: 224 ::file mkdir $path 225 226# add custom handling for new vfs args here. 227 228 namespace import -force ::fileutil::globfind::globfind 229 set quotaArgs [lrange $args 0 end-2] 230 231 ParseArgs ::vfs::template::quota::quota($to) $quotaArgs 232 233# Initialize quotas: 234 set root $to 235 set aList {} 236 foreach afile [globfind $path] { 237 file stat $afile fs 238 lappend aList "$fs(atime) [list $afile]" 239 } 240 set atimes {} 241 foreach aset [lsort -dictionary $aList] { 242 set atime [lindex $aset 0] 243 set afile [lindex $aset 1] 244 append atimes " $atime [list $afile]" 245 set ::vfs::template::quota::files($afile) $atime 246 } 247 set ::vfs::template::quota::atimes($root) $atimes 248 249 globfind $path QuotaAdd 250 251 set ::vfs::template::quota::atimes($root) $atimes 252 253# return two-item list consisting of real and virtual locations. 254 lappend pathto $path 255 lappend pathto $to 256 return $pathto 257} 258 259 260proc UnmountProcedure {path to} { 261# add custom unmount handling of new vfs elements here. 262 263 unset -nocomplain ::vfs::template::quota::quota($to) 264 unset -nocomplain ::vfs::template::quota::atimes($to) 265 return 266} 267 268# Default rule for quotas with pattern specified: 269proc CheckPattern {pattern value} { 270 foreach ptn $pattern { 271 set negate [string equal [string index $ptn 0] !] 272 if $negate {set ptn [string range $ptn 1 end]} 273 set match [string match $ptn $value] 274 if $negate {set match [expr !$match]} 275 if !$match {return 0} 276 } 277 return 1 278} 279 280# Used as argument to proc globfind to recurse down dir hierarchies and process each file and dir found: 281proc QuotaAdd {fileName} { 282 set caller [lindex [info level -1] 0] 283 if {$caller == "MountProcedure"} {set init 1} else {set init 0} 284 upvar path path root root quotaSize quotaSize fstat fstat 285 if ![string first ".vfs_" [file tail $fileName]] {return 0} 286 if {[info exists path] && ($fileName == $path)} {return 0} 287 array set quotaArray $::vfs::template::quota::quota($root) 288 set overLimit {} 289 set items [lsort -unique [string map {",type " " " ",rule " " " ",quota " " " ",current " " "} " [array names quotaArray] "]] 290 291 set delete 1 292if [info exists fstat] { 293 array set fs $fstat 294} else { 295 set noexist [catch {file stat $fileName fs}] 296 if $noexist {return 0} 297} 298 set fs(filename) $fileName 299 300# if this call is being used to check edits, replace file size with channel size and don't delete file if edit too big: 301 if [info exists quotaSize] {set fs(size) $quotaSize ; set delete 0 ; unset quotaSize} 302 303# Update queue which tracks which files to try deleting first to make room for new files: 304 append ::vfs::template::quota::atimes($root) " $fs(atime) [list $fileName]" 305 set ::vfs::template::quota::files($fileName) $fs(atime) 306 307# Check each defined quota to see if given file violates it: 308 foreach item $items { 309 regexp {([0-9]*),(.*)} $item trash groupCount item 310 if ![info exists fs($item)] {if [file exists $fileName] {array set fs [file attributes $fileName]}} 311 if ![info exists fs($item)] {continue} 312 set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]] 313 if $contrib { 314 if {$quotaArray($groupCount,$item,type) == "total"} { 315 316 # If file quantity by itself would violate quota, reject immediately: 317 if {$fs($item) > $quotaArray($groupCount,$item,quota)} { 318 if $delete {catch {file delete -force -- $fileName} result} 319if [info exists ::vfs::template::quota::debug] { 320puts "\n$fileName violates quota by itself: 321$item: $fs($item) 322quota: $quotaArray($groupCount,$item,quota)" 323if $delete {puts "$fileName deleted: $result"} 324} 325 if $init {return 0} else {vfs::filesystem posixerror $::vfs::posix(EDQUOT)} 326 } 327 set quotaArray($groupCount,$item,current) [expr $quotaArray($groupCount,$item,current) + $fs($item)] 328 } else { 329 if {$quotaArray($groupCount,$item,quota) == 0} { 330 if $delete {catch {file delete -force -- $fileName} result} 331if [info exists ::vfs::template::quota::debug] { 332puts "\n$fileName violates quota by itself: 333$item: $fs($item) 334quota: $quotaArray($groupCount,$item,quota)" 335if $delete {puts "$fileName deleted: $result"} 336} 337 if $init {return 0} else {vfs::filesystem posixerror $::vfs::posix(EDQUOT)} 338 } 339 incr quotaArray($groupCount,$item,current) 340 } 341 # If file violates quota, store quota to see if room can be made by deleting older files: 342 if {$quotaArray($groupCount,$item,current) > $quotaArray($groupCount,$item,quota)} {lappend overLimit "$groupCount,$item"} 343 } 344 } 345# if given file puts some quotas over limit, see if room can be made by deleting older files: 346 347 foreach item $overLimit { 348 set itm [lindex [split $item ,] 1] 349 if {$quotaArray($item,current) <= $quotaArray($item,quota)} {continue} 350 351 # examine queue of stored atimes to find older files: 352 foreach {atime afile} $::vfs::template::quota::atimes($root) { 353 354 # If stored atime doesn't match latest value, delete record and move on: 355 if {($::vfs::template::quota::files($afile) != $atime) || ![file exists $afile]} { 356 set deleteLoc [lsearch -exact $::vfs::template::quota::atimes($root) $afile] 357 set ::vfs::template::quota::atimes($root) [lreplace $::vfs::template::quota::atimes($root) [expr $deleteLoc - 1] $deleteLoc] 358 if {[lsearch -exact $::vfs::template::quota::atimes($root) $afile] < 0} {unset ::vfs::template::quota::files($afile)} 359 continue 360 } 361 362 # if file from queue is in fact newer than given file, skip it: 363 if {$atime > $fs(atime)} {continue} 364 365 # if stored filename is same as given filename, given filename violates quota and must be rejected: 366 if {$afile == $fileName} { 367 if !$delete {set quotaSize $fs(size)} 368 catch {QuotaDelete $fileName $delete} 369 set ::vfs::template::quota::quota($root) [array get quotaArray] 370 if $init {return 0} else {vfs::filesystem posixerror $::vfs::posix(EDQUOT)} 371 } 372 373 # If stored file contributes to quota, delete it and remove from quota tally: 374 375 if {$itm == "filename"} { 376 set itm_val $afile 377 } elseif {[string index $itm 0] == "-"} { 378 set itm_val [file attributes $afile $itm] 379 } else { 380 file stat $afile iv 381 set itm_val $iv($itm) 382 } 383 384 set contrib [eval $quotaArray($item,rule) [list $itm_val]] 385 if $contrib { 386 if {$quotaArray($item,type) == "total"} { 387 set itm [lindex [split $item ,] 1] 388 if {[string index $itm 0] == "-"} { 389 set itm_val [file attributes $afile $itm] 390 } else { 391 file stat $afile iv 392 set itm_val $iv($itm) 393 } 394 if !$itm_val {continue} 395 } 396 set ::vfs::template::quota::quota($root) [array get quotaArray] 397 QuotaDelete $afile 398 } 399 400 # If deletions make room for new file, then OK: 401 if {$quotaArray($item,current) <= $quotaArray($item,quota)} {break} 402 } 403 } 404 set ::vfs::template::quota::quota($root) [array get quotaArray] 405 return 0 406} 407 408proc QuotaDelete {fileName {delete 1}} { 409 upvar quotaArray quotaArray quotaSize quotaSize 410 set items [lsort -unique [string map {",type " " " ",rule " " " ",quota " " " ",current " " "} " [array names quotaArray] "]] 411 412# If given fileName is a dir, must remove all contents from quota tallies before removing dir itself: 413 set files [lsort -decreasing [globfind $fileName]] 414 set type file 415 416# Must parse contents twice, eliminate files first, then dirs: 417 foreach file [concat $files //// $files] { 418 if {$file == "////"} {set type directory ; continue} 419 420 # cache quantity info to save time on second pass: 421 if ![info exists stat($file)] { 422 file stat $file fs 423 set fs(filename) $fileName 424 if [info exists quotaSize] {set fs(size) $quotaSize} 425 set stat($file) [array get fs] 426 } 427 array set fs $stat($file) 428 429 # If file type is wrong for this pass, continue: 430 if {($type == "file") && ($fs(type) == "directory")} {continue} 431 if {($type == "directory") && ($fs(type) != "directory")} {continue} 432 433 # Check each quota to see if current file contributes to it: 434 foreach item $items { 435 regexp {([0-9]*),(.*)} $item trash groupCount item 436 if ![info exists fs($item)] {if [file exists $file] {array set fs [file attributes $file]} ; set stat($file) [array get fs]} 437 if ![info exists fs($item)] {continue} 438 set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]] 439 if $contrib { 440 if {$quotaArray($groupCount,$item,type) == "total"} { 441 set quotaArray($groupCount,$item,current) [expr $quotaArray($groupCount,$item,current) - $fs($item)] 442 } else { 443 incr quotaArray($groupCount,$item,current) -1 444 } 445if [info exists ::vfs::template::quota::debug] { 446puts "\n$file contributed to quota: 447rule: $quotaArray($groupCount,$item,rule) 448quota: $quotaArray($groupCount,$item,quota) 449current: $quotaArray($groupCount,$item,current)" 450} 451 } 452 } 453 454 # After removing file from quota tallies, delete it: 455 if $delete {file delete -force -- $file} 456if {$delete && [info exists ::vfs::template::quota::debug]} { 457puts "\n$file deleted" 458} 459 } 460 return 461} 462 463# Decided on new command line syntax, rather than rewrite whole vfs, 464# this proc casts new syntax into old format, then processes as before: 465proc ParseArgs {argsStore args} { 466 upvar path path 467 set args [lindex $args 0] 468 469 array set attrs [file attributes $path] 470 set quotas {} 471 set totals {} 472 set rtotals {} 473 set newArgs {} 474 475# find location of each quota group: 476 set qPosition [lsearch -all $args "-quota"] 477 set tPosition [lsearch -all $args "-total"] 478 set rPosition [lsearch -all $args "-ruletotal"] 479 480# break group defs into separate categories: 481 foreach qp $qPosition { 482 incr qp 483 append quotas " [lrange $args [expr $qp - 3] $qp]" 484 } 485 486 foreach tp $tPosition { 487 incr tp 488 append totals " [lrange $args [expr $tp - 2] $tp]" 489 } 490 491 foreach rp $rPosition { 492 incr rp 493 append rtotals " [lrange $args [expr $rp - 3] $rp]" 494 } 495 496# cast each category into old syntax: 497 foreach {type pr quota number} $quotas { 498 set patrul "-pattern" 499 if {[lsearch -exact [info commands [string trim [string range $pr 0 [string first { } $pr]]]] [string trim [string range $pr 0 [string first { } $pr]]]] > -1} { 500 set patrul "-rule" 501 } 502 if ![info exists attrs($type)] {set type [string range $type 1 end]} 503 append newArgs " -number: -item $type $patrul [list $pr] -quota $number" 504 } 505 506 foreach {type total number} $totals { 507 if ![info exists attrs($type)] {set type [string range $type 1 end]} 508 append newArgs " -total: -item $type -quota $number" 509 } 510 511 foreach {type pr rtotal number} $rtotals { 512 set patrul "-pattern" 513 if {[lsearch -exact [info commands [string trim [string range $pr 0 [string first { } $pr]]]] [string trim [string range $pr 0 [string first { } $pr]]]] > -1} { 514 set patrul "-rule" 515 } 516 if ![info exists attrs($type)] {set type [string range $type 1 end]} 517 append newArgs " -total: -item $type $patrul [list $pr] -quota $number" 518 } 519 520# process old syntax: 521 unset args 522 lappend args [string trim $newArgs] 523 524 set groupCount 0 525 set args [lindex $args 0] 526 set argsIndex [llength $args] 527 for {set i $argsIndex} {$i >= 0} {incr i -1} { 528 switch -- [lindex $args $i] { 529 -number: - 530 -total: { 531 set item $itemSet(item) 532 if ![info exists itemSet(rule)] {set itemSet(rule) "CheckPattern *"} 533 set argsArray($groupCount,$item,type) [string range [lindex $args $i] 1 end-1] 534 set argsArray($groupCount,$item,rule) $itemSet(rule) 535 set argsArray($groupCount,$item,quota) $itemSet(quota) 536 set argsArray($groupCount,$item,current) 0 537 array unset itemSet 538 incr groupCount 539 } 540 -item { 541 set itemSet(item) [lindex $args [expr $i + 1]] 542 } 543 -pattern { 544 set itemSet(rule) "CheckPattern [list [lindex $args [expr $i + 1]]]" 545 } 546 -quota { 547 set itemSet(quota) [lindex $args [expr $i + 1]] 548 } 549 -rule { 550 set itemSet(rule) [lindex $args [expr $i + 1]] 551 } 552 } 553 } 554 set $argsStore [array get argsArray] 555} 556 557} 558# end namespace ::vfs::template::quota 559 560