Version 4 of A chroot virtual filesystem

Updated 2007-05-20 22:16:40 by dkf

SEH -- 1/12/05 -- This should be of interest to anyone who runs pure-tcl httpd, ftpd or other servers, or uses the Tcl plug-in. Once this vfs is mounted, the specified existing directory appears to the interpreter to be the toplevel of the filesystem, thus providing a kind of "chroot" functionality within the tcl shell.

This can work as a big security enhancement for those who can't use safe interpreters because they want to be able to read and write files, but still don't want to expose potentially their whole filesystem to visitors due to accident or hacking. This vfs thus provides what might be called a "safe-ish" interpreter.

N.B. in order to make the filesystem outside the specified chroot directory truly inaccessible, you must disable the interpreter's ability to spawn outside shell command processes, since this vfs has no effect on how programs outside tclsh access files. That could be done by creating a slave interpreter and disabling its ability to call the exec command, and aliasing its open command to a proc in the master that calls open on files but returns an error if the command pipeline syntax is used.

 # chrootvfs.tcl --
 #
 #        A chroot virtual filesystem.
 #
 #        This virual filesystem has an effect similar to a "chroot" command; it makes the named existing directory appear
 #        to be the top of the filesystem and makes the rest of the real filesystem invisible. If there is more than
 #        one real volume (i.e., multiple letter drives on a Windows computer), all but the volume the chroot
 #        directory is on will be disabled.
 #
 #        This vfs does not block access by the "exec" command to the real filesystem outside the chroot directory,
 #        or that of the "open" command when its command pipeline syntax is used.
 #
 #
 # Written by Stephen Huntley ([email protected])
 #
 # Install: This code requires that the template vfs (http://wiki.tcl.tk/11938) procedures have already
 # been sourced into the interpreter.
 #
 # Usage: Mount ?-volume? <existing "chroot" directory>  <virtual directory>
 #
 # examples:
 #
 #        Mount $::env(HOME) /
 #
 #        Mount {C:\My Music} C:/
 #
 #        Mount -volume /var/www/htdocs chroot://

 package require vfs 1
 namespace eval ::vfs::template::chroot {}

 proc ::vfs::template::chroot::Mount {args} {
        eval [info body ::vfs::template::Mount]
 }

 namespace eval ::vfs::template::chroot {

 proc FsTrace {commandString op} {
        if {[lindex $commandString 1] == "posixerror"} {set ::vfs::template::chroot::fstrace $commandString}
 }

 proc MountProcedure {args} {
 set origArgs $args
        foreach templateProc "Mount Unmount CloseTrace Access CreateDirectory DeleteFile FileAttributes FileAttributesSet MatchInDirectory Open Close RemoveDirectory Stat Utime" {
                set infoArgs [info args ::vfs::template::$templateProc]
                set infoBody [info body ::vfs::template::$templateProc]
                proc $templateProc $infoArgs $infoBody
        }
        if {[lindex $args 0] == "-volume"} {
                set args [lrange $args 1 end]
                set to [lindex $args end]
        } else {
                set to [file normalize [lindex $args end]]
        }
        set path [file normalize [lindex $args 0]]

        foreach volume [file volumes] {
                if [string first $volume $to] {
                        if ![catch {::vfs::filesystem info $volume}] {continue}
                        ::vfs::filesystem mount $volume {vfs::filesystem posixerror $::vfs::posix(ENOENT)}
                }
        }

 append handler {Unmount $root
 catch {unset ::vfs::template::chroot::fstrace}
 }
 append handler "set errNum \[catch \{"
 append handler \n
 append handler [info body ::vfs::template::handler]
 append handler \n
 append handler "\} result]"
 append handler \n
 append handler "Mount $origArgs"
 append handler \n
 append handler {if {!$errNum || ($errNum == 2)} {return $result}
 if [info exists ::vfs::template::chroot::fstrace] {eval $::vfs::template::chroot::fstrace}
 error

 }

        set infoArgs [info args ::vfs::template::handler]
        set infoBody $handler
        proc handler $infoArgs $infoBody

        trace add execution ::vfs::filesystem enter ::vfs::template::chroot::FsTrace
        vfs::states

        file mkdir $path
        array unset ::vfs::_unmountCmd $to
        lappend pathto $path
        lappend pathto $to
        return $pathto
 }

 proc UnmountProcedure {path to} {
        return
 }

 }
 # end namespace eval ::vfs::template::chroot

Now with this vfs in combination with the others like a versioning virtual filesystem and a quota-enforcing virtual filesystem, you may be able to begin imagining file and information sharing, archiving and collaboration utilities that make end-to-end use of tcl tools -- the likes of tclhttpd, burrow, mkRinterp, comm, Mk4Tcl, starkits, Tcl modules, plugins -- that are more functional, stabler and safer than anything available anywhere else. I've already hacked up a backup/archive utility for personal use that duplicates a large subset of the function of programs like Subversion, except it's stabler, easier to use and more cross-platform.

I think Tcl is at a point where its main strength can be viewed as more than an excellent glue between the unsatisfactory legacy systems current today, but instead as a source of easy-to-use infrastructure modules, unmatchable with any other technology, that can completely replace those systems.

All we need is the imagination and the ambition.

See also SafeKit sets up a chroot jail for a complementary Unix-side utility which will totally seal off a static tclkit setup.


[Category VFS]