From: Vince Darley <vincentdarley@sourceforge.net>
Date: Fri, 10 Aug 2001 16:40:51 +0000 (+0000)
Subject: mk4vfs support, some fixes
X-Git-Tag: vfs-1-2~133
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=08607e18620ff6701a6e7df26fa3789173a85f94;p=tclvfs

mk4vfs support, some fixes
---

diff --git a/ChangeLog b/ChangeLog
index f8ce536..70963b6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,2 +1,8 @@
+2001-08-10  Vince Darley <vincentdarley@sourceforge.net>
+	* added 'utime' to various vfs
+	* included mk4tcl vfs implementation which works
+	* added some support files so this library can be
+	  used more easily with TclKit.
+
 2001-05-09  Vince Darley <vincentdarley@sourceforge.net>
-	* initial distribution zip vfs works
+	* initial distribution, zip vfs works
diff --git a/library/ftpvfs.tcl b/library/ftpvfs.tcl
index 472a3c1..7dad36e 100644
--- a/library/ftpvfs.tcl
+++ b/library/ftpvfs.tcl
@@ -90,3 +90,7 @@ proc vfs::ftp::fileattributes {fd path args} {
     }
 }
 
+proc vfs::ftp::utime {fd path actime mtime} {
+    
+}
+
diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
new file mode 100644
index 0000000..340c448
--- /dev/null
+++ b/library/mk4vfs.tcl
@@ -0,0 +1,819 @@
+#
+# Copyright (C) 1997-1999 Sensus Consulting Ltd. All Rights Reserved.
+# Matt Newman <matt@sensus.org> and Jean-Claude Wippler <jcw@equi4.com>
+#
+# $Header$
+#
+
+###############################################################################
+# use Pink for zip and md5 replacements, this avoids the dependency on Trf
+
+    package ifneeded Trf 1.3 {
+    
+        package require pink
+        package provide Trf 1.3
+    
+        proc zip {flag value data} {
+            switch -glob -- "$flag $value" {
+            {-mode d*} {
+                set mode decompress
+            }
+            {-mode c*} {
+                set mode compress
+            }
+            default {
+                error "usage: zip -mode {compress|decompress} data"
+            }
+            }
+            return [pink zlib $mode $data]
+        }
+    
+        proc crc {data} {
+            return [pink zlib crc32 $data]
+        }
+    
+        proc md5 {data} {
+            set cmd [pink md5]
+            $cmd update $data
+            set result [$cmd digest]
+            rename $cmd ""
+            return $result
+        }
+    }
+
+###############################################################################
+# this replacement is for memchan, used for simple (de)compression
+
+    package ifneeded memchan 0.1 {
+    
+	    package require rechan
+	    package provide memchan 0.1
+	
+	    proc _memchan_handler {cmd fd args} {
+	        upvar #0 ::_memchan_buf($fd) _buf
+	        upvar #0 ::_memchan_pos($fd) _pos
+	        set arg1 [lindex $args 0]
+	        
+	        switch -- $cmd {
+	            seek {
+	                switch $args {
+	                    1 { incr arg1 $_pos }
+	                    2 { incr arg1 [string length $_buf]}
+	                }
+	                return [set _pos $arg1]
+	            }
+	            read {
+	                set r [string range $_buf $_pos [expr { $_pos + $arg1 - 1 }]]
+	                incr _pos [string length $r]
+	                return $r
+	            }
+	            write {
+	                set n [string length $arg1]
+	                if { $_pos >= [string length $_buf] } {
+	                    append _buf $arg1
+	                } else { # the following doesn't work yet :(
+	                    set last [expr { $_pos + $n - 1 }]
+	                    set _buf [string replace $_buf $_pos $last $arg1]
+			    error "mk4vfs: sorry no inline write yet"
+	                }
+	                incr _pos $n
+	                return $n
+	            }
+	            close {
+	                unset _buf _pos
+	            }
+		    default {
+			error "Bad call to memchan replacement handler: $cmd"
+		    }
+	        }
+	    }
+	    
+	    proc memchan {} {
+	        set fd [rechan _memchan_handler 6]
+	        #fconfigure $fd -translation binary -encoding binary
+	        
+	        set ::_memchan_buf($fd) ""
+	        set ::_memchan_pos($fd) 0
+	        
+	        return $fd
+	    }
+	}
+        
+###############################################################################
+
+namespace eval vfs::mk4 {}
+
+proc vfs::mk4::Mount {what local args} {
+    set fd [eval [list ::mk4vfs::mount $what $local] $args]
+    return $fd
+}
+
+proc vfs::mk4::handler {db cmd root relative actualpath args} {
+    #tclLog [list $db $cmd $root $relative $actualpath $args]
+    if {$cmd == "matchindirectory"} {
+	eval [list $cmd $db $relative $actualpath] $args
+    } elseif {$cmd == "fileattributes"} {
+	eval [list $cmd $db $root $relative] $args
+    } else {
+	eval [list $cmd $db $relative] $args
+    }
+}
+
+proc vfs::mk4::utime {db path actime modtime} {
+    #puts [list utime $path]
+    ::mk4vfs::stat $db $path sb
+    
+    if { $sb(type) == "file" } {
+	::mk::set $sb(ino) date $modtime
+    }
+}
+
+# If we implement the commands below, we will have a perfect
+# virtual file system for zip files.
+
+proc vfs::mk4::matchindirectory {db path actualpath pattern type} {
+    #puts stderr [list matchindirectory $path $actualpath $pattern $type]
+    set res [::mk4vfs::getdir $db $path $pattern]
+    #puts stderr "got $res"
+    set newres [list]
+    foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
+	lappend newres "$actualpath$p"
+    }
+    #puts "got $newres"
+    return $newres
+}
+
+proc vfs::mk4::stat {db name} {
+    #puts "stat $name"
+    ::mk4vfs::stat $db $name sb
+    #puts [array get sb]
+
+    # for new vfs:
+    set sb(dev) 0
+    set sb(ino) 0
+    array get sb
+}
+
+proc vfs::mk4::access {db name mode} {
+    #puts "mk4-access $name $mode"
+    # This needs implementing better.  
+    #tclLog "mk4vfs::driver $db access $name $mode"
+    switch -- $mode {
+	0 {
+	    # exists
+	    if {![catch {::mk4vfs::stat $db $name sb}]} {
+		return
+	    }
+	}
+	1 {
+	    # executable
+	    if {![catch {::mk4vfs::stat $db $name sb}]} {
+		return
+	    }
+	}
+	2 {
+	    # writable
+	    if {![catch {::mk4vfs::stat $db $name sb}]} {
+		return
+	    }
+	}
+	4 {
+	    # readable
+	    if {![catch {::mk4vfs::stat $db $name sb}]} {
+		return
+	    }
+	}
+    }
+    #tclLog "access bad"
+    error "bad file" 
+}
+
+proc vfs::mk4::open {db file mode permissions} {
+    #puts "open $file $mode $permissions"
+    # return a list of two elements:
+    # 1. first element is the Tcl channel name which has been opened
+    # 2. second element (optional) is a command to evaluate when
+    #    the channel is closed.
+    switch -glob -- $mode {
+	{}  -
+	r   {
+	    ::mk4vfs::stat $db $file sb
+	
+	    if { $sb(csize) != $sb(size) } {
+		package require Trf
+		package require memchan
+		#tclLog "$file: decompressing on read"
+
+		set fd [memchan]
+		fconfigure $fd -translation binary
+		set s [mk::get $sb(ino) contents]
+		puts -nonewline $fd [zip -mode decompress $s]
+
+		fconfigure $fd -translation auto
+		seek $fd 0
+		return [list $fd [list _memchan_handler close $fd]]
+	    } elseif { $::mk4vfs::direct } {
+		package require Trf
+		package require memchan
+
+		set fd [memchan]
+		fconfigure $fd -translation binary
+		puts -nonewline $fd [mk::get $sb(ino) contents]
+
+		fconfigure $fd -translation auto
+		seek $fd 0
+		return [list $fd [list _memchan_handler close $fd]]
+	    } else {
+		set fd [mk::channel $sb(ino) contents r]
+	    }
+	    return [list $fd]
+	}
+	a   {
+	    if { [catch {::mk4vfs::stat $db $file sb }] } {
+		#tclLog "stat failed - creating $file"
+		# Create file
+		::mk4vfs::stat $db [file dirname $file] sb
+
+		set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
+		set sb(ino) $cur
+
+		if { [string match *z* $mode] || ${mk4vfs::compress} } {
+		    set sb(csize) -1    ;# HACK - force compression
+		} else {
+		    set sb(csize) 0
+		}
+	    }
+
+	    if { $sb(csize) != $sb(size) } {
+		package require Trf
+		package require memchan
+
+		#tclLog "$file: compressing on append"
+		append mode z
+		set fd [memchan]
+
+		fconfigure $fd -translation binary
+		set s [mk::get $sb(ino) contents]
+		puts -nonewline $fd [zip -mode decompress $s]
+		fconfigure $fd -translation auto
+	    } else {
+		set fd [mk::channel $sb(ino) contents a]
+	    }
+	    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+	}
+	w*  {
+	    if { [catch {::mk4vfs::stat $db $file sb }] } {
+		#tclLog "stat failed - creating $file"
+		# Create file
+		::mk4vfs::stat $db [file dirname $file] sb
+		set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
+		set sb(ino) $cur
+	    }
+	    if { [string match *z* $mode] || ${mk4vfs::compress} } {
+		package require Trf
+		package require memchan
+		#tclLog "$file: compressing on write"
+		###zip -attach $fd -mode compress
+		append mode z
+		set fd [memchan]
+	    } else {
+		set fd [mk::channel $sb(ino) contents w]
+	    }
+	    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+	}
+	default     {
+	    error "illegal access mode \"$mode\""
+	}
+    }
+}
+
+proc vfs::mk4::createdirectory {db name} {
+    #puts stderr "createdirectory $name"
+    mk4vfs::mkdir $db $name
+}
+
+proc vfs::mk4::removedirectory {db name} {
+    #puts stderr "removedirectory $name"
+    mk4vfs::delete $db $name
+}
+
+proc vfs::mk4::deletefile {db name} {
+    #puts "deletefile $name"
+    mk4vfs::delete $db $name
+}
+
+proc vfs::mk4::fileattributes {db root relative args} {
+    #puts "fileattributes $args"
+    switch -- [llength $args] {
+	0 {
+	    # list strings
+	    return [::vfs::listAttributes]
+	}
+	1 {
+	    # get value
+	    set index [lindex $args 0]
+	    return [::vfs::attributesGet $root $relative $index]
+
+	}
+	2 {
+	    # set value
+	    set index [lindex $args 0]
+	    set val [lindex $args 1]
+	    return [::vfs::attributesSet $root $relative $index $val]
+	}
+    }
+}
+
+package require Mk4tcl
+package require vfs
+package require vfslib
+
+package provide mk4vfs 1.0
+
+namespace eval mk4vfs {
+    variable uid 0
+    variable compress 1         ;# HACK - needs to be part of "Super-Block"
+    variable flush      5000    ;# Auto-Commit frequency
+    variable direct 0
+
+    namespace export mount umount
+}
+
+proc mk4vfs::init {db} {
+    mk::view layout $db.dirs {name:S parent:I {files {name:S size:I date:I contents:M}}}
+
+    if { [mk::view size $db.dirs] == 0 } {
+        mk::row append $db.dirs name <root> parent 0
+    }
+}
+
+proc mk4vfs::mount {path file args} {
+    variable uid
+    set db mk4vfs[incr uid]
+
+    eval [list mk::file open $db $file] $args
+
+    init $db
+
+    ::vfs::filesystem mount $path [list ::vfs::mk4::handler $db]
+
+    set flush 1
+    for {set idx 0} {$idx < [llength $args]} {incr idx} {
+        switch -- [lindex $args $idx] {
+        -readonly       -
+        -nocommit       {set flush 0}
+        }
+    }
+    if { $flush } {
+        _commit $db
+    }
+    return $db
+}
+
+proc mk4vfs::_commit {db} {
+    after ${::mk4vfs::flush} [list mk4vfs::_commit $db]
+    mk::file commit $db
+}
+
+proc mk4vfs::umount {path args} {
+    tclLog [list unmount $path $args]
+    return [eval [list vfs::filesystem unmount $path] $args]
+}
+
+proc mk4vfs::stat {db path arr} {
+    variable cache
+    
+    #set pre [array names cache]
+    
+    upvar 1 $arr sb
+    #tclLog "mk4vfs::stat $db $path $arr"
+
+    set sp [::file split $path]
+    set tail [lindex $sp end]
+
+    set parent 0
+    set view $db.dirs
+    set cur $view!$parent
+    set type directory
+
+    foreach ele [lrange $sp 0 [expr { [llength $sp] - 2 }]] {
+
+        if { [info exists cache($cur,$ele)] } {
+            set parent $cache($cur,$ele)
+        } else {
+            #set row [mk::select $view name $ele parent $parent]
+            set row [find/dir $view $ele $parent]
+
+            if { $row == -1 } {
+                #tclLog "select failed: parent $parent name $ele"
+                return -code error "could not read \"$path\": no such file or directory"
+            }
+	    set parent $row
+            set cache($cur,$ele) $parent
+        }
+	set cur $view!$parent
+	#mk::cursor position cur $parent
+    }
+    #
+    # 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 ""] } {
+	# donothing
+
+    } elseif { [info exists cache($cur,$tail)] } {
+        set type directory
+        #set cur $view!$cache($cur,$tail)
+	mk::cursor position cur $cache($cur,$tail)
+
+    } else {
+        # File?
+        #set row [mk::select $cur.files name $tail]
+        set row [find/file $cur.files $tail]
+
+        if { $row != -1 } {
+            set type file
+            set view $cur.files
+	    #set cur $view!$row
+	    mk::cursor create cur $view $row
+
+        } else {
+            # Directory?
+            #set row [mk::select $view parent $parent name $tail]
+            set row [find/dir $view $tail $parent]
+
+            if { $row != -1 } {
+                set type directory
+		#set cur $view!$row
+		# MUST SET cache BEFORE calling mk::cursor!!!
+		set cache($cur,$tail) $row
+		mk::cursor position cur $row
+            } else { 
+                return -code error "could not read \"$path\": no such file or directory"
+            }
+        }
+    }
+    set sb(type)	$type
+    set sb(view)	$view
+    set sb(ino)		$cur
+    set sb(dev)		[list mk4vfs::driver $db]
+
+    if { [string equal $type "directory"] } {
+        set sb(atime)   0
+        set sb(ctime)   0
+	set sb(gid)	0
+        set sb(mode)    0777
+        set sb(mtime)   0
+        set sb(nlink)   [expr { [mk::get $cur files] + 1 }]
+        set sb(size)    0
+        set sb(csize)   0
+	set sb(uid)	0
+    } else {
+        set mtime	[mk::get $cur date]
+        set sb(atime)	$mtime
+        set sb(ctime)	$mtime
+	set sb(gid)	0
+        set sb(mode)    0777
+        set sb(mtime)	$mtime
+        set sb(nlink)   1
+        set sb(size)    [mk::get $cur size]
+        set sb(csize)   [mk::get $cur -size contents]
+	set sb(uid)	0
+    }
+    
+    #foreach n [array names cache] {
+    #if {[lsearch -exact $pre $n] == -1} {
+    #puts "added $path $n $cache($n)"
+    #}
+    #}
+}
+
+proc mk4vfs::driver {db option args} {
+    #tclLog "mk4vfs::driver $db $option $args"
+    switch -- $option {
+    lstat       {return [uplevel 1 [concat [list mk4vfs::stat $db] $args]]}
+    chdir       {return [lindex $args 0]}
+    access      {
+	# This needs implementing better.  The 'lindex $args 1' is
+	# the access mode we should be checking.
+	set mode [lindex $args 1]
+	#tclLog "mk4vfs::driver $db access [lindex $args 0] $mode"
+	switch -- $mode {
+	    0 {
+		# exists
+		if {![catch {stat $db [lindex $args 0] sb}]} {
+		    return
+		}
+	    }
+	    1 {
+		# executable
+		if {![catch {stat $db [lindex $args 0] sb}]} {
+		    return
+		}
+	    }
+	    2 {
+		# writable
+		if {![catch {stat $db [lindex $args 0] sb}]} {
+		    return
+		}
+	    }
+	    4 {
+		# readable
+		if {![catch {stat $db [lindex $args 0] sb}]} {
+		    return
+		}
+	    }
+	}
+	#tclLog "access bad"
+	error "bad file" 
+    }
+    removedirectory {
+	return [uplevel 1 [concat [list mk4vfs::delete $db] $args]]
+    }
+    atime       {
+	# Not implemented
+    }
+    mtime       -
+    delete      -
+    stat        -
+    getdir      -
+    mkdir       {return [uplevel 1 [concat [list mk4vfs::$option $db] $args]]}
+    
+    open        {
+            set file [lindex $args 0]
+            set mode [lindex $args 1]
+
+            switch -glob -- $mode {
+            {}  -
+            r   {
+                    stat $db $file sb
+                
+                    if { $sb(csize) != $sb(size) } {
+                        package require Trf
+                        package require memchan
+                        #tclLog "$file: decompressing on read"
+
+                        set fd [memchan]
+                        fconfigure $fd -translation binary
+                        set s [mk::get $sb(ino) contents]
+                        puts -nonewline $fd [zip -mode decompress $s]
+
+                        fconfigure $fd -translation auto
+                        seek $fd 0
+			return [list $fd [list _memchan_handler close $fd]]
+                    } elseif { $::mk4vfs::direct } {
+                        package require Trf
+                        package require memchan
+
+                        set fd [memchan]
+                        fconfigure $fd -translation binary
+                        puts -nonewline $fd [mk::get $sb(ino) contents]
+
+                        fconfigure $fd -translation auto
+                        seek $fd 0
+			return [list $fd [list _memchan_handler close $fd]]
+		    } else {
+			set fd [mk::channel $sb(ino) contents r]
+                    }
+		    return [list $fd]
+                }
+            a   {
+                    if { [catch {stat $db $file sb }] } {
+                        #tclLog "stat failed - creating $file"
+                        # Create file
+                        stat $db [file dirname $file] sb
+
+                        set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
+                        set sb(ino) $cur
+
+                        if { [string match *z* $mode] || ${mk4vfs::compress} } {
+                            set sb(csize) -1    ;# HACK - force compression
+                        } else {
+                            set sb(csize) 0
+                        }
+                    }
+
+                    if { $sb(csize) != $sb(size) } {
+                        package require Trf
+                        package require memchan
+
+                        #tclLog "$file: compressing on append"
+                        append mode z
+                        set fd [memchan]
+
+                        fconfigure $fd -translation binary
+                        set s [mk::get $sb(ino) contents]
+                        puts -nonewline $fd [zip -mode decompress $s]
+                        fconfigure $fd -translation auto
+                    } else {
+			set fd [mk::channel $sb(ino) contents a]
+                    }
+                    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+                }
+            w*  {
+                    if { [catch {stat $db $file sb }] } {
+                        #tclLog "stat failed - creating $file"
+                        # Create file
+                        stat $db [file dirname $file] sb
+                        set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
+                        set sb(ino) $cur
+                    }
+                    if { [string match *z* $mode] || ${mk4vfs::compress} } {
+                        package require Trf
+                        package require memchan
+                        #tclLog "$file: compressing on write"
+                        ###zip -attach $fd -mode compress
+                        append mode z
+                        set fd [memchan]
+                    } else {
+	                    set fd [mk::channel $sb(ino) contents w]
+                    }
+                    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+                }
+            default     {
+                    error "illegal access mode \"$mode\""
+                }
+            }
+        }
+    sync        {eval [list mk::file commit $db] [lrange $args 1 end]}
+    umount      {eval [list mk::file close $db] $args}
+    default     {
+            return -code error "bad option \"$option\": must be one of chdir, delete, getdir, load, lstat, mkdir, open, stat, sync, or umount"
+        }
+    }
+}
+
+proc mk4vfs::do_close {fd mode cur} {
+    # Set size to -1 before the seek - just in case it fails.
+    
+    if {[catch {
+	set iswrite [regexp {[aw]} $mode]
+	    
+	if {$iswrite} {
+	    mk::set $cur size -1 date [clock seconds]
+	    flush $fd
+	    if { [string match *z* $mode] } {
+		fconfigure $fd -translation binary
+		seek $fd 0
+		set data [read $fd]
+		_memchan_handler close $fd
+		set cdata [zip -mode compress $data]
+		set len [string length $data]
+		set clen [string length $cdata]
+		if { $clen < $len } {
+		    mk::set $cur size $len contents $cdata
+		} else {
+		    mk::set $cur size $len contents $data
+		}
+	    } else {
+		mk::set $cur size [mk::get $cur -size contents]
+	    }
+	    # added 30-10-2000
+	    set db [lindex [split $cur .] 0]
+	    mk::file autocommit $db
+	} else {
+	    # This should only be called for write operations...
+	    error "Shouldn't call me for read ops"
+	}
+    } err]} {
+	global errorInfo
+	tclLog "mk4vfs::do_close callback error: $err $errorInfo"
+    }
+}
+
+proc mk4vfs::mkdir {db path} {
+    set sp [::file split $path]
+    set parent 0
+    set view $db.dirs
+
+    set npath {}
+    foreach ele $sp {
+        set npath [file join $npath $ele]
+
+        if { ![catch {stat $db $npath sb}] } {
+            if { $sb(type) != "directory" } {
+                return -code error "can't create directory \"$npath\": file already exists"
+            }
+            set parent [mk::cursor position sb(ino)]
+            continue
+        }
+        #set parent [mk::cursor position sb(ino)]
+#puts "set cur \[mk::row append $view name $ele parent $parent]"
+        set cur [mk::row append $view name $ele parent $parent]
+        set parent [mk::cursor position cur]
+    }
+}
+
+# removed this from 'getdir' proc.
+if { 0 } {
+    foreach row [mk::select $sb(view) parent $parent -glob name $pat] {
+	if { $row == 0 } {continue}
+
+	set hits([mk::get $sb(view)!$row name]) 1
+    }
+    # Match files
+    set view $sb(view)!$parent.files
+    foreach row [mk::select $view -glob name $pat] {
+	set hits([mk::get $view!$row name]) 1
+    }
+} 
+
+proc mk4vfs::getdir {db path {pat *}} {
+    #tclLog [list mk4vfs::getdir $db $path $pat]
+
+    if { [catch {
+        stat $db $path sb
+    }] } {
+        return {}
+    }
+
+    if { $sb(type) != "directory" } {
+        return {}
+        #return -code error "bad path \"$path\": not a directory"
+    }
+    # Match directories
+    set parent [mk::cursor position sb(ino)] 
+    mk::loop sb(ino) {
+	if { [mk::get $sb(ino) parent] == $parent &&
+	     [string match $pat [mk::get $sb(ino) name]] &&
+	     [mk::cursor position sb(ino)] != 0 } {
+	    set hits([mk::get $sb(ino) name]) 1
+	}
+    }
+    # Match files
+    mk::loop sb(ino) $sb(view)!$parent.files {
+	if { [string match $pat [mk::get $sb(ino) name]] } {
+	    set hits([mk::get $sb(ino) name]) 1
+	}
+    }
+    return [lsort [array names hits]]
+}
+
+proc mk4vfs::mtime {db path time} {
+
+    stat $db $path sb
+
+    if { $sb(type) == "file" } {
+        mk::set $sb(ino) date $time
+    }
+    return $time
+}
+
+proc mk4vfs::delete {db path {recursive 0}} {
+    #tclLog "trying to delete $path"
+    set rc [catch { stat $db $path sb } err]
+    if { $rc }  {
+	#tclLog "delete error: $err"
+	return -code error $err
+    }
+    if {$sb(type) == "file" } {
+	mk::row delete $sb(ino)
+    } else {
+	# just mark dirs as deleted
+	set contents [getdir $db $path *]
+	#puts "path, $contents"
+	if {$recursive} {
+	    # We have to delete these manually, else
+	    # they (or their cache) may conflict with
+	    # something later
+	    foreach f $contents {
+		delete $db [file join $path $f] $recursive
+	    }
+	} else {
+	    if {[llength $contents]} {
+		return -code error "Non-empty"
+	    }
+	}
+	set tail [file tail $path]
+	variable cache
+	set var2 "$sb(view)![mk::get $sb(ino) parent],$tail"
+	#puts "del $path, $tail , $var2, [info exists cache($var2)]"
+	if {[info exists cache($var2)]} {
+	    #puts "remove2: $path $var2 $cache($var2)"
+	    unset cache($var2)
+	}
+	
+	mk::set $sb(ino) parent -1
+    }
+    return ""
+}
+
+proc mk4vfs::find/file {v name} {
+    mk::loop cur $v {
+	if { [string equal [mk::get $cur name] $name] } {
+	    return [mk::cursor position cur]
+	}
+    }
+    return -1
+}
+
+proc mk4vfs::find/dir {v name parent} {
+    mk::loop cur $v {
+	if {	[mk::get $cur parent] == $parent &&
+		[string equal [mk::get $cur name] $name] } {
+	    return [mk::cursor position cur]
+	}
+    }
+    return -1
+}
diff --git a/library/pkgIndex.tcl b/library/pkgIndex.tcl
index df2a0aa..45125a6 100644
--- a/library/pkgIndex.tcl
+++ b/library/pkgIndex.tcl
@@ -10,3 +10,6 @@
 
 lappend auto_path $dir
 package ifneeded vfs 1.0 [list load [file join $dir vfs10[info sharedlibextension]]]
+package ifneeded scripdoc 0.3 [list source [file join $dir scripdoc.tcl]]
+package ifneeded mk4vfs 1.0 [list source [file join $dir mk4vfs.tcl]]
+package ifneeded vfslib 0.1 [list source [file join $dir vfs.tcl]]
diff --git a/library/scripdoc.tcl b/library/scripdoc.tcl
new file mode 100644
index 0000000..20fb1fa
--- /dev/null
+++ b/library/scripdoc.tcl
@@ -0,0 +1,122 @@
+# Only useful for TclKit
+# (this file is include in tclvfs so this entire package can be
+# use in tclkit if desired).
+#
+# Scripted document support
+#
+# 2000/03/12 jcw v0.1	initial version
+# 2000/09/30 jcw v0.2	added extendPath
+#
+# Copyright (C) 2000 Jean-Claude Wippler <jcw@equi4.com>
+
+package require vfs
+package provide scripdoc 0.3
+
+namespace eval scripdoc {
+    variable self	;# the scripted document file
+    variable script	;# the script which is started up
+
+    namespace export init extendPath
+}
+
+proc scripdoc::init {version driver args} {
+    variable self
+    variable script
+    global errorInfo tk_library
+
+    set self [info script]
+    set root [file tail [file rootname $self]]
+
+    if {$root == ""} {
+	error "scripdoc::init can only be called from a script file"
+    }
+
+    if {[catch {
+	if {$version != 1.0} {
+	    error "Unsupported scripdoc format (need $version, have 1.0)"
+	}
+
+	array set opts {m -nocommit}
+	array set opts $args
+
+	package require ${driver}vfs
+	::vfs::${driver}::Mount $self $self $opts(m)
+
+	extendPath $self
+
+	foreach name [list $root main help] {
+	    set script [file join $self bin $name.tcl]
+	    if {[file exists $script]} break
+	}
+
+	if {![file exists $script]} {
+	    error "don't know how to run $root for $self"
+	}
+
+	uplevel [list source $script]
+    } msg]} {
+	if {[info exists tk_library]} {
+	    wm withdraw .
+	    tk_messageBox -icon error -message $msg -title "Fatal error"
+	} elseif {"[info commands eventlog][info procs eventlog]" != ""} {
+	    eventlog error $errorInfo
+	} else {
+	    puts stderr $errorInfo
+	}
+	exit
+    }
+}
+
+# Extend auto_path with a set of directories, if they exist.
+#
+# The following paths may be added (but in the opposite order):
+#	$base/lib
+#	$base/lib/arch/$tcl_platform(machine)
+#	$base/lib/arch/$tcl_platform(platform)
+#	$base/lib/arch/$tcl_platform(os)
+#	$base/lib/arch/$tcl_platform(os)/$tcl_platform(osVersion)
+#
+# The last two entries are actually expanded even further, splitting
+# $tcl_platform(os) on spaces and $tcl_platform(osVersion) on ".".
+#
+# So on NT, "Windows" and "Windows/NT" would also be considered, and on
+# Linux 2.2.14, all of the following: Linux/2, Linux/2/2, Linux/2/2/14
+#
+# Only paths for which the dir exist are added (once) to auto_path.
+
+proc scripdoc::extendPath {base {verbose 0}} {
+    global auto_path
+    upvar #0 tcl_platform pf
+
+    set path [file join $base lib]
+    if {[file isdirectory $path]} {
+	set pos [lsearch $auto_path $path]
+	if {$pos < 0} {
+	    set pos [llength $auto_path]
+	    lappend auto_path $path
+	}
+	
+	if {$verbose} {
+	    set tmp [join [concat {{}} $auto_path] "\n      "]
+	    tclLog "scripDoc::extendPath $base -> auto_path is: $tmp"
+	}
+
+	foreach suffix [list $pf(machine) \
+			     $pf(platform) \
+			     [list $pf(os) $pf(osVersion)] \
+			     [concat [split $pf(os) " "] \
+			     	     [split $pf(osVersion) .]]] {
+
+	    set tmp [file join $path arch]
+	    foreach x $suffix {
+	    	set tmp [file join $tmp $x]
+		if {$verbose} {tclLog "  checking $tmp"}
+		if {![file isdirectory $tmp]} break
+		if {[lsearch $auto_path $tmp] < 0} {
+		    if {$verbose} {tclLog "    inserted in auto_path."}
+		    set auto_path [linsert $auto_path $pos $tmp]
+		}
+	    }
+	}
+    }
+}
diff --git a/library/tclIndex b/library/tclIndex
index dbacdf3..3d43b66 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -24,6 +24,7 @@ set auto_index(::vfs::tclproc::stat) [list source [file join $dir tclprocvfs.tcl
 set auto_index(::vfs::tclproc::access) [list source [file join $dir tclprocvfs.tcl]]
 set auto_index(::vfs::tclproc::exists) [list source [file join $dir tclprocvfs.tcl]]
 set auto_index(::vfs::tclproc::open) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::tclproc::_generate) [list source [file join $dir tclprocvfs.tcl]]
 set auto_index(::vfs::tclproc::matchindirectory) [list source [file join $dir tclprocvfs.tcl]]
 set auto_index(::vfs::tclproc::createdirectory) [list source [file join $dir tclprocvfs.tcl]]
 set auto_index(::vfs::tclproc::removedirectory) [list source [file join $dir tclprocvfs.tcl]]
@@ -44,12 +45,14 @@ set auto_index(::vfs::autoMountUrl) [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]]
 set auto_index(::vfs::fileUrlMount) [list source [file join $dir vfsUtils.tcl]]
+set auto_index(::vfs::tclprocMount) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::auto) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::matchCorrectTypes) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::accessMode) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::matchDirectories) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::matchFiles) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::modeToString) [list source [file join $dir vfsUtils.tcl]]
+set auto_index(::vfs::posixError) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::zip::Mount) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::Unmount) [list source [file join $dir zipvfs.tcl]]
 set auto_index(::vfs::zip::handler) [list source [file join $dir zipvfs.tcl]]
diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index d98876c..953cdd1 100644
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -181,3 +181,7 @@ proc vfs::tclproc::fileattributes {ns name args} {
     }
 }
 
+proc vfs::tclproc::utime {what name actime mtime} {
+    puts stderr "utime $name"
+    error ""
+}
diff --git a/library/testvfs.tcl b/library/testvfs.tcl
index 321f753..2b6db90 100644
--- a/library/testvfs.tcl
+++ b/library/testvfs.tcl
@@ -75,3 +75,6 @@ proc vfs::test::fileattributes {what args} {
     }
 }
 
+proc vfs::test::utime {what name actime mtime} {
+    puts "utime $name"
+}
diff --git a/library/vfs.tcl b/library/vfs.tcl
new file mode 100644
index 0000000..c5b3f47
--- /dev/null
+++ b/library/vfs.tcl
@@ -0,0 +1,73 @@
+# Only useful for TclKit
+# (this file is include in tclvfs so this entire package can be
+# use in tclkit if desired).
+#
+# Initialization script normally executed in the interpreter for each
+# VFS-based application.
+#
+# Copyright (c) 1999  Matt Newman <matt@sensus.org>
+# Further changes made by Jean-Claude Wippler <jcw@equi4.com>
+# Further changes made by Vince Darley <vince.darley@eurobios.com>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# Insist on running with compatible version of Tcl.
+
+package require Tcl 8.4
+
+package provide vfslib 0.1
+
+# So I can debug on command line!
+#proc history {args} {}
+
+lappend auto_path [file dirname [info script]]
+
+namespace eval ::vfs {
+    variable debug	0
+    if {[info exists env(VFS_DEBUG)]} {
+	set debug $env(VFS_DEBUG)
+    }
+
+    variable temp
+    global env
+
+    set temp [file nativename /usr/tmp]
+    if {![file exists $temp]} {set temp [file nativename /tmp]}
+    catch {set temp $env(TMP)}
+    catch {set temp $env(TMPDIR)}
+    catch {set temp $env(SYSTEMDRIVE)/temp}
+    catch {set temp $env(TEMP)}
+    catch {set temp $env(VFS_TEMP)}
+    set temp [file join $temp tclkit]
+    file mkdir $temp
+
+    # This is not right XXX need somewhere to unpack
+    # indirect-dependant DLL's etc.
+
+    global env tcl_platform
+    if {$tcl_platform(platform) == "windows"} {
+	set env(PATH) "${vfs::temp}/bin;$env(PATH)"
+    } elseif {$tcl_platform(platform) == "unix"} {
+	set env(PATH) "${vfs::temp}/bin:$env(PATH)"
+    } else {
+	set env(PATH) "${vfs::temp}/bin"
+    }
+    proc debug {tag body} {
+	set cnt [info cmdcount]
+	set time [lindex [time {
+	    set rc [catch {uplevel 1 [list eval $body]} ret]
+	}] 0]
+	set cnt' [info cmdcount]
+	set ei ${::errorInfo}
+	set ec ${::errorCode}
+	puts stderr "$tag: [expr {${cnt'} - $cnt}] ops, $time us"
+	return -code $rc -errorcode $ec -errorinfo $ei $ret
+    }
+}
+
+proc vfs::log {msg {lvl 0}} {
+    if {$lvl < ${::vfs::debug}} {
+	tclLog "vfs($lvl): $msg"
+    }
+}
diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index f727faf..29dc811 100644
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -155,6 +155,90 @@ proc vfs::matchFiles {types} {
 proc vfs::modeToString {mode} {
 }
 
+# These lists are used to convert attribute indices into the string equivalent.
+# They are copied from Tcl's C sources.  There is no need for them to be
+# the same as in the native filesystem; we can use completely different
+# attribute sets.  However some items, like '-longname' it is probably
+# best to implement.
+set vfs::attributes(windows) [list -archive -hidden -longname -readonly -shortname -system -vfs]
+set vfs::attributes(macintosh) [list -creator -hidden -readonly -type -vfs]
+set vfs::attributes(unix) [list -group -owner -permissions -vfs]
+
+proc vfs::listAttributes {} {
+    variable attributes
+    global tcl_platform
+    set attributes($tcl_platform(platform))
+}
+
+proc vfs::indexToAttribute {idx} {
+    return [lindex [listAttributes] $idx]
+}
+
+proc vfs::attributesGet {root stem index} {
+    # Return standard Tcl result, or error.
+    set attribute [indexToAttribute $index]
+    switch -- $attribute {
+	"-longname" {
+	    # We always use the normalized form!
+	    return [file join $root $stem]
+	}
+	"-shortname" {
+	    set rootdir [file attributes [file dirname $root] -shortname]
+	    return [file join $rootdir [file tail $root] $stem]
+	}
+	"-archive" {
+	    return 0
+	}
+	"-hidden" {
+	    return 0
+	}
+	"-readonly" {
+	    return 0
+	}
+	"-system" {
+	    return 0
+	}
+	"-vfs" {
+	    return 1
+	}
+	"-owner" {
+	    return
+	}
+	"-group" {
+	    return
+	}
+    }
+}
+
+proc vfs::attributesSet {root stem index val} {
+    # Return standard Tcl result, or error.
+    set attribute [indexToAttribute $index]
+    #puts "$attribute"
+    switch -- $attribute {
+	"-owner" {
+	    return
+	}
+	"-group" {
+	    return
+	}
+	"-archive" {
+	    return
+	}
+	"-hidden" {
+	    return
+	}
+	"-permissions" {
+	    return
+	}
+	"-longname" {
+	    error "no such luck"
+	}
+	"-vfs" {
+	    error "read-only"
+	}
+    }
+}
+
 proc vfs::posixError {name} {
     variable posix
     return $posix($name)
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 90039ab..c64f96a 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -8,7 +8,7 @@ namespace eval vfs::zip {}
 
 proc vfs::zip::Mount {zipfile local} {
     set fd [::zip::open [::file normalize $zipfile]]
-    vfs::filesystem mount $local [list vfs::zip::handler $fd]
+    vfs::filesystem mount $local [list ::vfs::zip::handler $fd]
     return $fd
 }
 
@@ -136,6 +136,11 @@ proc vfs::zip::fileattributes {zipfd name args} {
     }
 }
 
+proc vfs::zip::utime {fd path actime mtime} {
+    error ""
+}
+
+
 # Below copied from TclKit distribution
 
 #
diff --git a/runZippedTests.tcl b/runZippedTests.tcl
index 51f0c06..a7c9056 100644
--- a/runZippedTests.tcl
+++ b/runZippedTests.tcl
@@ -9,7 +9,19 @@ puts stdout "Zipping tests" ; update
 exec zip -q -9 tests.zip tests/*
 puts stdout "Done zipping"
 
-package require vfs
+cd [file dirname [info script]]
+
+if {[catch {package require vfs}]} {
+    cd win
+    load vfs10d.dll
+    cd ..
+    lappend auto_path [file join [pwd] library]
+}
+
+lappend auto_path "C:/Program Files/Tcl/lib"
+package require Trf
+package require Memchan
+
 set mount [vfs::zip::Mount tests.zip tests.zip]
 puts "Zip mount is $mount"
 update