Tcl Source Code

Check-in [4307ae7c2a]
Login
Core Home Timeline Branches Tags Tickets Wiki Clone or Download
Bounty program for improvements to Tcl and certain Tcl packages.

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 Unified Diffs Ignore Whitespace Patch

Changes to doc/safe.n. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
...
241
242
243
244
245
246
247






248
249
250
251
252
253
254
...
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" 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 $
'\" 
.so man.macros
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Safe\ Base \- A mechanism for creating and manipulating safe interpreters.
................................................................................
scripts are prevented from corrupting the state of the hosting
application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
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
are able to use the auto-loading and package mechanisms.
.PP
No knowledge of the file system structure is leaked to the
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
master interpreter transparently 
................................................................................
\fBfile\fR ?\fIsubCmd args...\fR?
The \fBfile\fR alias provides access to a safe subset of the subcommands of
the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR,
\fBextension\fR, \fBroot\fR, \fBtail\fR, \fBpathname\fR and \fBsplit\fR
subcommands. For more details on what these subcommands do see the manual
page for the \fBfile\fR command.
.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.

.SH SECURITY
The Safe Base does not attempt to completely prevent annoyance and
denial of service attacks. These forms of attack prevent the
................................................................................
all available screen real estate.
These attacks, while aggravating, are deemed to be of lesser importance
in general than integrity and privacy attacks that the Safe Base
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.
.PP
Because some of these commands access the local file system, there is a
potential for information leakage about its directory structure.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
e.g., source a file is mediated by the master interpreter.






|







 







|







 







>
>
>
>
>
>







 







|
|
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
..
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
...
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279

'\"
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\"
'\" 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.3 1999/04/06 00:43:15 redman Exp $
'\" 
.so man.macros
.TH "Safe Tcl" n 8.0 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
Safe\ Base \- A mechanism for creating and manipulating safe interpreters.
................................................................................
scripts are prevented from corrupting the state of the hosting
application or computer. Untrusted scripts are also prevented from
disclosing information stored on the hosting computer or in the
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, \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
safe interpreter, because it has access only to a virtualized path
containing tokens. When the safe interpreter requests to source a file, it
uses the token in the virtual path as part of the file name to source; the
master interpreter transparently 
................................................................................
\fBfile\fR ?\fIsubCmd args...\fR?
The \fBfile\fR alias provides access to a safe subset of the subcommands of
the \fBfile\fR command; it allows only \fBdirname\fR, \fBjoin\fR,
\fBextension\fR, \fBroot\fR, \fBtail\fR, \fBpathname\fR and \fBsplit\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.

.SH SECURITY
The Safe Base does not attempt to completely prevent annoyance and
denial of service attacks. These forms of attack prevent the
................................................................................
all available screen real estate.
These attacks, while aggravating, are deemed to be of lesser importance
in general than integrity and privacy attacks that the Safe Base
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 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.
To prevent this, commands that take file names as arguments in a safe
interpreter use tokens instead of the real directory names.
These tokens are translated to the real directory name while a request to,
e.g., source a file is mediated by the master interpreter.

Changes to generic/tclBasic.c. 

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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 $
 */

#include "tclInt.h"
#include "tclCompile.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif
................................................................................
    {"clock",		(Tcl_CmdProc *) NULL,	Tcl_ClockObjCmd,
        (CompileProc *) NULL,		1},
    {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
        (CompileProc *) NULL,		1},
    {"continue",	(Tcl_CmdProc *) NULL,	Tcl_ContinueObjCmd,
        TclCompileContinueCmd,		1},
    {"encoding",	(Tcl_CmdProc *) NULL,	Tcl_EncodingObjCmd,
        (CompileProc *) NULL,		1},
    {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
        (CompileProc *) NULL,		1},
    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
        (CompileProc *) NULL,		1},
    {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
        (CompileProc *) NULL,		0},
    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,







|







 







|








8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90

 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.15 1999/04/06 00:43:16 redman Exp $
 */

#include "tclInt.h"
#include "tclCompile.h"
#ifndef TCL_GENERIC_ONLY
#   include "tclPort.h"
#endif
................................................................................
    {"clock",		(Tcl_CmdProc *) NULL,	Tcl_ClockObjCmd,
        (CompileProc *) NULL,		1},
    {"concat",		(Tcl_CmdProc *) NULL,	Tcl_ConcatObjCmd,
        (CompileProc *) NULL,		1},
    {"continue",	(Tcl_CmdProc *) NULL,	Tcl_ContinueObjCmd,
        TclCompileContinueCmd,		1},
    {"encoding",	(Tcl_CmdProc *) NULL,	Tcl_EncodingObjCmd,
        (CompileProc *) NULL,		0},
    {"error",		(Tcl_CmdProc *) NULL,	Tcl_ErrorObjCmd,
        (CompileProc *) NULL,		1},
    {"eval",		(Tcl_CmdProc *) NULL,	Tcl_EvalObjCmd,
        (CompileProc *) NULL,		1},
    {"exit",		(Tcl_CmdProc *) NULL,	Tcl_ExitObjCmd,
        (CompileProc *) NULL,		0},
    {"expr",		(Tcl_CmdProc *) NULL,	Tcl_ExprObjCmd,

Changes to library/safe.tcl. 

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
435
436
437
438
439
440
441







442
443
444
445
446
447
448
...
879
880
881
882
883
884
885
886

887





































# See the safe.n man page for details.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
#
# 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 $

#
# The implementation is based on namespaces. These naming conventions
# are followed:
# Private procs starts with uppercase.
# Public  procs are exported and starts with lowercase
#
................................................................................

	# These aliases let the slave load files to define new commands

	# NB we need to add [namespace current], aliases are always
	# absolute paths.
	::interp alias $slave source {} [namespace current]::AliasSource $slave
	::interp alias $slave load {} [namespace current]::AliasLoad $slave








	# This alias lets the slave have access to a subset of the 'file'
	# command functionality.

	AliasSubset $slave file file dir.* join root.* ext.* tail \
		path.* split

................................................................................
	    append pat $sep$sub
	    set sep |
	}
	append pat )\$
	::interp alias $slave $alias {}\
		[namespace current]::Subset $slave $target $pat
    }


}











































|







 







>
>
>
>
>
>
>







 








>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931

# See the safe.n man page for details.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
#
# 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.4 1999/04/06 00:43:17 redman Exp $

#
# The implementation is based on namespaces. These naming conventions
# are followed:
# Private procs starts with uppercase.
# Public  procs are exported and starts with lowercase
#
................................................................................

	# These aliases let the slave load files to define new commands

	# NB we need to add [namespace current], aliases are always
	# absolute paths.
	::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.

	AliasSubset $slave file file dir.* join root.* ext.* tail \
		path.* split

................................................................................
	    append pat $sep$sub
	    set sep |
	}
	append pat )\$
	::interp alias $slave $alias {}\
		[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
    }

}

Changes to tests/safe.test. 

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
...
438
439
440
441
442
443
444



































































445
446
447
448
449
450
451

#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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 $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [interp slaves] {
  interp delete $i
................................................................................
} {invalid command name "exec"}
test safe-3.2 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    set l [lsort [a aliases]]
    safe::interpDelete a
    set l
} {exit file load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    set x [interp eval a {source [file join $tcl_library init.tcl]}]
    safe::interpDelete a
    set x
} ""
................................................................................
	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
	    $msg \
            [safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}


}




































































# cleanup
::tcltest::cleanupTests
return










|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
..
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518

#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# 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.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]
}

foreach i [interp slaves] {
  interp delete $i
................................................................................
} {invalid command name "exec"}
test safe-3.2 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    set l [lsort [a aliases]]
    safe::interpDelete a
    set l
} {encoding exit file load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} {
    catch {safe::interpDelete a}
    safe::interpCreate a
    set x [interp eval a {source [file join $tcl_library init.tcl]}]
    safe::interpDelete a
    set x
} ""
................................................................................
	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
	    $msg \
            [safe::interpDelete $i];
} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}


}

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

This page was generated in about 0.119s by Fossil 2.10 [eb804dc674] 2019-09-19 14:14:14