diff options
Diffstat (limited to 'library/safe.tcl')
| -rw-r--r-- | library/safe.tcl | 48 |
1 files changed, 46 insertions, 2 deletions
diff --git a/library/safe.tcl b/library/safe.tcl index 44def92..3be7739 100644 --- a/library/safe.tcl +++ b/library/safe.tcl @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: safe.tcl,v 1.4 1998/11/11 02:39:31 welch Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.5 1999/04/16 00:46:57 stanton Exp $ # # The implementation is based on namespaces. These naming conventions @@ -22,7 +22,7 @@ # # Needed utilities package -package require opt 0.2; +package require opt 0.4.1; # Create the safe namespace namespace eval ::safe { @@ -440,6 +440,13 @@ proc ::safe::interpAddToAccessPath {slave path} { ::interp alias $slave source {} [namespace current]::AliasSource $slave ::interp alias $slave load {} [namespace current]::AliasLoad $slave + # This alias lets the slave use the encoding names, convertfrom, + # convertto, and system, but not "encoding system <name>" to set + # the system encoding. + + ::interp alias $slave encoding {} [namespace current]::AliasEncoding \ + $slave + # This alias lets the slave have access to a subset of the 'file' # command functionality. @@ -884,4 +891,41 @@ proc ::safe::setLogCmd {args} { [namespace current]::Subset $slave $target $pat } + # AliasEncoding is the target of the "encoding" alias in safe interpreters. + + proc AliasEncoding {slave args} { + + set argc [llength $args]; + + set okpat "^(name.*|convert.*)\$" + set subcommand [lindex $args 0] + + if {[regexp $okpat $subcommand]} { + return [eval ::interp invokehidden $slave encoding $subcommand \ + [lrange $args 1 end]] + } + + if {[string match $subcommand system]} { + if {$argc == 1} { + # passed all the tests , lets source it: + if {[catch {::interp invokehidden \ + $slave encoding system} msg]} { + Log $slave $msg; + return -code error "script error"; + } + } else { + set msg "wrong # args: should be \"encoding system\""; + Log $slave $msg; + error $msg; + } + } else { + set msg "wrong # args: should be \"encoding option ?arg ...?\""; + Log $slave $msg; + error $msg; + } + + + return $msg + } + } |