From: Vince Darley Date: Tue, 24 Dec 2002 11:12:56 +0000 (+0000) Subject: ftp fix X-Git-Tag: vfs-1-2~23 X-Git-Url: http://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=ba92ca1badd598e6dc355d5ddc743d3325a0a75d;p=tclvfs ftp fix --- diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl index d7e905f..3a629b7 100644 --- a/library/ftpvfs.tcl +++ b/library/ftpvfs.tcl @@ -74,7 +74,6 @@ proc vfs::ftp::stat {fd name} { return [list type directory mtime 0 size 0 mode 0777 ino -1 \ depth 0 name "" dev -1 uid -1 gid -1 nlink 1] } - # get information on the type of this file set ftpInfo [_findFtpInfo $fd $name] if {$ftpInfo == ""} { error "Couldn't find file info" } @@ -88,7 +87,8 @@ proc vfs::ftp::stat {fd name} { set mtime [ftp::ModTime $fd $name] } lappend res dev -1 uid -1 gid -1 nlink 1 depth 0 \ - atime $mtime ctime $mtime mtime $mtime mode 0777 + atime $mtime ctime $mtime mtime $mtime mode 0777 \ + size [ftp::FileSize $fd $name] return $res } @@ -168,15 +168,19 @@ proc vfs::ftp::_findFtpInfo {fd name} { ::vfs::log "findFtpInfo $fd $name" set ftpList [ftp::List $fd [file dirname $name]] foreach p $ftpList { - foreach {pname perms} [_parseListLine $p] {} + foreach {pname other} [_parseListLine $p] {} if {$pname == [file tail $name]} { - return [list $perms] + return $other } } return "" } -# Currently returns a list of name and permissions +# Currently returns a list of name and a list of other +# information. The other information is currently a +# list of: +# () permissions +# () size proc vfs::ftp::_parseListLine {line} { # Check for filenames with spaces if {[regexp {([^ ]|[^0-9] )+$} $line name]} { @@ -188,12 +192,14 @@ proc vfs::ftp::_parseListLine {line} { } regsub -all "\[ \t\]+" $line " " line set items [split $line " "] - + if {![info exists name]} {set name [lindex $items end]} + lappend other [lindex $items 0] + if {[string is integer [lindex $items 4]]} { + lappend other [lindex $items 4] + } - set perms [lindex $items 0] - - return [list $name $perms] + return [list $name $other] } proc vfs::ftp::matchindirectory {fd path actualpath pattern type} { diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl index 6fdb5bf..65843b8 100644 --- a/library/mk4vfs.tcl +++ b/library/mk4vfs.tcl @@ -87,7 +87,12 @@ namespace eval vfs::mk4 { proc access {db name mode} { # This needs implementing better. - ::mk4vfs::stat $db $name sb + if {$mode & 2} { + ::mk4vfs::stat $db $name + #error "read-only" + } else { + ::mk4vfs::stat $db $name + } } proc open {db file mode permissions} { @@ -299,8 +304,7 @@ namespace eval mk4vfs { mk::file close $db } - proc stat {db path arr} { - upvar 1 $arr sb + proc stat {db path {arr ""}} { set sp [::file split $path] set tail [lindex $sp end] @@ -326,8 +330,8 @@ namespace eval mk4vfs { # Now check if final comp is a directory or a file # CACHING is required - it can deliver a x15 speed-up! - if { [string equal $tail "."] || [string equal $tail ":"] || - [string equal $tail ""] } { + if {[string equal $tail "."] || [string equal $tail ":"] \ + || [string equal $tail ""]} { set row $parent } elseif { [info exists v::cache($db,$parent,$tail)] } { @@ -363,8 +367,16 @@ namespace eval mk4vfs { } } } + + if {![string length $arr]} { + # The caller doesn't need more detailed information. + return 1 + } + set cur $view!$row + upvar 1 $arr sb + set sb(type) $type set sb(view) $view set sb(ino) $cur