tcl/tk safe - 4 - 范例

 下面贴上几个关于safe policy的例子

Example 1.

# Policy parameters:
#  directory is the location for the files
#  maxfile is the number of files allowed in the directory
#  maxsize is the max size for any single file.

array set tempfile {
   maxfile       4
   maxsize       65536
   directory ./
}
# tempfile(directory) is computed dynamically based on
# the source of the script

proc Tempfile_PolicyInit { slave } {
    global tempfile
    interp alias $slave open {} TempfileOpenAlias $slave $tempfile(directory) $tempfile(maxfile) "1.tcl"
    interp eval p open
    interp alias $slave puts {} TempfilePutsAlias $slave tempfile(maxsize) $tempfile(channels,$slave)
    interp alias $slave exit {} TempfileExitAlias $slave
}



proc TempfileOpenAlias { slave dir maxfile name { m w } { p 0777 } } {
    global tempfile
    # remove sneaky characters
    regsub -all {|/:} [file tail $name] {} real
    set real [file join $dir $real]
    # Limit the number of files
    set files [ glob -nocomplain [file join $dir *] ]
    set N [ llength $files ]

    if { ( $N >= $maxfile ) && ( [ lsearch -exact $files $real ] < 0 ) } {
        error "permission denied"
    }
    if [ catch { open $real $m $p } out ] {
        return -code error "$name: permission denied"
    }
    lappend tempfile(channels,$slave) $out
    interp share {} $out $slave
    return $out
}

proc TempfileExitAlias { slave } {
    global tempfile
    interp delete $slave
    if [info exists tempfile(channels,$slave)] {
        foreach out $tempfile(channels,$slave) {
            catch { close $out }
        }
        unset tempfile(channels,$slave)
    }
}

# See also the puts alias in Example 24–4 on page 389
proc TempfilePutsAlias { slave max chan args } {
    # max is the file size limit, in bytes
    # chan is the I/O channel
    # args is either a single string argument,
    # or the -nonewline flag plus the string.

    if { [ llength $args ] > 2} {
        error "invalid arguments"
    }
    if { [ llength $args ] == 2 } {
        if { ![ string match -n* [ lindex $args 0 ] ] } {
            error "invalid arguments"
        }
        set str [ lindex $args 1 ]
    } else {
        set str [ lindex $args 0 ]n
    }
    set size [ expr [ tell $chan ] + [ string length $str ] ]
    if { $size > $max } {
        error "File size exceeded"
    } else {
        puts -nonewline $chan $str
    }
}

safe::interpCreate p
Tempfile_PolicyInit p

interp eval p puts 1234

    interp eval p exit

本例子通过在{}解释器空间中创建一个I/O通道,并共享此I/O通道的方式在子解释器p中使用I/O，在子解释器调用的puts命令中对写入文件的大小做了限制

Example 2.

array set tempfile {
   maxfile    4
   maxsize    65536
   directory    ./
}

proc Tempfile_PolicyInit { slave } {
    global tempfile
    interp alias $slave open {} TempfileOpenAlias $slave $tempfile(directory) $tempfile(maxfile) "1.tcl"
    interp eval p open
    interp hide $slave tell
    interp alias $slave tell {} TempfileTellAlias $slave $tempfile(channels,$slave)
    interp hide $slave puts
    interp alias $slave puts {} TempfilePutsAlias $slave $tempfile(maxsize) $tempfile(channels,$slave)
#    interp alias $slave exit {} TempfileExitAlias $slave
}

proc TempfileOpenAlias { slave dir maxfile name { m w } { p 0777 } } {
    global tempfile
    # remove sneaky characters
    regsub -all {|/:} [ file tail $name ] {} real
    set real [ file join $dir $real ]
    # Limit the number of files
    set files [ glob -nocomplain [ file join $dir * ] ]
    set N [ llength $files ]
    if { ( $N >= $maxfile ) && ( [ lsearch -exact $files $real ] < 0 ) } {
        error "permission denied"
    }
    if [ catch { interp invokehidden $slave open $real $m $p } out ] {
        return -code error "$name: permission denied"
    }
    lappend tempfile(channels,$slave) $out
    return $out
}

proc TempfileTellAlias { slave chan } {
    return [ interp invokehidden $slave tell $chan ]
}

proc TempfilePutsAlias { slave max chan args } {
    if { [ llength $args ] > 2 } {
        error "invalid arguments"
    }
    if { [ llength $args ] == 2 } {
        if { ![ string match -n* [ lindex $args 0 ] ] } {
            error "invalid arguments"
        }
        set string [lindex $args 1]
    } else {
        set string [lindex $args 0]n
    }
    set size [ interp invokehidden $slave tell $chan ]
    incr size [ string length $string ]
    if { $size > $max } {
        error "File size exceeded"
    } else {
        interp invokehidden $slave puts -nonewline $chan $string
    }
}

proc TempfileExitAlias { slave } {
    global tempfile
    interp delete $slave
    if [info exists tempfile(channels,$slave)] {
        foreach out $tempfile(channels,$slave) {
            catch { close $out }
        }
        unset tempfile(channels,$slave)
    }
}

safe::interpCreate p
Tempfile_PolicyInit p

本例子通过在子解释器中调用隐藏的命令来实现I/O

Example 3.

# SafeAfter_PolicyInit creates a child witha safe after command

proc SafeAfter_PolicyInit { slave max } {
    # max limits the number of outstanding after events
    global after
    interp alias $slave after {} SafeAfterAlias $slave $max
    interp alias $slave exit {} SafeAfterExitAlias $slave
    # This is used to generate after IDs for the slave.
    set after(id,$slave) 0
}

# SafeAfterAlias is an alias for after. It disallows after with only a time argument and no command.
proc SafeAfterAlias { slave max args } {
    global after
    set argc [ llength $args ]
    if { $argc == 0 } {
        error "Usage: after option args"
    }
    switch -- [ lindex $args 0 ] {
        cancel {
            # A naive implementation would just eval after cancel $args but something dangerous could be hiding in args.
            set myid [ lindex $args 1 ]
            if { [ info exists after(id,$slave,$myid) ] } {
                set id $after(id,$slave,$myid)
                unset after(id,$slave,$myid)
                after cancel $id
            }
            return ""
        }
        default {
            if { $argc == 1 } {
                error "Usage: after time command args..."
            }
            if { [ llength [ array names after id,$slave,* ] ] >= $max } {
                error "Too many after events"
            }
            # Maintain concat semantics
            set command [concat [ lrange $args 1 end ] ]
            # Compute our own id to pass the callback.

            # after(id,$slave)=0

            set myid after#[ incr after(id,$slave) ]
            set id [ after [ lindex $args 0 ] [ list SafeAfterCallback $slave $myid $command ] ]
            set after(id,$slave,$myid) $id
            return $myid
        }
    }
}

# SafeAfterCallback is the after callback in the master.
# It evaluates its command in the safe interpreter.
proc SafeAfterCallback { slave myid cmd } {
    global after
    unset after(id,$slave,$myid)
    if [ catch { interp eval $slave $cmd } err ] {
        catch { interp eval $slave bgerror $error }
        puts $error
    }
}

# SafeAfterExitAlias is an alias for exit that does cleanup.
proc SafeAfterExitAlias { slave } {
    global after
    foreach id [ array names after id,$slave,* ] {
        after cancel $after($id)
        unset after($id)
    }
    interp delete $slave
}

safe::interpCreate p
SafeAfter_PolicyInit p 4

after command policy