diff options
| -rw-r--r-- | doc/safe.n | 16 | ||||
| -rw-r--r-- | generic/tclBasic.c | 4 | ||||
| -rw-r--r-- | library/safe.tcl | 46 | ||||
| -rw-r--r-- | tests/safe.test | 71 |
4 files changed, 127 insertions, 10 deletions
@@ -4,7 +4,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.n,v 1.1.2.2 1998/09/24 23:58:36 stanton Exp $ +'\" RCS: @(#) $Id: safe.n,v 1.1.2.3 1999/04/06 00:43:15 redman Exp $ '\" .so man.macros .TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands" @@ -49,7 +49,7 @@ hosting application to any party. .PP The Safe Base allows a master interpreter to create safe, restricted interpreters that contain a set of predefined aliases for the \fBsource\fR, -\fBload\fR, \fBfile\fR and \fBexit\fR commands and +\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and are able to use the auto-loading and package mechanisms. .PP No knowledge of the file system structure is leaked to the @@ -245,6 +245,12 @@ the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR, subcommands. For more details on what these subcommands do see the manual page for the \fBfile\fR command. .TP +\fBencoding\fR ?\fIsubCmd args...\fR? +The \fBenconding\fR alias provides access to a safe subset of the +subcommands of the \fBencoding\fR command; it disallows setting of +the system encoding, but allows all other subcommands including +\fBsystem\fR to check the current encoding. +.TP \fBexit\fR The calling interpreter is deleted and its computation is stopped, but the Tcl process in which this interpreter exists is not terminated. @@ -261,9 +267,9 @@ is to prevent. .PP The commands available in a safe interpreter, in addition to the safe set as defined in \fBinterp\fR manual page, are mediated aliases -for \fBsource\fR, \fBload\fR, \fBexit\fR, and a safe subset of \fBfile\fR. -The safe interpreter can also auto-load code and it can request that -packages be loaded. +for \fBsource\fR, \fBload\fR, \fBexit\fR, and safe subsets of +\fBfile\fR and \fBencoding\fR. The safe interpreter can also auto-load +code and it can request that packages be loaded. .PP Because some of these commands access the local file system, there is a potential for information leakage about its directory structure. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 928cfc6..9605e8b 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -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: tclBasic.c,v 1.1.2.14 1999/04/02 00:54:16 redman Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.1.2.15 1999/04/06 00:43:16 redman Exp $ */ #include "tclInt.h" @@ -80,7 +80,7 @@ static CmdInfo builtInCmds[] = { {"continue", (Tcl_CmdProc *) NULL, Tcl_ContinueObjCmd, TclCompileContinueCmd, 1}, {"encoding", (Tcl_CmdProc *) NULL, Tcl_EncodingObjCmd, - (CompileProc *) NULL, 1}, + (CompileProc *) NULL, 0}, {"error", (Tcl_CmdProc *) NULL, Tcl_ErrorObjCmd, (CompileProc *) NULL, 1}, {"eval", (Tcl_CmdProc *) NULL, Tcl_EvalObjCmd, diff --git a/library/safe.tcl b/library/safe.tcl index 76d4d29..ebc4804 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.1.2.3 1998/12/02 20:08:06 welch Exp $ +# RCS: @(#) $Id: safe.tcl,v 1.1.2.4 1999/04/06 00:43:17 redman Exp $ # # The implementation is based on namespaces. These naming conventions @@ -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 + } + } diff --git a/tests/safe.test b/tests/safe.test index 00723e4..80a7d7e 100644 --- a/tests/safe.test +++ b/tests/safe.test @@ -10,7 +10,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.test,v 1.1.2.7 1999/04/02 22:30:42 hershey Exp $ +# RCS: @(#) $Id: safe.test,v 1.1.2.8 1999/04/06 00:43:17 redman Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -84,7 +84,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} { set l [lsort [a aliases]] safe::interpDelete a set l -} {exit file load source} +} {encoding exit file load source} test safe-3.3 {calling safe::interpCreate on trusted interp} { catch {safe::interpDelete a} safe::interpCreate a @@ -443,6 +443,73 @@ test safe-10.4 {testing nested statics loading / -nestedloadok} { } +test safe-11.1 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding option ?arg ...?"} {}} + +test safe-11.2 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding system cp775} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding system"} {}} + +test safe-11.3 {testing safe encoding} { + set i [safe::interpCreate] + set result [catch { + string match [encoding system] [interp eval $i encoding system] + } msg] + list $result $msg [safe::interpDelete $i] +} {0 1 {}} + +test safe-11.4 {testing safe encoding} { + set i [safe::interpCreate] + set result [catch { + string match [encoding names] [interp eval $i encoding names] + } msg] + list $result $msg [safe::interpDelete $i] +} {0 1 {}} + +test safe-11.5 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \ + $msg \ + [safe::interpDelete $i]; +} {0 foobar {}} + + +test safe-11.6 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertto cp1258 foobar} msg] \ + $msg \ + [safe::interpDelete $i]; +} {0 foobar {}} + +test safe-11.7 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertfrom} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}} + + +test safe-11.8 {testing safe encoding} { + set i [safe::interpCreate] + list \ + [catch {interp eval $i encoding convertto} msg] \ + $msg \ + [safe::interpDelete $i]; +} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}} + + # cleanup ::tcltest::cleanupTests return |