From: Vince Darley <vincentdarley@sourceforge.net>
Date: Tue, 24 Dec 2002 11:12:56 +0000 (+0000)
Subject: ftp fix
X-Git-Tag: vfs-1-2~23
X-Git-Url: https://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