From 359c1d97cecc5174af751e025ec7b6ea3189f788 Mon Sep 17 00:00:00 2001 From: Steve Huntley Date: Wed, 27 Feb 2008 04:36:38 +0000 Subject: [PATCH] Minor bug fixes and reformatting. --- library/template/deltavfs.tcl | 5 ++++- library/template/pkgIndex.tcl | 2 +- library/template/quotavfs.tcl | 38 ++++++++++++++++++++------------ library/template/templatevfs.tcl | 4 ++-- library/template/versionvfs.tcl | 9 ++++++-- 5 files changed, 38 insertions(+), 20 deletions(-) diff --git a/library/template/deltavfs.tcl b/library/template/deltavfs.tcl index 1e17158..499fcd0 100644 --- a/library/template/deltavfs.tcl +++ b/library/template/deltavfs.tcl @@ -5,7 +5,7 @@ deltavfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5 +Version 1.5.1 A delta virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -232,6 +232,9 @@ proc Delta {filename} { } proc GetFileName {file} { + set isdir 0 + if {([string first \; $file] == -1) && ![set isdir [file isdirectory $file]]} {return {}} + if $isdir {return $file} set fileNames [glob -nocomplain -path $file *] if {[lindex [file system $file] 0] != "tclvfs"} {append fileNames " [glob -nocomplain -path $file -type hidden *]"} set fileName [lindex $fileNames 0] diff --git a/library/template/pkgIndex.tcl b/library/template/pkgIndex.tcl index a74ecd8..e8a09d4 100644 --- a/library/template/pkgIndex.tcl +++ b/library/template/pkgIndex.tcl @@ -8,7 +8,7 @@ # script is sourced, the variable $dir must contain the # full path name of this file's directory. -package ifneeded vfs::template 1.5 [list source [file join $dir templatevfs.tcl]] +package ifneeded vfs::template 1.5.1 [list source [file join $dir templatevfs.tcl]] set ::auto_index(::vfs::template::mount) [list package require vfs::template 1.5] set ::auto_index(::vfs::template::collate::mount) [list source [file join $dir collatevfs.tcl]] diff --git a/library/template/quotavfs.tcl b/library/template/quotavfs.tcl index 021d7d2..e258b90 100644 --- a/library/template/quotavfs.tcl +++ b/library/template/quotavfs.tcl @@ -5,7 +5,7 @@ quotavfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5 +Version 1.5.1 A quota-enforcing virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -170,7 +170,7 @@ proc file_stat {file array} {upvar $array fs ; ::file stat $file fs} proc file_writable {file} {file writable $file} proc glob_ {directory dir nocomplain tails types typeString dashes pattern} {glob -directory $dir -nocomplain -tails -types $typeString -- $pattern} proc open_ {file mode} { - upvar root root + upvar root root permissions permissions upvar newFile newFile if {$mode == "r"} { set atime [clock seconds] @@ -178,18 +178,24 @@ proc open_ {file mode} { set ::vfs::template::quota::files($file) $atime return [open $file r] } + +if $newFile { + set now [clock seconds] + set fstat "mtime $now atime $now mode $permissions type file ctime $now size 0" + QuotaAdd $file +} set channel [open $file $mode] # Check if new file violates any quotas by adding it to quota tallies: - if $newFile { - set err [catch {QuotaAdd $file} result] - if $err { - close $channel - file delete -force -- $file - vfs::filesystem posixerror $::vfs::posix(EDQUOT) - error "Disk quota exceeded" - } - } +# if $newFile { +# set err [catch {QuotaAdd $file} result] +# if $err { +# close $channel +# file delete -force -- $file +# vfs::filesystem posixerror $::vfs::posix(EDQUOT) +# error "Disk quota exceeded" +# } +# } # remove file from quota tallies until channel is closed: array set quotaArray $::vfs::template::quota::quota($root) QuotaDelete $file 0 @@ -274,7 +280,7 @@ proc CheckPattern {pattern value} { proc QuotaAdd {fileName} { set caller [lindex [info level -1] 0] if {$caller == "MountProcedure"} {set init 1} else {set init 0} - upvar path path root root quotaSize quotaSize + upvar path path root root quotaSize quotaSize fstat fstat if ![string first ".vfs_" [file tail $fileName]] {return 0} if {[info exists path] && ($fileName == $path)} {return 0} array set quotaArray $::vfs::template::quota::quota($root) @@ -282,8 +288,12 @@ proc QuotaAdd {fileName} { set items [lsort -unique [string map {",type " " " ",rule " " " ",quota " " " ",current " " "} " [array names quotaArray] "]] set delete 1 +if [info exists fstat] { + array set fs $fstat +} else { set noexist [catch {file stat $fileName fs}] if $noexist {return 0} +} set fs(filename) $fileName # if this call is being used to check edits, replace file size with channel size and don't delete file if edit too big: @@ -296,7 +306,7 @@ proc QuotaAdd {fileName} { # Check each defined quota to see if given file violates it: foreach item $items { regexp {([0-9]*),(.*)} $item trash groupCount item - if ![info exists fs($item)] {array set fs [file attributes $fileName]} + if ![info exists fs($item)] {if [file exists $fileName] {array set fs [file attributes $fileName]}} if ![info exists fs($item)] {continue} set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]] if $contrib { @@ -422,7 +432,7 @@ proc QuotaDelete {fileName {delete 1}} { # Check each quota to see if current file contributes to it: foreach item $items { regexp {([0-9]*),(.*)} $item trash groupCount item - if ![info exists fs($item)] {array set fs [file attributes $file] ; set stat($file) [array get fs]} + if ![info exists fs($item)] {if [file exists $file] {array set fs [file attributes $file]} ; set stat($file) [array get fs]} if ![info exists fs($item)] {continue} set contrib [eval $quotaArray($groupCount,$item,rule) [list $fs($item)]] if $contrib { diff --git a/library/template/templatevfs.tcl b/library/template/templatevfs.tcl index 7f64113..386df88 100644 --- a/library/template/templatevfs.tcl +++ b/library/template/templatevfs.tcl @@ -7,7 +7,7 @@ templatevfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5 +Version 1.5.1 The template virtual filesystem is designed as a prototype on which to build new virtual filesystems. Only a few simple, abstract procedures have to be overridden to produce a new @@ -54,7 +54,7 @@ set vfs::posix(load) x vfs::posixError load unset vfs::posix(load) -package provide vfs::template 1.5 +package provide vfs::template 1.5.1 namespace eval ::vfs::template { diff --git a/library/template/versionvfs.tcl b/library/template/versionvfs.tcl index fb6bb5f..aff036c 100644 --- a/library/template/versionvfs.tcl +++ b/library/template/versionvfs.tcl @@ -5,7 +5,7 @@ versionvfs.tcl -- Written by Stephen Huntley (stephen.huntley@alum.mit.edu) License: Tcl license -Version 1.5 +Version 1.5.1 A versioning virtual filesystem. Requires the template vfs in templatevfs.tcl. @@ -221,12 +221,15 @@ proc file_delete {file} { proc file_executable {file} { upvar path path root root relative relative set fileName [VAcquireFile $path $root $relative] + if ![string first .&dir [file tail $fileName]] {return 0} file executable $fileName } proc file_exists {file} { upvar path path root root relative relative set fileName [VAcquireFile $path $root $relative] - file exists $fileName + if ![string first .&dir [file tail $fileName]] {return 0} + if [file isdirectory $fileName] {return 1} + expr ![string equal [file join $path $relative] $fileName] } proc file_mkdir {file} { upvar root root @@ -242,6 +245,7 @@ proc file_mkdir {file} { proc file_readable {file} { upvar path path root root relative relative set fileName [VAcquireFile $path $root $relative] + if ![string first .&dir [file tail $fileName]] {return 0} file readable $fileName } proc file_stat {file array} { @@ -258,6 +262,7 @@ proc file_stat {file array} { proc file_writable {file} { upvar path path root root relative relative set fileName [VAcquireFile $path $root $relative] + if ![string first .&dir [file tail $fileName]] {return 0} file writable $fileName } proc glob_ {directory dir nocomplain tails types typeString dashes pattern} { -- 2.23.0