TMG inside SafeTCL
Not logged in

TMG is a line based macro processor implemented in 22 SLOC. The first character of the line determines how to expand it, in particular:

  1. @ - its just plain code, like a foreach loop, e.g. @foreach i {1 2 3} {
  2. $ - just expand any variables using, e.g. $ and I is $i
  3. ! - expand both variables and commands, e.g. ! \expr sin($i)\
  4. Anything else is just a literal line

The implementation is:

proc tmg {s} {
  set prog {}
  set ::_out {} 
  foreach line [split $s \n] {
    if {[regexp {^[@](.*)} $line -> rest]} {
      append prog $rest \n
    } elseif {[regexp {^[$](.*)} $line -> rest]} {
      append prog "append _out \[subst -nocommands -nobackslashes [list $rest]\] \\n" \n
    } elseif {[regexp {^[!](.*)} $line -> rest]} {
      append prog "append _out \[subst [list $rest]\] \\n" \n
    } else {
      append prog "append _out [list $line] \\n" \n
    }
  }
  if {[catch [list uplevel #0 $prog] r]} {
    puts "$prog failed $r $::errorInfo"
    return ""
  } else { 
    return $r
  }
}

SafeTCL lets us run code with a limited set of commands so if we combine it TMG we can build code and data in a moderately secure way.

proc safetcl {code {name {}}} {
  set si [interp create -safe]
  if {$name != ""} {
    interp eval $si [list set name $name]
  }
  foreach c [info commands {[%*=?!]*}] {
    interp alias $si $c {} $c
  }
  foreach c {puts verbose check check_never exit} {
    interp alias $si $c {} $c
  }
  set r [interp eval $si $code]
  interp delete $si
  return $r
}