Tcl Source Code

'\"
'\" 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
application or user from temporarily using the computer to perform
useful work, for example by consuming all available CPU time or
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.

 * 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,

# 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
    }

}

# safe.test --
#
# This file contains a collection of tests for safe Tcl, packages loading,
# and using safe interpreters. Sourcing this file into tcl runs the tests
# and generates output for errors.  No output means no errors were found.
#
# 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