island

The package below helps bringing back some file operation capabilities to Safe Interps. Use it as exemplified below:

package require island
set slave [interp create -safe]
::island::add $slave /one/path/of/your/choice

Then, the code in your safe interpreter slave should be able to perform file operations, but only on the files that are under /one/path/of/your/choice. You can create as many islands as necessary through calling ::island::add several times. All paths are fully normalized before testing for access. The commands that are brought back to the slave are: file, glob, open and fconfigure.

##################
## Module Name     --  island.tcl
## Original Author --  Emmanuel Frecon - [email protected]
## Description:
##
##      Package to a allow a safe interpreter to access islands of the
##      filesystem only, i.e. restricted directory trees within the
##      filesystem. The package brings back file, open and glob to the slave
##      interpreter, though in a restricted manner.
##
##################

package require Tcl 8.4


namespace eval ::island {
    namespace eval interps {};   # Will host information for interpreters
    namespace export {[a-z]*};   # Convention: export all lowercase
    catch {namespace ensemble create}
    variable version 0.2
}


# ::island::add -- Add allowed path
#
#       Add a path to the list of paths that are explicitely allowed for access
#       to a slave interpreter. Access to any path that has not been explicitely
#       allowed will be denied. Paths that are added to the list of allowed
#       islands are always fully normalized.
#
# Arguments:
#        slave        Identifier of the slave to control
#        path        Path to add to allowed list
#
# Results:
#       The current list of allowed path
#
# Side Effects:
#       None.
proc ::island::add { slave path } {
    set vname [namespace current]::interps::[string map {: _} $slave]
    if { ![info exists $vname]} {
        Init $slave
    }
    upvar \#0 $vname paths
    lappend paths [::file dirname [::file normalize $path/___]]
}


# ::island::reset -- Cleanup
#
#       Remove all access path allowance and arrange for the interpreter to be
#       able to return to the regular safe state.
#
# Arguments:
#        slave        Identifier of the slave
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::island::reset { slave } {
    set vname [namespace current]::interps::[string map {: _} $slave]
    if { [info exists $vname] } {
        $slave alias file {}
        $slave alias open {}
        $slave alias glob {}
        $slave alias fconfigure {}
        unset $vname
    }    
}



########################
##
## Procedures below are internal to the implementation.
##
########################


# ::island::Allowed -- Check access restrictions
#
#       Check that the file name passed as an argument is within the islands of
#       the filesystem that have been registered through the add command for a
#       given (safe) interpreter. The path is fully normalized before testing
#       against the islands, which themselves are fully normalized.
#
# Arguments:
#        slave        Identifier of the slave under out control
#        fname        (relative) path to the file to test
#
# Results:
#       1 if access is allowed, 0 otherwise
#
# Side Effects:
#       None.
proc ::island::Allowed { slave fname } {
    set vname [namespace current]::interps::[string map {: _} $slave]
    upvar \#0 $vname paths

    set abs_fname [::file dirname [::file normalize $fname/___]]
    foreach path $paths {
        if { [string first $path $abs_fname] == 0 } {
            return 1
        }
    }
    return 0
}


# ::island::File -- Restricted file
#
#       Parses the options and arguments to the file command to discover which
#       paths it tries to access and only return the results of its execution
#       when these path are within the allowed islands of the filesystem.
#
# Arguments:
#        slave        Identifier of the slave under our control
#        cmd        Subcommand of the file command.
#        args        Arguments to the file subcommand.
#
# Results:
#       As of the file command.
#
# Side Effects:
#       As of the file command.
proc ::island::File { slave cmd args } {
    switch $cmd {
        atime -
        attributes -
        executable -
        exists -
        isdirectory -
        isfile -
        lstat -
        mtime -
        normalize -
        owned -
        readable -
        readlink -
        size -
        stat -
        system -
        type -
        writable {
            set fname [lindex $args 0]
            if { [Allowed $slave $fname] } {
                return [uplevel [linsert $args 0 ::file $cmd]]
                # file is highly restrictive in slaves, so we can't do the following.
                return [uplevel [linsert $args 0 $slave invokehidden ::file $cmd]]
            } else {
                return -code error "Access to $fname denied."
            }
        }
        channels -
        dirname -
        extension -
        join -
        nativename -
        pathtype -
        rootname -
        separator -
        split -
        tail -
        volumes {
            return [uplevel [linsert $args 0 ::file $cmd]]
            # file is highly restrictive in slaves, so we can't do the following.
            return [uplevel [linsert $args 0 $slave invokehidden file $cmd]]
        }
        copy -
        delete -
        rename -
        link {
            set idx [lsearch $args "--"]
            if { $idx >= 0 } {
                set paths [lrange $args [expr {$idx+1}] end]
            } else {
                if { [string index [lindex $args 0] 0] eq "-" } {
                    set paths [lrange $args 1 end]
                } else {
                    set paths $args
                }
            }
            foreach path $paths {
                if { ![Allowed $slave $path] } {
                    return -code error "Access to $path denied."
                }
            }
            return [uplevel [linsert $args 0 ::file $cmd]]
            # file is highly restrictive in slaves, so we can't do the following.
            return [uplevel [linsert $args 0 $slave invokehidden file $cmd]]
        }
        mkdir {
            foreach path $args {
                if { ![Allowed $slave $path] } {
                    return -code error "Access to $path denied."
                }
            }
            return [uplevel [linsert $args 0 ::file $cmd]]
            # file is highly restrictive in slaves, so we can't do the following.
            return [uplevel [linsert $args 0 $slave invokehidden file $cmd]]
        }
    }
}


# ::island::Open -- Restricted open
#
#       Parses the options and arguments to the open command to discover which
#       paths it tries to access and only return the results of its execution
#       when these path are within the allowed islands of the filesystem.
#
# Arguments:
#        slave        Identifier of the slave under our control
#        args        Arguments to the open command.
#
# Results:
#       As of the open command.
#
# Side Effects:
#       As of the open command.
proc ::island::Open { slave args } {
    set fname [lindex $args 0]
    if { [string index [string trim $fname] 0] eq "|" } {
        return -code error "Execution of external programs disabled."
    }
    
    if { [Allowed $slave $fname] } {
        return [uplevel [linsert $args 0 $slave invokehidden open]]
    } else {
        return -code error "Access to $fname denied."
    }
}


# ::island::Expose -- Expose back a command
#
#       This procedure allows to callback a command that would typically have
#       been hidden from a slave interpreter. It does not "interp expose" but
#       rather calls the hidden command, so we can easily revert back.
#
# Arguments:
#        slave        Identifier of the slave under our control
#        cmd        Hidden command to call
#        args        Arguments to the glob command.
#
# Results:
#       As of the hidden command to call
#
# Side Effects:
#       As of the hidden command to call
proc ::island::Expose { slave cmd args } {
    return [uplevel [linsert $args 0 $slave invokehidden $cmd]]
}


# ::island::Glob -- Restricted glob
#
#       Parses the options and arguments to the glob command to discover which
#       paths it tries to access and only return the results of its execution
#       when these path are within the allowed islands of the filesystem.
#
# Arguments:
#        slave        Identifier of the slave under our control
#        args        Arguments to the glob command.
#
# Results:
#       As of the glob command.
#
# Side Effects:
#       As of the glob command.
proc ::island::Glob { slave args } {
    set noargs [list -join -nocomplain -tails]
    set within ""
    for {set i 0} {$i < [llength $args]} {incr i} {
        set itm [lindex $args $i]
        if { $itm eq "--" } {
            incr i; break
        } elseif { [string index $itm 0] eq "-" } {
            # Segragates between options that take a value and options that
            # have no arguments and are booleans.
            if { [lsearch $noargs $itm] < 0 } {
                incr i;  # Jump over argument
                switch -glob -- $itm {
                    "-dir*" {
                        set within [lindex $args $i]
                        append within /
                    }
                    "-path*" {
                        set within [lindex $args $i]
                    }
                }
            }
        } else {
            break
        }
    }

    foreach ptn [lrange $args $i end] {
        set path ${within}$ptn
        if { ![Allowed $slave $path] } {
            return -code error "Access to $path denied."
        }
    }

    return [uplevel [linsert $args 0 $slave invokehidden glob]]    
}


# ::island::Init -- Initialise interp
#
#       Initialise slave interpreter so that it will be able to perform some
#       file operations, but only within some islands of the filesystem.
#
# Arguments:
#        slave        Identifier of the slave to control
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::island::Init { slave } {
    $slave alias file ::island::File $slave
    $slave alias glob ::island::Glob $slave
    # Allow to open some of the files, and since we did, arrange to be able to
    # fconfigure them once opened.
    $slave alias open ::island::Open $slave
    $slave alias fconfigure ::island::Expose $slave fconfigure
}



package provide island $::island::version

APN Useful functionality for sure but is there a functional difference compared to the Safe package?

EF Yes. The Safe package is about controlling where and what to source from (and other commands that would load code into the interpreter). This package is about creating directory "jails" within which the safe interpreter will be able to perform most file-related operations. file for example, behaves pretty much the same as the real one, as opposed to the crippled version that is otherwise available.

APN Now that you say it, that was obvious!

APN RFE: ability to distinguish between read-only and read-write directories.