+2001-08-29 Vince Darley <vincentdarley@sourceforge.net>
+ * can now mount root volumes which end in separator
+ characters (such as 'ftp://'). The code handles path
+ separation in such cases. This means the 'urltype'
+ vfs now works (the 8-22 changes below didn't quite
+ complete the job).
+ This requires the latest 8.4a4 release from cvs.
+
2001-08-22 Vince Darley <vincentdarley@sourceforge.net>
* added ability to treat entire urls as file paths, so
we can mount 'ftp://' as a root volume and examine its
- contents. This requires a patch to Tcl 8.4a4 which
- is currently available from the Tcl project (see the
- 'fs update' patch/bug).
+ contents. This requires the latest 8.4a4 release from cvs.
2001-08-13 Vince Darley <vincentdarley@sourceforge.net>
* ftp vfs works reasonably well now; try:
This is an implementation of a 'vfs' extension (and a 'vfs' package,
including a small library of Tcl code). The goal of this extension
-is to expose Tcl 8.4a3's new filesystem C API to the Tcl level.
+is to expose Tcl 8.4's new filesystem C API to the Tcl level.
Since 8.4 is still in alpha, the APIs on which this extension depends may of
course change (although this isn't too likely). If that happens, it will of
The vfs's currently available are:
--------+-----------------------------------------------------------------
-vfs | mount command
+vfs | example mount command
--------+-----------------------------------------------------------------
zip | vfs::zip::Mount my.zip local
ftp | vfs::ftp::Mount ftp://user:pass@ftp.foo.com/dir/name/ local
mk4 | vfs::mk4::Mount myMk4database local
test | vfs::test::Mount ...
-tclproc | vfs::tclproc::Mount ::tcl local
+ns | vfs::ns::Mount ::tcl local
+urltype | vfs::urltype::Mount ftp
--------+-----------------------------------------------------------------
For file-systems which make use of a local file (e.g. mounting zip or mk4
Limitations
-----------
-We can't currently mount a file protocol. For example it would be nice to
-tell Tcl that we understand 'ftp://' as meaning an absolute path to be
-handled by our ftp-vfs system. Then we could so something like
+None yet.
- file copy ftp://ftp.foo.com/pub/readme.txt ~/readme.txt
+Helping!
+--------
-and our ftp-vfs system can deal with it. This is really a limitation in
-Tcl's current understanding of file paths (and not any problem in this
-extension per se).
+Any help is much appreciated! The current code has very much _evolved_
+which means it isn't necessarily even particular well thought out, so if
+you wish to contribute a single line of code or a complete re-write, I'd be
+very happy!
-Of course what we can do is mount any specific ftp address to somewhere in
-the filesystem. For example, we can mount 'ftp://ftp.foo.com/ to
-/ftp.foo.com/ and proceed from there.
-
Future thoughts
---------------
which come to mind are asynchronicity: 'file copy' from a mounted remote
site (ftp or http) is going to be very slow and simply block the
application. Commands like that should have new asynchronous versions which
-can be used when desired (e.g. 'file copy from to -callback foo').
+can be used when desired (for example, 'file copy from to -callback foo'
+would be one approach to handling this).
+Bugs in Tcl vfs's are hard to track down, since error messages can't
+necessarily propagate to the toplevel. Could add a debugging command.
VfsInFilesystem(Tcl_Obj *pathPtr, ClientData *clientDataPtr) {
Tcl_Obj *normedObj;
int len, splitPosition;
+ char remember;
char *normed;
Tcl_Interp* interp;
VfsNativeRep *nativeRep;
&& (normed[--splitPosition] != VFS_SEPARATOR)) {
/* Do nothing */
}
+ /*
+ * We now know that normed[splitPosition] is a separator.
+ * However, we might have mounted a root filesystem with a
+ * strange name (for example 'ftp://')
+ */
+ if ((splitPosition > 0) && (splitPosition != len)) {
+ remember = normed[splitPosition + 1];
+ normed[splitPosition+1] = '\0';
+ mountCmd = Tcl_GetVar2Ex(interp, "vfs::mount", normed,
+ TCL_GLOBAL_ONLY);
+
+ if (mountCmd != NULL) {
+ splitPosition++;
+ break;
+ }
+ normed[splitPosition+1] = remember;
+ }
+
+ /* Otherwise continue as before */
+
/* Terminate the string there */
if (splitPosition == 0) {
break;
}
+ remember = VFS_SEPARATOR;
normed[splitPosition] = 0;
}
return -1;
}
if (splitPosition != len) {
- normed[splitPosition] = VFS_SEPARATOR;
+ normed[splitPosition] = remember;
}
nativeRep = (VfsNativeRep*) ckalloc(sizeof(VfsNativeRep));
nativeRep->splitPosition = splitPosition;
} else {
Tcl_ListObjAppendElement(interp, mountCmd,
Tcl_NewStringObj(normedString,splitPosition));
+ if (normedString[splitPosition] != VFS_SEPARATOR) {
+ /* This will occur if we mount 'ftp://' */
+ splitPosition--;
+ }
Tcl_ListObjAppendElement(interp, mountCmd,
Tcl_NewStringObj(normedString+splitPosition+1,
len-splitPosition-1));
--- /dev/null
+
+package require vfs 1.0
+package require http
+
+# THIS DOES NOT WORK!
+
+# It's currently a copy of ftpvfs.tcl where there has basically been
+# a global replacement of 'ftp' by 'http'.
+
+namespace eval vfs::http {}
+
+proc vfs::http::Mount {dirurl local} {
+ if {[string range $dirurl 0 5] == "http://"} {
+ set dirurl [string range $dirurl 6 end]
+ }
+ if {![regexp {(([^:]*)(:([^@]*))?@)?([^/]*)/(.*/)?([^/]*)$} $dirurl \
+ junk junk user junk pass host path file]} {
+ return -code error "Sorry I didn't understand\
+ the url address \"$dirurl\""
+ }
+
+ if {[string length $file]} {
+ return -code error "Can only mount directories, not\
+ files (perhaps you need a trailing '/')"
+ }
+
+ if {![string length $user]} {
+ set user anonymous
+ }
+
+ set fd [::http::Open $host $user $pass $path]
+ if {$fd == -1} {
+ error "Mount failed"
+ }
+ if {[catch {
+ ::http::Cd $fd $path
+ } err]} {
+ http::Close $fd
+ error "Opened http connection, but then received error: $err"
+ }
+
+ ::vfs::log "http $host, $path mounted at $fd"
+ vfs::filesystem mount $local [list vfs::http::handler $fd $path]
+ # Register command to unmount
+ vfs::RegisterMount $local [list ::vfs::http::Unmount $fd]
+ return $fd
+}
+
+proc vfs::http::Unmount {fd local} {
+ vfs::filesystem unmount $local
+ ::http::Close $fd
+}
+
+proc vfs::http::handler {fd path cmd root relative actualpath args} {
+ if {$cmd == "matchindirectory"} {
+ eval [list $cmd $fd $relative $actualpath] $args
+ } else {
+ eval [list $cmd $fd $relative] $args
+ }
+}
+
+# If we implement the commands below, we will have a perfect
+# virtual file system for remote http sites.
+
+proc vfs::http::stat {fd name} {
+ ::vfs::log "stat $name"
+ if {$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 httpInfo [_findHttpInfo $fd $name]
+ if {$httpInfo == ""} { error "Couldn't find file info" }
+ ::vfs::log $httpInfo
+ set perms [lindex $httpInfo 0]
+ if {[string index $perms 0] == "d"} {
+ lappend res type directory
+ set mtime 0
+ } else {
+ lappend res type file
+ set mtime [http::ModTime $fd $name]
+ }
+ lappend res dev -1 uid -1 gid -1 nlink 1 depth 0 \
+ atime $mtime ctime $mtime mtime $mtime mode 0777
+ return $res
+}
+
+proc vfs::http::access {fd name mode} {
+ ::vfs::log "access $name $mode"
+ if {$name == ""} { return 1 }
+ set info [vfs::http::_findHttpInfo $fd $name]
+ if {[string length $info]} {
+ return 1
+ } else {
+ error "No such file"
+ }
+}
+
+# We've chosen to implement these channels by using a memchan.
+# The alternative would be to use temporary files.
+proc vfs::http::open {fd name mode permissions} {
+ ::vfs::log "open $name $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" {
+ http::Get $fd $name -variable tmp
+ package require Memchan
+
+ set filed [memchan]
+ fconfigure $filed -translation binary
+ puts -nonewline $filed $tmp
+
+ fconfigure $filed -translation auto
+ seek $filed 0
+ return [list $filed]
+ }
+ "a" -
+ "w*" {
+ # Try to write an empty file
+ error "Can't open $name for writing"
+ }
+ default {
+ return -code error "illegal access mode \"$mode\""
+ }
+ }
+}
+
+proc vfs::http::_findHttpInfo {fd name} {
+ ::vfs::log "findHttpInfo $fd $name"
+ set httpList [http::List $fd [file dirname $name]]
+ foreach p $httpList {
+ regsub -all "\[ \t\]+" $p " " p
+ set items [split $p " "]
+ set pname [lindex $items end]
+ if {$pname == [file tail $name]} {
+ return $items
+ }
+ }
+ return ""
+}
+
+proc vfs::http::matchindirectory {fd path actualpath pattern type} {
+ ::vfs::log "matchindirectory $path $pattern $type"
+ set httpList [http::List $fd $path]
+ ::vfs::log "httpList: $httpList"
+ set res [list]
+
+ foreach p $httpList {
+ regsub -all "\[ \t\]+" $p " " p
+ set items [split $p " "]
+ set name [lindex $items end]
+ set perms [lindex $items 0]
+ if {[::vfs::matchDirectories $type]} {
+ if {[string index $perms 0] == "d"} {
+ lappend res "$actualpath$name"
+ }
+ }
+ if {[::vfs::matchFiles $type]} {
+ if {[string index $perms 0] != "d"} {
+ lappend res "$actualpath$name"
+ }
+ }
+
+ }
+
+ return $res
+}
+
+proc vfs::http::createdirectory {fd name} {
+ ::vfs::log "createdirectory $name"
+ error "read-only"
+}
+
+proc vfs::http::removedirectory {fd name} {
+ ::vfs::log "removedirectory $name"
+ error "read-only"
+}
+
+proc vfs::http::deletefile {fd name} {
+ ::vfs::log "deletefile $name"
+ error "read-only"
+}
+
+proc vfs::http::fileattributes {fd path args} {
+ ::vfs::log "fileattributes $args"
+ switch -- [llength $args] {
+ 0 {
+ # list strings
+ return [list]
+ }
+ 1 {
+ # get value
+ set index [lindex $args 0]
+ }
+ 2 {
+ # set value
+ set index [lindex $args 0]
+ set val [lindex $args 1]
+ error "read-only"
+ }
+ }
+}
+
+proc vfs::http::utime {fd path actime mtime} {
+ error "Can't set utime"
+}
+
set auto_index(::vfs::ftp::deletefile) [list source [file join $dir ftpvfs.tcl]]
set auto_index(::vfs::ftp::fileattributes) [list source [file join $dir ftpvfs.tcl]]
set auto_index(::vfs::ftp::utime) [list source [file join $dir ftpvfs.tcl]]
+set auto_index(::vfs::http::Mount) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::Unmount) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::handler) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::stat) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::access) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::open) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::_findHttpInfo) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::matchindirectory) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::createdirectory) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::removedirectory) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::deletefile) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::fileattributes) [list source [file join $dir httpvfs.tcl]]
+set auto_index(::vfs::http::utime) [list source [file join $dir httpvfs.tcl]]
set auto_index(::vfs::mk4::Mount) [list source [file join $dir mk4vfs.tcl]]
set auto_index(::vfs::mk4::Unmount) [list source [file join $dir mk4vfs.tcl]]
set auto_index(::vfs::mk4::handler) [list source [file join $dir mk4vfs.tcl]]
set auto_index(::mk4vfs::find/dir) [list source [file join $dir mk4vfs.tcl]]
set auto_index(::scripdoc::init) [list source [file join $dir scripdoc.tcl]]
set auto_index(::scripdoc::extendPath) [list source [file join $dir scripdoc.tcl]]
-set auto_index(::vfs::tclproc::Mount) [list source [file join $dir tclprocvfs.tcl]]
-set auto_index(::vfs::tclproc::Unmount) [list source [file join $dir tclprocvfs.tcl]]
-set auto_index(::vfs::tclproc::handler) [list source [file join $dir tclprocvfs.tcl]]
-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]]
-set auto_index(::vfs::tclproc::deletefile) [list source [file join $dir tclprocvfs.tcl]]
-set auto_index(::vfs::tclproc::fileattributes) [list source [file join $dir tclprocvfs.tcl]]
-set auto_index(::vfs::tclproc::utime) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::Mount) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::Unmount) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::handler) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::stat) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::access) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::exists) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::open) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::_generate) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::matchindirectory) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::createdirectory) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::removedirectory) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::deletefile) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::fileattributes) [list source [file join $dir tclprocvfs.tcl]]
+set auto_index(::vfs::ns::utime) [list source [file join $dir tclprocvfs.tcl]]
set auto_index(::vfs::test::Mount) [list source [file join $dir testvfs.tcl]]
set auto_index(::vfs::test::Unmount) [list source [file join $dir testvfs.tcl]]
set auto_index(::vfs::test::handler) [list source [file join $dir testvfs.tcl]]
set auto_index(::vfs::test::fileattributes) [list source [file join $dir testvfs.tcl]]
set auto_index(::vfs::test::utime) [list source [file join $dir testvfs.tcl]]
set auto_index(::vfs::debug) [list source [file join $dir vfs.tcl]]
-set auto_index(::vfs::url::Mount) [list source [file join $dir vfsUrl.tcl]]
-set auto_index(::vfs::url::handler) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::Mount) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::handler) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::stat) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::access) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::matchindirectory) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::createdirectory) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::removedirectory) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::deletefile) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::fileattributes) [list source [file join $dir vfsUrl.tcl]]
+set auto_index(::vfs::urltype::utime) [list source [file join $dir vfsUrl.tcl]]
set auto_index(::vfs::listVolumes) [list source [file join $dir vfsUtils.tcl]]
set auto_index(::vfs::addVolume) [list source [file join $dir vfsUtils.tcl]]
set auto_index(::vfs::removeVolume) [list source [file join $dir vfsUtils.tcl]]
# procedures with the same name as a namespace, which are hidden in
# a filesystem representation.
-namespace eval vfs::tclproc {}
+namespace eval vfs::ns {}
-proc vfs::tclproc::Mount {ns local} {
+proc vfs::ns::Mount {ns local} {
if {![namespace exists ::$ns]} {
error "No such namespace"
}
- ::vfs::log "tclproc $ns mounted at $local"
- vfs::filesystem mount $local [list vfs::tclproc::handler $ns]
- vfs::RegisterMount $local [list vfs::tclproc::Unmount]
+ ::vfs::log "ns $ns mounted at $local"
+ vfs::filesystem mount $local [list vfs::ns::handler $ns]
+ vfs::RegisterMount $local [list vfs::ns::Unmount]
}
-proc vfs::tclproc::Unmount {local} {
+proc vfs::ns::Unmount {local} {
vfs::filesystem unmount $local
}
-proc vfs::tclproc::handler {ns cmd root relative actualpath args} {
+proc vfs::ns::handler {ns cmd root relative actualpath args} {
regsub -all / $relative :: relative
if {$cmd == "matchindirectory"} {
eval [list $cmd $ns $relative $actualpath] $args
}
# If we implement the commands below, we will have a perfect
-# virtual file system for remote tclproc sites.
+# virtual file system for namespaces.
-proc vfs::tclproc::stat {ns name} {
+proc vfs::ns::stat {ns name} {
::vfs::log "stat $name"
if {[namespace exists ::${ns}::${name}]} {
return [list type directory size 0 mode 0777 \
}
}
-proc vfs::tclproc::access {ns name mode} {
+proc vfs::ns::access {ns name mode} {
::vfs::log "access $name $mode"
if {[namespace exists ::${ns}::${name}]} {
return 1
}
}
-proc vfs::tclproc::exists {ns name} {
+proc vfs::ns::exists {ns name} {
if {[namespace exists ::${ns}::${name}]} {
return 1
} elseif {[llength [info procs ::${ns}::${name}]]} {
}
}
-proc vfs::tclproc::open {ns name mode permissions} {
+proc vfs::ns::open {ns name mode permissions} {
::vfs::log "open $name $mode $permissions"
# return a list of two elements:
# 1. first element is the Tcl channel name which has been opened
}
}
-proc vfs::tclproc::_generate {p} {
+proc vfs::ns::_generate {p} {
lappend a proc $p
set argslist [list]
foreach arg [info args $p] {
lappend a $argslist [info body $p]
}
-proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} {
+proc vfs::ns::matchindirectory {ns path actualpath pattern type} {
::vfs::log "matchindirectory $path $actualpath $pattern $type"
set res [list]
return $realres
}
-proc vfs::tclproc::createdirectory {ns name} {
+proc vfs::ns::createdirectory {ns name} {
::vfs::log "createdirectory $name"
namespace eval ::${ns}::${name} {}
}
-proc vfs::tclproc::removedirectory {ns name} {
+proc vfs::ns::removedirectory {ns name} {
::vfs::log "removedirectory $name"
namespace delete ::${ns}::${name}
}
-proc vfs::tclproc::deletefile {ns name} {
+proc vfs::ns::deletefile {ns name} {
::vfs::log "deletefile $name"
rename ::${ns}::${name} {}
}
-proc vfs::tclproc::fileattributes {ns name args} {
+proc vfs::ns::fileattributes {ns name args} {
::vfs::log "fileattributes $args"
switch -- [llength $args] {
0 {
}
}
-proc vfs::tclproc::utime {what name actime mtime} {
+proc vfs::ns::utime {what name actime mtime} {
::vfs::log "utime $name"
error ""
}
+# The idea here is that we can mount 'ftp' or 'http' or 'file' types
+# of urls and that (provided we have separate vfs types for them) we
+# can then treat 'ftp://' as a mount point for ftp services. For
+# example, we can do:
+#
+# % vfs::urltype::Mount ftp
+# Mounted at "ftp://"
+# % cd ftp://
+# % cd ftp.ucsd.edu (or 'cd user:pass@ftp.foo.com')
+# (This now creates an ordinary ftp-vfs for the remote site)
+# ...
+#
+# Or all in one go:
+#
+# % file copy ftp://ftp.ucsd.edu/pub/alpha/Readme .
+namespace eval ::vfs::urltype {}
-namespace eval ::vfs::url {}
-
-proc vfs::url::Mount {type} {
+proc vfs::urltype::Mount {type} {
# This requires Tcl 8.4a4.
- set volume "${type}://"
+ set mountPoint "${type}://"
if {$type == "file"} {
- append volume "/"
+ append mountPoint "/"
}
- ::vfs::addVolume $volume
- ::vfs::filesystem mount $volume [list vfs::url::handler $type]
+ ::vfs::addVolume "${mountPoint}"
+ ::vfs::filesystem mount $mountPoint [list vfs::urltype::handler $type]
+ return "Mounted at \"${mountPoint}\""
}
-proc vfs::url::handler {type cmd root relative actualpath args} {
+proc vfs::urltype::handler {type cmd root relative actualpath args} {
puts stderr [list $type $cmd $root $relative $actualpath $args]
+ if {$cmd == "matchindirectory"} {
+ eval [list $cmd $type $relative $actualpath] $args
+ } else {
+ eval [list $cmd $type $relative] $args
+ }
+}
+
+# Stuff below not very well implemented.
+
+proc vfs::urltype::stat {ns name} {
+ ::vfs::log "stat $name"
+ if {![string length $name]} {
+ return [list type directory size 0 mode 0777 \
+ ino -1 depth 0 name $name atime 0 ctime 0 mtime 0 dev -1 \
+ uid -1 gid -1 nlink 1]
+ } elseif {1} {
+ return [list type file]
+ } else {
+ return -code error "could not read \"$name\": no such file or directory"
+ }
+}
+
+proc vfs::urltype::access {ns name mode} {
+ ::vfs::log "access $name $mode"
+ if {![string length $name]} {
+ return 1
+ } elseif {1} {
+ if {$mode & 2} {
+ error "read-only"
+ }
+ return 1
+ } else {
+ error "No such file"
+ }
+}
+
+proc vfs::urltype::matchindirectory {ns path actualpath pattern type} {
+ ::vfs::log "matchindirectory $path $actualpath $pattern $type"
+ set res [list]
+
+ return $res
+}
+
+proc vfs::urltype::createdirectory {ns name} {
+ ::vfs::log "createdirectory $name"
+ error ""
+}
+
+proc vfs::urltype::removedirectory {ns name} {
+ ::vfs::log "removedirectory $name"
error ""
}
-proc vfs::url::handler {args} {
- puts stderr $args
+proc vfs::urltype::deletefile {ns name} {
+ ::vfs::log "deletefile $name"
error ""
}
+proc vfs::urltype::fileattributes {fd path args} {
+ ::vfs::log "fileattributes $args"
+ switch -- [llength $args] {
+ 0 {
+ # list strings
+ return [list]
+ }
+ 1 {
+ # get value
+ set index [lindex $args 0]
+ }
+ 2 {
+ # set value
+ set index [lindex $args 0]
+ set val [lindex $args 1]
+ }
+ }
+}
+
+proc vfs::urltype::utime {what name actime mtime} {
+ ::vfs::log "utime $name"
+ error ""
+}
package require vfs 1.0
# Using the vfs, memchan and Trf extensions, we ought to be able
-# to write a Tcl-only zip virtual filesystem.
+# to write a Tcl-only zip virtual filesystem. What we have below
+# is basically that.
namespace eval vfs::zip {}
DLL_VERSION = 10
# comment the following line to compile with symbols
-NODEBUG=0
+NODEBUG=1
!IF "$(NODEBUG)" == "1"
DEBUGDEFINES =
projects / tclvfs / commitdiff