From: Vince Darley Date: Tue, 18 Feb 2003 16:08:33 +0000 (+0000) Subject: readonly support added X-Git-Tag: vfs-1-3~50 X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=7d646127c2e3363c5cc8c04d7e77609e539eb03f;p=tclvfs readonly support added --- diff --git a/ChangeLog b/ChangeLog index b453552..7f0849e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2003-02-18 Vince Darley + + * generic/vfs.c: added 'vfs::filesystem posixerror' command + to allow direct reporting of posix error codes to Tcl. + * library/vfsUtils.tcl: added support for state switching + between "readonly", "translucent" and "readwrite". + * library/mk4vfs.tcl: + * library/tarvfs.tcl: + * library/zipvfs.tcl: + * library/httpvfs.tcl: added support for proper reporting + of read-only status of filesystem + * library/tclIndex: regen. + + You can now switch an mk4 filesystem between translucent and + readonly with 'vfs::attributes $mount -state readonly'. All + errors etc are correctly reported as if the filesystem is + read-only. + 2003-02-17 Vince Darley * library/vfsUtils.tcl: added beginnings of interface for diff --git a/generic/vfs.c b/generic/vfs.c index f49ee02..3d8d2be 100644 --- a/generic/vfs.c +++ b/generic/vfs.c @@ -680,11 +680,11 @@ VfsFilesystemObjCmd(dummy, interp, objc, objv) int index; static CONST char *optionStrings[] = { - "info", "mount", "unmount", "fullynormalize", + "info", "mount", "unmount", "fullynormalize", "posixerror", NULL }; enum options { - VFS_INFO, VFS_MOUNT, VFS_UNMOUNT, VFS_NORMALIZE + VFS_INFO, VFS_MOUNT, VFS_UNMOUNT, VFS_NORMALIZE, VFS_POSIXERROR }; if (objc < 2) { @@ -697,6 +697,18 @@ VfsFilesystemObjCmd(dummy, interp, objc, objv) } switch ((enum options) index) { + case VFS_POSIXERROR: { + int posixError = -1; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "errorcode"); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(NULL, objv[2], &posixError) != TCL_OK) { + return TCL_ERROR; + } + Tcl_SetErrno(posixError); + return TCL_OK; + } case VFS_NORMALIZE: { Tcl_Obj *path; if (objc != 3) { diff --git a/library/httpvfs.tcl b/library/httpvfs.tcl index 061f8c4..d6f30dd 100644 --- a/library/httpvfs.tcl +++ b/library/httpvfs.tcl @@ -81,6 +81,9 @@ proc vfs::http::stat {dirurl name} { proc vfs::http::access {dirurl name mode} { ::vfs::log "access $name $mode" + if {$mode & 2} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } if {$name == ""} { return 1 } set state [::http::geturl "$dirurl$name"] set info "" @@ -114,7 +117,7 @@ proc vfs::http::open {dirurl name mode permissions} { } "a" - "w*" { - error "Can't open $name for writing" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } default { return -code error "illegal access mode \"$mode\"" @@ -141,17 +144,17 @@ proc vfs::http::matchindirectory {dirurl path actualpath pattern type} { proc vfs::http::createdirectory {dirurl name} { ::vfs::log "createdirectory $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::http::removedirectory {dirurl name} { ::vfs::log "removedirectory $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::http::deletefile {dirurl name} { ::vfs::log "deletefile $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::http::fileattributes {dirurl path args} { @@ -169,12 +172,12 @@ proc vfs::http::fileattributes {dirurl path args} { # set value set index [lindex $args 0] set val [lindex $args 1] - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } } } proc vfs::http::utime {dirurl path actime mtime} { - error "Can't set utime" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl index b54f7bb..3a76d4d 100644 --- a/library/mk4vfs.tcl +++ b/library/mk4vfs.tcl @@ -59,10 +59,16 @@ namespace eval vfs::mk4 { proc state {db args} { switch -- [llength $args] { 0 { - return "translucent" + return $::mk4vfs::v::mode($db) } 1 { - return -code error "Can't set state yet" + set val [lindex $args 0] + if {[lsearch -exact [::vfs::states] $val] == -1} { + return -code error \ + "invalid state $val, must be one of: [vfs::states]" + } + set ::mk4vfs::v::mode($db) $val + ::mk4vfs::setupCommits $db } default { return -code error "Wrong num args" @@ -111,8 +117,13 @@ namespace eval vfs::mk4 { array get sb } - proc access {db name mode} { - # This needs implementing better. + proc vfs::mk4::access {db name mode} { + if {$mode & 2} { + if {$::mk4vfs::v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } + } + # We can probably do this more efficiently, can't we? ::mk4vfs::stat $db $name sb } @@ -153,6 +164,9 @@ namespace eval vfs::mk4 { return [list $fd] } a { + if {$::mk4vfs::v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } if { [catch {::mk4vfs::stat $db $file sb }] } { # Create file ::mk4vfs::stat $db [file dirname $file] sb @@ -186,9 +200,12 @@ namespace eval vfs::mk4 { } fconfigure $fd -translation auto seek $fd 0 end - return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]] + return [list $fd [list mk4vfs::do_close $db $fd $mode $sb(ino)]] } w* { + if {$::mk4vfs::v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } if { [catch {::mk4vfs::stat $db $file sb }] } { # Create file ::mk4vfs::stat $db [file dirname $file] sb @@ -208,7 +225,7 @@ namespace eval vfs::mk4 { } else { set fd [mk::channel $sb(ino) contents w] } - return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]] + return [list $fd [list mk4vfs::do_close $db $fd $mode $sb(ino)]] } default { error "illegal access mode \"$mode\"" @@ -242,6 +259,9 @@ namespace eval vfs::mk4 { } 2 { # set value + if {$::mk4vfs::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } set index [lindex $args 0] set val [lindex $args 1] return [::vfs::attributesSet $root $relative $index $val] @@ -258,13 +278,14 @@ namespace eval mk4vfs { namespace eval v { variable seq 0 - variable mode ;# array key is db, value is mode (rw/ro/nc) + variable mode ;# array key is db, value is mode + # (readwrite/translucent/readonly) variable timer ;# array key is db, set to afterid, periodicCommit array set cache {} array set fcache {} - array set mode {exe ro} + array set mode {exe translucent} } namespace export mount umount @@ -290,24 +311,24 @@ namespace eval mk4vfs { set db mk4vfs[incr v::seq] if {$file == ""} { - mk::file open $db - init $db - set v::mode($db) ro + mk::file open $db + init $db + set v::mode($db) "translucent" } else { - eval [list mk::file open $db $file] $args - - init $db - - set v::mode($db) rw - for {set idx 0} {$idx < [llength $args]} {incr idx} { - switch -- [lindex $args $idx] { - -readonly { set v::mode($db) ro } - -nocommit { set v::mode($db) nc } - } - } - if {$v::mode($db) == "rw"} { - periodicCommit $db - } + eval [list mk::file open $db $file] $args + + init $db + + set v::mode($db) "readwrite" + for {set idx 0} {$idx < [llength $args]} {incr idx} { + switch -- [lindex $args $idx] { + -readonly { set v::mode($db) "readonly" } + -nocommit { set v::mode($db) "translucent" } + } + } + if {$v::mode($db) == "readwrite"} { + periodicCommit $db + } } return $db } @@ -439,7 +460,7 @@ namespace eval mk4vfs { } } - proc do_close {fd mode cur} { + proc do_close {db fd mode cur} { if {![regexp {[aw]} $mode]} { error "mk4vfs::do_close called with bad mode: $mode" } @@ -462,17 +483,21 @@ namespace eval mk4vfs { mk::set $cur size [mk::get $cur -size contents] } # 16oct02 new logic to start a periodic commit timer if not yet running - setupCommits [lindex [split $cur .] 0] + setupCommits $db + return "" } proc setupCommits {db} { - if {$v::mode($db) ne "ro" && ![info exists v::timer($db)]} { + if {$v::mode($db) eq "readwrite" && ![info exists v::timer($db)]} { periodicCommit $db mk::file autocommit $db } } proc mkdir {db path} { + if {$v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } set sp [::file split $path] set parent 0 set view $db.dirs @@ -494,6 +519,7 @@ namespace eval mk4vfs { set parent [mk::cursor position cur] } setupCommits $db + return "" } proc getdir {db path {pat *}} { @@ -515,6 +541,9 @@ namespace eval mk4vfs { } proc mtime {db path time} { + if {$v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } stat $db $path sb if { $sb(type) == "file" } { mk::set $sb(ino) date $time @@ -524,6 +553,9 @@ namespace eval mk4vfs { proc delete {db path {recursive 0}} { #puts stderr "mk4delete db $db path $path recursive $recursive" + if {$v::mode($db) == "readonly"} { + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + } stat $db $path sb if {$sb(type) == "file" } { mk::row delete $sb(ino) diff --git a/library/tarvfs.tcl b/library/tarvfs.tcl index 2369ff9..556758f 100644 --- a/library/tarvfs.tcl +++ b/library/tarvfs.tcl @@ -73,7 +73,7 @@ proc vfs::tar::stat {tarfd name} { proc vfs::tar::access {tarfd name mode} { if {$mode & 2} { - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } # Readable, Exists and Executable are treated as 'exists' # Could we get more information from the archive? @@ -114,22 +114,25 @@ proc vfs::tar::open {tarfd name mode permissions} { return [list $nfd] } default { - return -code error "illegal access mode \"$mode\"" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } } } proc vfs::tar::createdirectory {tarfd name} { - error "tar-archives are read-only (not implemented)" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + #error "tar-archives are read-only (not implemented)" } proc vfs::tar::removedirectory {tarfd name} { #::vfs::log "removedirectory $name" - error "tar-archives are read-only (not implemented)" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + #error "tar-archives are read-only (not implemented)" } proc vfs::tar::deletefile {tarfd name} { - error "tar-archives are read-only (not implemented)" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] + #error "tar-archives are read-only (not implemented)" } # don't care about platform-specific attributes @@ -149,14 +152,14 @@ proc vfs::tar::fileattributes {tarfd name args} { # set value set index [lindex $args 0] set val [lindex $args 1] - error "tar-archives are read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } } } -# is this needed?? +# set the 'mtime' of a file. proc vfs::tar::utime {fd path actime mtime} { - error "" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } # diff --git a/library/tclIndex b/library/tclIndex index 6d19daf..4723cff 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -132,6 +132,7 @@ set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::log) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::RegisterMount) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::unmount) [list source [file join $dir vfsUtils.tcl]] +set auto_index(::vfs::states) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::attributes) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::haveMount) [list source [file join $dir vfsUtils.tcl]] set auto_index(::vfs::urlMount) [list source [file join $dir vfsUtils.tcl]] diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl index 0f016fb..9be0510 100644 --- a/library/vfsUtils.tcl +++ b/library/vfsUtils.tcl @@ -59,6 +59,10 @@ proc ::vfs::unmount {mountpoint} { unset _unmountCmd($norm) } +proc vfs::states {} { + return [list "readwrite" "translucent" "readonly"] +} + # vfs::attributes mountpoint ?-opt val? ?...-opt val? proc ::vfs::attributes {mountpoint args} { set handler [::vfs::filesystem info $mountpoint] diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl index 9adde8f..62d636c 100644 --- a/library/zipvfs.tcl +++ b/library/zipvfs.tcl @@ -73,7 +73,7 @@ proc vfs::zip::stat {zipfd name} { proc vfs::zip::access {zipfd name mode} { #::vfs::log "zip-access $name $mode" if {$mode & 2} { - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } # Readable, Exists and Executable are treated as 'exists' # Could we get more information from the archive? @@ -114,24 +114,24 @@ proc vfs::zip::open {zipfd name mode permissions} { return [list $nfd] } default { - return -code error "illegal access mode \"$mode\"" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } } } proc vfs::zip::createdirectory {zipfd name} { #::vfs::log "createdirectory $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::zip::removedirectory {zipfd name} { #::vfs::log "removedirectory $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::zip::deletefile {zipfd name} { #::vfs::log "deletefile $name" - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } proc vfs::zip::fileattributes {zipfd name args} { @@ -150,13 +150,13 @@ proc vfs::zip::fileattributes {zipfd name args} { # set value set index [lindex $args 0] set val [lindex $args 1] - error "read-only" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } } } proc vfs::zip::utime {fd path actime mtime} { - error "" + return -code error [vfs::filesystem posixerror $::vfs::posix(EROFS)] } # Below copied from TclKit distribution