+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).
+
2001-08-13 Vince Darley <vincentdarley@sourceforge.net>
* ftp vfs works reasonably well now; try:
% package require vfs
+Hello! The code here has evolved from ideas and excellent work by Matt
+Newman, Jean-Claude Wippler, TclKit etc. To make this really successful,
+we need a group of volunteers to enhance what we have and build a new way
+of writing and distributing Tcl code.
+
+Introduction
+------------
+
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.
-- Vince Darley, August 1st 2001
+Current implementation
+----------------------
+
Some of the provided vfs's require the Memchan extension for any operation
which involves opening files.
archive as a directory, rather than a file. Otherwise you might wish
to create a dummy file/directory called 'local' before mounting.
+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
+
+ file copy ftp://ftp.foo.com/pub/readme.txt ~/readme.txt
+
+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).
+
+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
+---------------
+
+See:
+
+http://www.ximian.com/tech/gnome-vfs.php3
+http://www.lh.com/~oleg/ftp/HTTP-VFS.html
+
+for some ideas. It would be good to accumulate ideas on the limitations of
+the current VFS support so we can plan out what vfs 2.0 will look like (and
+what changes will be needed in Tcl's core to support it). Obvious things
+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').
+
.TP
\fIcommand\fR \fImatchindirectory\fR \fIr-r-a\fR \fIpattern\fR \fItypes\fR
Return the list of files or directories in the given path (which is
-always the name of an existing directory), which match the \fIpattern\fR
-and are compatible with the \fItypes\fR given. It is very important
-that the command correctly handle \fItypes\fR requests for directories
-only (and files only).
+always the name of an existing directory), which match the
+\fIpattern\fR and are compatible with the \fItypes\fR given. It is
+very important that the command correctly handle \fItypes\fR requests
+for directories only (and files only), because to handle any kind of
+recursive globbing, Tcl will actually generate requests for
+directory-only matches from the filesystem. See \fBvfs::matchDirectories\fR
+below for help.
.TP
\fIcommand\fR \fIopen\fR \fIr-r-a\fR \fImode\fR \fIpermissions\fR
-For this command, \fImode\fR is a list of POSIX open modes or a
-string such as "rw". If the open involves creating a file, then
-\fIpermissions\fR dictates what modes to create it with. If the
-open operation is successful, the command
-should return a list of one or two items. The first item (which
-is obligatory) is the name of the channel which has been created.
-The second item, if given, is a Tcl-callback to be used when the
-channel is closed, so that the vfs can clean up as appropriate.
-If the open operation was not successful, an error should be thrown.
+For this command, \fImode\fR is a list of POSIX open modes or a string
+such as "rw". If the open involves creating a file, then
+\fIpermissions\fR dictates what modes to create it with. If the open
+operation was not successful, an error should be thrown. If the open
+operation is successful, the command should return a list of either one
+or two items. The first item (which is obligatory) is the name of the
+channel which has been created. The second item, if given, is a
+Tcl-callback to be used when the channel is closed, so that the vfs can
+clean up as appropriate. This callback will be evaluated by Tcl just
+before the channel is closed. The channel will still exist, and all
+available data will have been flushed into it. The callback can, for
+example, seek to the beginning of the channel, read its contents and
+store that contents elsewhere (e.g. compressed or on a remote ftp
+site, etc). The return code or any errors returned by the callback
+are ignored (if the callback wishes to signal an error, it must do so
+asychronously, with bgerror, for example).
.TP
\fIcommand\fR \fIremovedirectory\fR \fIr-r-a\fR
Delete the given directory.
static Tcl_FSFilesystemSeparatorProc VfsFilesystemSeparator;
static Tcl_FSFreeInternalRepProc VfsFreeInternalRep;
static Tcl_FSDupInternalRepProc VfsDupInternalRep;
+static Tcl_FSListVolumesProc VfsListVolumes;
static Tcl_Filesystem vfsFilesystem = {
"tclvfs",
&VfsOpenFileChannel,
&VfsMatchInDirectory,
&VfsUtime,
- /* readlink and listvolumes are not important */
- NULL,
+ /* link is not important */
NULL,
+ &VfsListVolumes,
&VfsFileAttrStrings,
&VfsFileAttrsGet,
&VfsFileAttrsSet,
return returnVal;
}
+Tcl_Obj*
+VfsListVolumes(void)
+{
+ Tcl_Obj *resultPtr;
+ Tcl_SavedResult savedResult;
+ Tcl_Interp* interp;
+
+ interp = (Tcl_Interp*) Tcl_FSData(&vfsFilesystem);
+ Tcl_SaveResult(interp, &savedResult);
+
+ /* List all vfs volumes */
+ if (Tcl_GlobalEval(interp, "::vfs::listVolumes") == TCL_OK) {
+ resultPtr = Tcl_DuplicateObj(Tcl_GetObjResult(interp));
+ Tcl_IncrRefCount(resultPtr);
+ } else {
+ resultPtr = NULL;
+ }
+ Tcl_RestoreResult(interp, &savedResult);
+ return resultPtr;
+}
+
\f
/*
*----------------------------------------------------------------------
if {[string range $dirurl 0 5] == "ftp://"} {
set dirurl [string range $dirurl 6 end]
}
- regexp {(([^:]*)(:([^@]*))?@)?([^/]*)/(.*/)?([^/]*)$} $dirurl \
- junk junk user junk pass host path file
+ 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\
# full path name of this file's directory.
lappend auto_path $dir
-package ifneeded vfs 1.0 [list load [file join $dir vfs10[info sharedlibextension]]]
+if {[info exists tcl_platform(debug)]} {
+ package ifneeded vfs 1.0 [list load [file join $dir vfs10d[info sharedlibextension]]]
+} else {
+ 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]]
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::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]]
set auto_index(::vfs::autoMountExtension) [list source [file join $dir vfsUtils.tcl]]
set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]]
set auto_index(::vfs::log) [list source [file join $dir vfsUtils.tcl]]
--- /dev/null
+
+
+namespace eval ::vfs::url {}
+
+proc vfs::url::Mount {type} {
+ # This requires Tcl 8.4a4.
+ set volume "${type}://"
+ if {$type == "file"} {
+ append volume "/"
+ }
+ ::vfs::addVolume $volume
+ ::vfs::filesystem mount $volume [list vfs::url::handler $type]
+}
+
+proc vfs::url::handler {type cmd root relative actualpath args} {
+ puts stderr [list $type $cmd $root $relative $actualpath $args]
+ error ""
+}
+
+proc vfs::url::handler {args} {
+ puts stderr $args
+ error ""
+}
+
if {[info exists env(VFS_DEBUG)]} {
set debug $env(VFS_DEBUG)
}
+ variable volumes ""
+}
+
+# This procedure is called by Tcl when we are registered.
+# The results of the procedure, as well as being listed
+# in 'file volumes' affect whether files are treated as
+# relative or absolute as well.
+proc ::vfs::listVolumes {} {
+ variable volumes
+ return $volumes
+}
+
+proc ::vfs::addVolume {vol} {
+ variable volumes
+ lappend volumes $vol
+}
+
+proc ::vfs::removeVolume {vol} {
+ variable volumes
+ set idx [lsearch -exact $volumes $vol]
+ if {$idx == -1} {
+ return -code error "No such volume \"$vol\""
+ }
+ set volumes [lreplace $volumes $idx $idx]
}
proc ::vfs::autoMountExtension {ext cmd {pkg ""}} {
DLL_VERSION = 10
# comment the following line to compile with symbols
-NODEBUG=1
+NODEBUG=0
!IF "$(NODEBUG)" == "1"
DEBUGDEFINES =
projects / tclvfs / commitdiff