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