Version 5 of A quota-enforcing virtual filesystem

Updated 2004-07-24 21:53:55

SEH A quota-enforcing virtual filesystem.

Quotas can be set on any value returned by [file stat] or [file attributes], plus the special values filename and dirname. Two types of quota limits can be set: total and number.

A total quota can be set on a numerical value like 'size' and enforces a limit on the sum of all values of all files.

A number quota can be set on any value, and enforces a limit on the number of files whose given attribute matches a pattern or rule.

By default the quota applies to the whole mounted location, but separate sub-locations can be specified.

Unlimited multiple quotas can be defined for separate values, types and locations. Each quota is set with a quota group:

-number: -item <value> -pattern <glob pattern>|-rule <command> -quota <number> [-location <sub-directory>]

-total: -item <value> -quota <number> [-location <sub-directory>]

The string containing all quota groups is incorporated into the Mount command.

If a file add leads to a quota being exceeded, the oldest files matching the quota criterion are deleted until the quota limit is re-established.

Usage: Mount <existing directory> <string of quota groups> <virtual directory>

Examples: to set a 10 MB size limit on your ftp upload directory

Mount C:/temp/upload -total: -item size -quota 10000000 /ftp/pub

To ban GIF files from your web site images directory

Mount C:/Apache/htdocs -number: -item filename -pattern "*.gif *GIF" -quota 0 -location images /docroot

To exclude all files which are not members of the Unix group called "admin" and delete files created longer that a week ago

First create a procedure to act as a rule:

proc ccheck {value} {if {$value < [clock scan "7 days ago"]} {return 1} else {return 0}}

Mount /var/logs -number: -item -group -pattern !admin -quota 0 -number: -item ctime -rule ccheck -quota 0 /reports

(the pattern is glob-style with the optional addition of ! at the beginning to indicate negative match)

Note that you can create a self-generating local cache with a collate/broadcast virtual filesystem, when daisy-chained with this VFS, you can restrict the cache size, among other things.

Based on a template virtual filesystem

I haven't done much testing on this or other virtual filesystems, I'm trying to post new ideas rapidly in order to stimulate interest and discussion. I will go back and polish up my work.

 package require vfs 1

 namespace eval ::vfs::template {}

 proc ::vfs::template::quota::Mount {args} {
        set pathto [eval MountProcedure $args]
        set path [lindex $pathto 0]
        set to [lindex $pathto 1]
        ::vfs::filesystem mount $to [list ::vfs::template::quota::handler $path]
        ::vfs::RegisterMount $to [list ::vfs::template::quota::Unmount]
        return $to
 }

 proc ::vfs::template::quota::Unmount {to} {
        set path [lindex [::vfs::filesystem info $to] end]
        UnmountProcedure $path $to
        ::vfs::filesystem unmount $to
 }

 proc ::vfs::template::quota::handler {path cmd root relative actualpath args} {
        switch -- $cmd {
                access {
                        set mode [lindex $args 0]
                        set error [catch {Access $path $root $relative $actualpath $mode}]
                        if $error {vfs::filesystem posixerror $::vfs::posix(EACCES) ; return -code error $::vfs::posix(EACCES)}
                }
                createdirectory {
                        CreateDirectory $path $root $relative $actualpath
                }
                deletefile {
                        DeleteFile $path $root $relative $actualpath
                }
                fileattributes {
                        set index [lindex $args 0]
                        set value [lindex $args 1]
                        array set attributes [FileAttributes $path $root $relative $actualpath]
                        if {$index == {}} {
                                return [lsort [array names attributes]]
                        }
                        set attribute [lindex [lsort [array names attributes]] $index]
                        if {$value == {}} {
                                return $attributes($attribute)
                        }
                        FileAttributesSet $path $root $relative $actualpath $attribute $value
                }
                matchindirectory {
                        set pattern [lindex $args 0]
                        set types [lindex $args 1]
                        return [MatchInDirectory $path $root $relative $actualpath $pattern $types]
                } open {
                        set mode [lindex $args 0]
                        if {$mode == {}} {set mode r}
                        set permissions [lindex $args 1]
                        set channelID [Open $path $root $relative $actualpath $mode $permissions]
                        switch -glob -- $mode {
                                "" -
                                "r*" -
                                "w*" {
                                        seek $channelID 0
                                }
                                "a*" {
                                            seek $channelID 0 end
                                }
                                default {
                                        ::vfs::filesystem posixerror $::vfs::posix(EINVAL)
                                        return -code error $::vfs::posix(EINVAL)
                                }
                        }
                        set result $channelID
                        lappend result [list ::vfs::template::quota::Close $channelID $path $root $relative $actualpath $mode]
                        return $result
                }
                removedirectory {
                        set recursive [lindex $args 0]
                        if !$recursive {
                                if {[MatchInDirectory $path $root $relative $actualpath * 0] != {}} {
                                        ::vfs::filesystem posixerror $::vfs::posix(EEXIST)
                                        return -code error $::vfs::posix(EEXIST)
                                }
                        }
                        RemoveDirectory $path $root $relative $actualpath
                }
                stat {
                        return [Stat $path $root $relative $actualpath]
                }
                utime {
                        set atime [lindex $args 0]
                        set mtime [lindex $args 1]
                        Utime $path $root $relative $actualpath $atime $mtime
                }
        }
 }

 namespace eval ::vfs::template::quota {

 proc MountProcedure {args} {
        package require ::fileutil
        set to [file normalize [lindex $args end]]
        set args [lrange $args 0 end-1]
        set path [lindex $args 0]
        set args [lrange $args 1 end]
        if {![catch {vfs::filesystem info $to}]} {
                # unmount old mount
                Unmount $to
        }

        if [file isfile $path/quotavfs.txt] {
                set f [open $path/quotavfs.txt r]
                while {![eof $f]} {
                        eval array set [gets $f]
                }
                close $f
        }
        set location $to

        set argsIndex [llength $args]
        incr argsIndex -1
        for {set i $argsIndex} {$i >= 0} {incr i -1} {
                switch -- [lindex $args $i] {
                        -number: -
                        -total: {
                                catch {set location $itemSet(location)}
                                set item $itemSet(item)
                                array unset itemSet $item
                                set itemSet(type) [string range [lindex $args $i] 1 end-1]
                                lappend ::vfs::template::quota::quota($location) $item
                                catch {array set itemSet $::vfs::template::quota::${item}($location)}
                                set ::vfs::template::quota::${item}($location) [array get itemSet]
                                if ![info exists $itemSet(current)] {set enforceQuota 1}
                                array unset itemSet
                                set location $to
                        }
                        -item {
                                set itemSet(item) [lindex $args [incr i]]
                        }
                        -location {
                                set itemSet(location) [file join $path [lindex $args [incr i]]]
                        }
                        -pattern {
                                set itemSet(rule) "CheckPattern [list [lindex $args [incr i]]]"
                        }
                        -quota {
                                set itemSet(quota) [lindex $args [incr i]]
                        }
                        -rule {
                                set itemSet(rule) [lindex $args [incr i]]
                        }
                }
        }

        if [info exists enforceQuota] {
                foreach {location items} [array get ::vfs::template::quota::quota] {
                        foreach item $items {
                                array unset itemSet
                                array set itemSet $::vfs::template::quota::${item}($location)
                                array set itemSet "current 0"
                                set ::vfs::template::quota::${item}($location) [array get itemSet]
                        }
                        ::fileutil::find $location CalculateQuota
                }
        }

        file mkdir $path

        lappend pathto $path
        lappend pathto $to
        return $pathto
 }

 proc UnmountProcedure {path to} {
        set f [open $path/quotavfs.txt w]

        puts $f "::vfs::template::quota::mtimes [list [array get ::vfs::template::quota::mtimes]]"
        array unset ::vfs::template::quota::mtimes
        puts $f "::vfs::template::quota::quota [list [array get ::vfs::template::quota::quota]]"
        foreach {location item} [array get ::vfs::template::quota::quota] {
                puts $f "::vfs::template::quota::${item} [list [array get ::vfs::template::quota::${item}]]"
                array unset ::vfs::template::quota::${item}
        }
        array unset ::vfs::template::quota::quota
        close $f
        return
 }

 proc Access {path root relative actualpath mode} {
        set modeString [::vfs::accessMode $mode]
        if {$modeString == "F"} {set modeString RWX}
        set modeString [split $modeString {}]
        set fileName [file join $path $relative]
        if [file readable $fileName] {lappend fileString R}
        if [file writable $fileName] {lappend fileString W}
        if [file executable $fileName] {lappend fileString X}
        foreach mS $modeString {
                set errorMessage "not [string map {R readable W writable X executable} $mS]"
                if {[lsearch $fileString $mS] == -1} {error $errorMessage}
        }
 }

 proc CreateDirectory {path root relative actualpath} {
        file mkdir [file join $path $relative]
 }

 proc DeleteFile {path root relative actualpath} {
        set fileName [file join $path $relative]
        file delete $fileName
 }

 proc FileAttributes {path root relative actualpath} {
        set fileName [file join $path $relative]
        file attributes $fileName
 }

 proc FileAttributesSet {path root relative actualpath attribute value} {
        set fileName [file join $path $relative]
        file attributes $fileName $attribute $value
 }

 proc MatchInDirectory {path root relative actualpath pattern types} {
        if [::vfs::matchDirectories $types] {lappend typeString d}
        if [::vfs::matchFiles $types] {lappend typeString f}

        set globList [glob -directory [file join $path $relative] -nocomplain -types $typeString $pattern]
        set pathLength [expr [string length $path] - 1]
        set newGlobList {}
        foreach gL $globList {
                if {[file tail $gL] == "quotavfs.txt"} {continue}
                set gL [string replace $gL 0 $pathLength $root]
                lappend newGlobList $gL
        }
        return $newGlobList
 }

 proc Open {path root relative actualpath mode permissions} {
        set fileName [file join $path $relative]
        set newFile 0

        if ![file exists $fileName] {
                set newFile 1
        } else {
                file stat $fileName fs
                array set fs [file attributes $fileName]
        }
        set fs(filename) [file tail [file join $path $relative]]
        set fs(dirname) [file dirname [file join $path $relative]]

        EnforceQuota [array get fs]
        foreach {item quotaDir} $::vfs::template::quota::overlimit {
                array unset itemSet
                array set itemSet $::vfs::template::quota::${item}($quotaDir)
                if ![string first $quotaDir/ $fileName] {continue}
                if {($itemSet(type) == "total") || ([eval $itemSet(rule) \$fs(\$item)])} {
                        vfs::filesystem posixerror $::vfs::posix(ENOSPC) ; return -code error $::vfs::posix(ENOSPC)
                }
        }

        set channelID [open $fileName $mode]
        if $newFile {catch {file attributes $fileName -permissions $permissions}}
        return $channelID
 }

 proc Close {channelID path root relative actualpath mode} {
 # Do not close the channel in the close callback!
 # It will crash Tcl!  Honest!
 # The core will close the channel after you've taken what info you need from it.

 #        close $channelID
        set tempFile [::fileutil::tempfile]
        set f [open $tempFile w]
        seek $channelID 0
        fconfigure $channelID -translation binary
        fconfigure $f -translation binary
        fcopy $channelID $f
        close $f
        file stat $tempFile fs
        array set fs [file attributes $tempFile]
        file delete $tempFile

        set fs(filename) [file tail [file join $path $relative]]
        set fs(dirname) [file dirname [file join $path $relative]]
        EnforceQuota [array get fs]
        return
 }

 proc RemoveDirectory {path root relative actualpath} {
        file delete -force [file join $path $relative]
 }

 proc Stat {path root relative actualpath} {
        file stat [file join $path $relative] fs
        return [array get $fs]
 }

 proc Utime {path root relative actualpath atime mtime} {
        set fileName [file join $path $relative]
        file atime $fileName $atime
        file mtime $fileName $mtime
        array set ::vfs::template::quota::mtimes "$mtime [file join $path $relative]"
 }

 proc CalculateQuota {name} {
        set currentDir [pwd]
        file stat $name fs
        array set fs [file attributes $name]
        array set fs "filename $name"
        array set fs "dirname $currentDir"
        array set ::vfs::template::quota::mtimes "$fs(mtime) $name"
        QuotaCheck [array get fs]
        return 0
 }

 proc CheckPattern {pattern value} {
        foreach ptn $pattern {
                set negate [string equal [string index $ptn 0] !]
                if $negate {set ptn [string range $ptn 1 end]}
                set match [string match $ptn $value]
                if $negate {set match [expr !$match]}
                if $match {return $match}
        }
        return 0
 }

 proc CheckTotal {quota current value} {
        if {[expr $current + $value] > $quota} {return 1}
        return 0
 }

 proc EnforceQuota {args} {
        eval array set fs $args
        QuotaCheck [array get fs]
        foreach {item quotaDir} $::vfs::template::quota::overlimit {
                set underLimit 0
                array unset itemSet
                array set itemSet $::vfs::template::quota::${item}($quotaDir)
                foreach mT [lsort [array names ::vfs::template::quota::mtimes]] {
                        set mTFile $::vfs::template::quota::mtimes($mT)
                        if {$mTFile == [file join $fs(dirname) $fs(filename)]} {continue}
                        array unset mTStat
                        file stat $mTFile mTStat
                        array set mTStat [file attributes $mTFile]

                        set mTStat(filename) [file tail $mTFile]
                        set mTStat(dirname) [file dirname $mTFile]
                        if ![info exists mTStat($item)] {continue}
                        if ![string first $quotaDir/ $mTFile] {continue}

                        if {($itemSet(type) == "total") || ([eval $itemSet(rule) \$mTStat(\$item)])} {
                                file delete $mTFile
                                array unset ::vfs::template::quota::mtimes $mT
                                if {$itemSet(type) == "number"} {incr itemSet(current) -1} else {set itemSet(current) [expr $itemSet(current) - $fs($item)]}
                        }
                        if {$itemSet(current) <= $itemSet(quota)} {set underLimit 1 ; break} 
                }
                if $underLimit {
                        set oL [lsearch $::vfs::template::quota::overlimit "$item $quotaDir"]
                        set ::vfs::template::quota::overlimit [lreplace $::vfs::template::quota::overlimit $oL $oL]
                }
        }
 }

 proc QuotaCheck {args} {
        eval array set fs $args
        set currentDir $fs(dirname)
        set quotaCheck 0
        foreach quotaDir [lsort -decreasing [array names ::vfs::template::quota::quota]] {
                if ![string first $quotaDir/ $currentDir/] {set quotaCheck 1 ; break}
        }
        if !$quotaCheck {return 0}
        foreach item $::vfs::template::quota::quota($quotaDir) {
                if ![info exists fs($item)] {continue}
                array unset itemSet
                array set itemSet $::vfs::template::quota::${item}($quotaDir)
                if ![info exists $itemSet(current)] {set current 0} else {set current $itemSet(current)}
                if {($itemSet(type) == "total") || ([eval $itemSet(rule) \$fs(\$item)])} {
                        if {$itemSet(type) == "number"} {incr current} else {set current [expr $current + $fs($item)]}
                }
                array set itemSet "current $current"
                if {$itemSet(current) > $itemSet(quota)} {lappend ::vfs::template::quota::overlimit "$item [list $quotaDir]"}
                set $::vfs::template::quota::${item}($quotaDir) [array get itemSet]
        }
        return 1
 }

 }
 # end namespace eval vfs::template::quota

[ Category VFS ]