Tcl Source Code

Check-in [4307ae7c2a]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make a safe alias for the "encoding" command which disables setting of the system encoding using "encoding system <name>" but allows all other uses of the command. Updated safe.test to check the encoding alias. Updated manpage.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-1-branch-old
Files: files | file ages | folders
SHA1: 4307ae7c2ae0b2ac736045b7e0d03a1240efe3a5
User & Date: redman 1999-04-06 00:43:15
Context
1999-04-06
00:46
Make encoding safe. check-in: 924005ef03 user: redman tags: core-8-1-branch-old
00:43
Make a safe alias for the "encoding" command which disables setting of the system encoding using "en... check-in: 4307ae7c2a user: redman tags: core-8-1-branch-old
00:29
*** empty log message *** check-in: fc67f5b576 user: stanton tags: core-8-1-branch-old
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to doc/safe.n.

     1      1   '\"
     2      2   '\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
     3      3   '\"
     4      4   '\" See the file "license.terms" for information on usage and redistribution
     5      5   '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     6      6   '\" 
     7         -'\" RCS: @(#) $Id: safe.n,v 1.1.2.2 1998/09/24 23:58:36 stanton Exp $
            7  +'\" RCS: @(#) $Id: safe.n,v 1.1.2.3 1999/04/06 00:43:15 redman Exp $
     8      8   '\" 
     9      9   .so man.macros
    10     10   .TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
    11     11   .BS
    12     12   '\" Note:  do not modify the .SH NAME line immediately below!
    13     13   .SH NAME
    14     14   Safe\ Base \- A mechanism for creating and manipulating safe interpreters.
................................................................................
    45     45   scripts are prevented from corrupting the state of the hosting
    46     46   application or computer. Untrusted scripts are also prevented from
    47     47   disclosing information stored on the hosting computer or in the
    48     48   hosting application to any party.
    49     49   .PP
    50     50   The Safe Base allows a master interpreter to create safe, restricted
    51     51   interpreters that contain a set of predefined aliases for the \fBsource\fR,
    52         -\fBload\fR, \fBfile\fR and \fBexit\fR commands and
           52  +\fBload\fR, \fBfile\fR, \fBencoding\fR, and \fBexit\fR commands and
    53     53   are able to use the auto-loading and package mechanisms.
    54     54   .PP
    55     55   No knowledge of the file system structure is leaked to the
    56     56   safe interpreter, because it has access only to a virtualized path
    57     57   containing tokens. When the safe interpreter requests to source a file, it
    58     58   uses the token in the virtual path as part of the file name to source; the
    59     59   master interpreter transparently 
................................................................................
   241    241   \fBfile\fR ?\fIsubCmd args...\fR?
   242    242   The \fBfile\fR alias provides access to a safe subset of the subcommands of
   243    243   the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR,
   244    244   \fBextension\fR, \fBroot\fR, \fBtail\fR, \fBpathname\fR and \fBsplit\fR
   245    245   subcommands. For more details on what these subcommands do see the manual
   246    246   page for the \fBfile\fR command.
   247    247   .TP
          248  +\fBencoding\fR ?\fIsubCmd args...\fR?
          249  +The \fBenconding\fR alias provides access to a safe subset of the
          250  +subcommands of the \fBencoding\fR command;  it disallows setting of
          251  +the system encoding, but allows all other subcommands including
          252  +\fBsystem\fR to check the current encoding.
          253  +.TP
   248    254   \fBexit\fR
   249    255   The calling interpreter is deleted and its computation is stopped, but the
   250    256   Tcl process in which this interpreter exists is not terminated.
   251    257   
   252    258   .SH SECURITY
   253    259   The Safe Base does not attempt to completely prevent annoyance and
   254    260   denial of service attacks. These forms of attack prevent the
................................................................................
   257    263   all available screen real estate.
   258    264   These attacks, while aggravating, are deemed to be of lesser importance
   259    265   in general than integrity and privacy attacks that the Safe Base
   260    266   is to prevent.
   261    267   .PP
   262    268   The commands available in a safe interpreter, in addition to
   263    269   the safe set as defined in \fBinterp\fR manual page, are mediated aliases
   264         -for \fBsource\fR, \fBload\fR, \fBexit\fR, and a safe subset of \fBfile\fR.
   265         -The safe interpreter can also auto-load code and it can request that
   266         -packages be loaded.
          270  +for \fBsource\fR, \fBload\fR, \fBexit\fR, and safe subsets of
          271  +\fBfile\fR and \fBencoding\fR. The safe interpreter can also auto-load
          272  +code and it can request that packages be loaded.
   267    273   .PP
   268    274   Because some of these commands access the local file system, there is a
   269    275   potential for information leakage about its directory structure.
   270    276   To prevent this, commands that take file names as arguments in a safe
   271    277   interpreter use tokens instead of the real directory names.
   272    278   These tokens are translated to the real directory name while a request to,
   273    279   e.g., source a file is mediated by the master interpreter.

Changes to generic/tclBasic.c.

     8      8    * Copyright (c) 1987-1994 The Regents of the University of California.
     9      9    * Copyright (c) 1994-1997 Sun Microsystems, Inc.
    10     10    * Copyright (c) 1998-1999 by Scriptics Corporation.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution
    13     13    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15         - * RCS: @(#) $Id: tclBasic.c,v 1.1.2.14 1999/04/02 00:54:16 redman Exp $
           15  + * RCS: @(#) $Id: tclBasic.c,v 1.1.2.15 1999/04/06 00:43:16 redman Exp $
    16     16    */
    17     17   
    18     18   #include "tclInt.h"
    19     19   #include "tclCompile.h"
    20     20   #ifndef TCL_GENERIC_ONLY
    21     21   #   include "tclPort.h"
    22     22   #endif
................................................................................
    76     76       {"clock",		(Tcl_CmdProc *) NULL,	Tcl_ClockObjCmd,
    77     77           (CompileProc *) NULL,		1},
    78     78       {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
    79     79           (CompileProc *) NULL,		1},
    80     80       {"continue",	(Tcl_CmdProc *) NULL,	Tcl_ContinueObjCmd,
    81     81           TclCompileContinueCmd,		1},
    82     82       {"encoding",	(Tcl_CmdProc *) NULL,	Tcl_EncodingObjCmd,
    83         -        (CompileProc *) NULL,		1},
           83  +        (CompileProc *) NULL,		0},
    84     84       {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
    85     85           (CompileProc *) NULL,		1},
    86     86       {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
    87     87           (CompileProc *) NULL,		1},
    88     88       {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
    89     89           (CompileProc *) NULL,		0},
    90     90       {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,

Changes to library/safe.tcl.

     8      8   # See the safe.n man page for details.
     9      9   #
    10     10   # Copyright (c) 1996-1997 Sun Microsystems, Inc.
    11     11   #
    12     12   # See the file "license.terms" for information on usage and redistribution
    13     13   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14   #
    15         -# RCS: @(#) $Id: safe.tcl,v 1.1.2.3 1998/12/02 20:08:06 welch Exp $
           15  +# RCS: @(#) $Id: safe.tcl,v 1.1.2.4 1999/04/06 00:43:17 redman Exp $
    16     16   
    17     17   #
    18     18   # The implementation is based on namespaces. These naming conventions
    19     19   # are followed:
    20     20   # Private procs starts with uppercase.
    21     21   # Public  procs are exported and starts with lowercase
    22     22   #
................................................................................
   435    435   
   436    436   	# These aliases let the slave load files to define new commands
   437    437   
   438    438   	# NB we need to add [namespace current], aliases are always
   439    439   	# absolute paths.
   440    440   	::interp alias $slave source {} [namespace current]::AliasSource $slave
   441    441   	::interp alias $slave load {} [namespace current]::AliasLoad $slave
          442  +
          443  +	# This alias lets the slave use the encoding names, convertfrom,
          444  +	# convertto, and system, but not "encoding system <name>" to set
          445  +	# the system encoding.
          446  +
          447  +	::interp alias $slave encoding {} [namespace current]::AliasEncoding \
          448  +		$slave
   442    449   
   443    450   	# This alias lets the slave have access to a subset of the 'file'
   444    451   	# command functionality.
   445    452   
   446    453   	AliasSubset $slave file file dir.* join root.* ext.* tail \
   447    454   		path.* split
   448    455   
................................................................................
   879    886   	    append pat $sep$sub
   880    887   	    set sep |
   881    888   	}
   882    889   	append pat )\$
   883    890   	::interp alias $slave $alias {}\
   884    891   		[namespace current]::Subset $slave $target $pat
   885    892       }
          893  +
          894  +    # AliasEncoding is the target of the "encoding" alias in safe interpreters.
          895  +
          896  +    proc AliasEncoding {slave args} {
          897  +
          898  +	set argc [llength $args];
          899  +
          900  +	set okpat "^(name.*|convert.*)\$"
          901  +	set subcommand [lindex $args 0]
          902  +
          903  +	if {[regexp $okpat $subcommand]} {
          904  +	    return [eval ::interp invokehidden $slave encoding $subcommand \
          905  +		    [lrange $args 1 end]]
          906  +	}
          907  +
          908  +	if {[string match $subcommand system]} {
          909  +	    if {$argc == 1} {
          910  +		# passed all the tests , lets source it:
          911  +		if {[catch {::interp invokehidden \
          912  +			$slave encoding system} msg]} {
          913  +		    Log $slave $msg;
          914  +		    return -code error "script error";
          915  +		}
          916  +	    } else {
          917  +		set msg "wrong # args: should be \"encoding system\"";
          918  +		Log $slave $msg;
          919  +		error $msg;
          920  +	    }
          921  +	} else {
          922  +	    set msg "wrong # args: should be \"encoding option ?arg ...?\"";
          923  +	    Log $slave $msg;
          924  +	    error $msg;
          925  +	}
          926  +	
          927  +	
          928  +	return $msg
          929  +    }
   886    930   
   887    931   }

Changes to tests/safe.test.

     6      6   #
     7      7   # Copyright (c) 1995-1996 Sun Microsystems, Inc.
     8      8   # Copyright (c) 1998-1999 by Scriptics Corporation.
     9      9   #
    10     10   # See the file "license.terms" for information on usage and redistribution
    11     11   # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    12     12   #
    13         -# RCS: @(#) $Id: safe.test,v 1.1.2.7 1999/04/02 22:30:42 hershey Exp $
           13  +# RCS: @(#) $Id: safe.test,v 1.1.2.8 1999/04/06 00:43:17 redman Exp $
    14     14   
    15     15   if {[lsearch [namespace children] ::tcltest] == -1} {
    16     16       source [file join [pwd] [file dirname [info script]] defs.tcl]
    17     17   }
    18     18   
    19     19   foreach i [interp slaves] {
    20     20     interp delete $i
................................................................................
    80     80   } {invalid command name "exec"}
    81     81   test safe-3.2 {calling safe::interpCreate on trusted interp} {
    82     82       catch {safe::interpDelete a}
    83     83       safe::interpCreate a
    84     84       set l [lsort [a aliases]]
    85     85       safe::interpDelete a
    86     86       set l
    87         -} {exit file load source}
           87  +} {encoding exit file load source}
    88     88   test safe-3.3 {calling safe::interpCreate on trusted interp} {
    89     89       catch {safe::interpDelete a}
    90     90       safe::interpCreate a
    91     91       set x [interp eval a {source [file join $tcl_library init.tcl]}]
    92     92       safe::interpDelete a
    93     93       set x
    94     94   } ""
................................................................................
   438    438   	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
   439    439   	    $msg \
   440    440               [safe::interpDelete $i];
   441    441   } {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
   442    442   
   443    443   
   444    444   }
          445  +
          446  +test safe-11.1 {testing safe encoding} {
          447  +    set i [safe::interpCreate]
          448  +    list \
          449  +	    [catch {interp eval $i encoding} msg] \
          450  +	    $msg \
          451  +	    [safe::interpDelete $i];
          452  +} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
          453  +
          454  +test safe-11.2 {testing safe encoding} {
          455  +    set i [safe::interpCreate]
          456  +    list \
          457  +	    [catch {interp eval $i encoding system cp775} msg] \
          458  +	    $msg \
          459  +	    [safe::interpDelete $i];
          460  +} {1 {wrong # args: should be "encoding system"} {}}
          461  +
          462  +test safe-11.3 {testing safe encoding} {
          463  +    set i [safe::interpCreate]
          464  +    set result [catch {
          465  +	string match [encoding system] [interp eval $i encoding system]
          466  +    } msg]
          467  +    list $result $msg [safe::interpDelete $i]
          468  +} {0 1 {}}
          469  +
          470  +test safe-11.4 {testing safe encoding} {
          471  +    set i [safe::interpCreate]
          472  +    set result [catch {
          473  +	string match [encoding names] [interp eval $i encoding names]
          474  +    } msg]
          475  +    list $result $msg  [safe::interpDelete $i]
          476  +} {0 1 {}}
          477  +
          478  +test safe-11.5 {testing safe encoding} {
          479  +    set i [safe::interpCreate]
          480  +    list \
          481  +	    [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
          482  +	    $msg \
          483  +	    [safe::interpDelete $i];
          484  +} {0 foobar {}}
          485  +
          486  +
          487  +test safe-11.6 {testing safe encoding} {
          488  +    set i [safe::interpCreate]
          489  +    list \
          490  +	    [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
          491  +	    $msg \
          492  +	    [safe::interpDelete $i];
          493  +} {0 foobar {}}
          494  +
          495  +test safe-11.7 {testing safe encoding} {
          496  +    set i [safe::interpCreate]
          497  +    list \
          498  +	    [catch {interp eval $i encoding convertfrom} msg] \
          499  +	    $msg \
          500  +	    [safe::interpDelete $i];
          501  +} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
          502  +
          503  +
          504  +test safe-11.8 {testing safe encoding} {
          505  +    set i [safe::interpCreate]
          506  +    list \
          507  +	    [catch {interp eval $i encoding convertto} msg] \
          508  +	    $msg \
          509  +	    [safe::interpDelete $i];
          510  +} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
          511  +
   445    512   
   446    513   # cleanup
   447    514   ::tcltest::cleanupTests
   448    515   return
   449    516   
   450    517   
   451    518