3 use vars qw($VERSION @ISA @EXPORT_OK);
9 @ISA = qw(Exporter DynaLoader);
10 @EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname opdesc
11 MAXO emptymask fullmask);
15 Safe - Safe extension module for Perl
19 The Safe extension module allows the creation of compartments
20 in which perl code can be evaluated. Each compartment has
26 The "root" of the namespace (i.e. "main::") is changed to a
27 different package and code evaluated in the compartment cannot
28 refer to variables outside this namespace, even with run-time
29 glob lookups and other tricks. Code which is compiled outside
30 the compartment can choose to place variables into (or share
31 variables with) the compartment's namespace and only that
32 data will be visible to code evaluated in the compartment.
34 By default, the only variables shared with compartments are the
35 "underscore" variables $_ and @_ (and, technically, the much less
36 frequently used %_, the _ filehandle and so on). This is because
37 otherwise perl operators which default to $_ will not work and neither
38 will the assignment of arguments to @_ on subroutine entry.
40 =item an operator mask
42 Each compartment has an associated "operator mask". Recall that
43 perl code is compiled into an internal format before execution.
44 Evaluating perl code (e.g. via "eval" or "do 'file'") causes
45 the code to be compiled into an internal format and then,
46 provided there was no error in the compilation, executed.
47 Code evaulated in a compartment compiles subject to the
48 compartment's operator mask. Attempting to evaulate code in a
49 compartment which contains a masked operator will cause the
50 compilation to fail with an error. The code will not be executed.
52 By default, the operator mask for a newly created compartment masks
53 out all operations which give "access to the system" in some sense.
54 This includes masking off operators such as I<system>, I<open>,
55 I<chown>, and I<shmget> but does not mask off operators such as
56 I<print>, I<sysread> and I<E<lt>HANDLE<gt>>. Those file operators
57 are allowed since for the code in the compartment to have access
58 to a filehandle, the code outside the compartment must have explicitly
59 placed the filehandle variable inside the compartment.
61 Since it is only at the compilation stage that the operator mask
62 applies, controlled access to potentially unsafe operations can
63 be achieved by having a handle to a wrapper subroutine (written
64 outside the compartment) placed into the compartment. For example,
68 # vet arguments and perform potentially unsafe operations
70 $cpt->share('&wrapper');
76 An operator mask exists at user-level as a string of bytes of length
77 MAXO, each of which is either 0x00 or 0x01. Here, MAXO is the number
78 of operators in the current version of perl. The subroutine MAXO()
79 (available for export by package Safe) returns the number of operators
80 in the current version of perl. Note that, unlike the beta versions of
81 the Safe extension, this is a reliable count of the number of
82 operators in the currently running perl executable. The presence of a
83 0x01 byte at offset B<n> of the string indicates that operator number
84 B<n> should be masked (i.e. disallowed). The Safe extension makes
85 available routines for converting from operator names to operator
86 numbers (and I<vice versa>) and for converting from a list of operator
87 names to the corresponding mask (and I<vice versa>).
89 =head2 Methods in class Safe
91 To create a new compartment, use
95 Optional arguments are (NAMESPACE, MASK), where
101 is the root namespace to use for the compartment (defaults to
102 "Safe::Root000000000", auto-incremented for each new compartment); and
106 is the operator mask to use (defaults to a fairly restrictive set).
110 The following methods can then be used on the compartment
111 object returned by the above constructor. The object argument
112 is implicit in each case.
116 =item root (NAMESPACE)
118 This is a get-or-set method for the compartment's namespace. With the
119 NAMESPACE argument present, it sets the root namespace for the
120 compartment. With no NAMESPACE argument present, it returns the
121 current root namespace of the compartment.
125 This is a get-or-set method for the compartment's operator mask.
126 With the MASK argument present, it sets the operator mask for the
127 compartment. With no MASK argument present, it returns the
128 current operator mask of the compartment.
132 This sets bits in the compartment's operator mask corresponding
133 to each operator named in the list of arguments. Each OP can be
134 either the name of an operation or its number. See opcode.h or
135 opcode.pl in the main perl distribution for a canonical list of
138 =item untrap (OP, ...)
140 This resets bits in the compartment's operator mask corresponding
141 to each operator named in the list of arguments. Each OP can be
142 either the name of an operation or its number. See opcode.h or
143 opcode.pl in the main perl distribution for a canonical list of
146 =item share (VARNAME, ...)
148 This shares the variable(s) in the argument list with the compartment.
149 Each VARNAME must be the B<name> of a variable with a leading type
150 identifier included. Examples of legal variable names are '$foo' for
151 a scalar, '@foo' for an array, '%foo' for a hash, '&foo' for a
152 subroutine and '*foo' for a glob (i.e. all symbol table entries
153 associated with "foo", including scalar, array, hash, sub and filehandle).
155 =item varglob (VARNAME)
157 This returns a glob for the symbol table entry of VARNAME in the package
158 of the compartment. VARNAME must be the B<name> of a variable without
159 any leading type marker. For example,
161 $cpt = new Safe 'Root';
162 $Root::foo = "Hello world";
163 # Equivalent version which doesn't need to know $cpt's package name:
164 ${$cpt->varglob('foo')} = "Hello world";
169 This evaluates STRING as perl code inside the compartment. The code
170 can only see the compartment's namespace (as returned by the B<root>
171 method). Any attempt by code in STRING to use an operator which is
172 in the compartment's mask will cause an error (at run-time of the
173 main program but at compile-time for the code in STRING). The error
174 is of the form "%s trapped by operation mask operation...". If an
175 operation is trapped in this way, then the code in STRING will not
176 be executed. If such a trapped operation occurs or any other
177 compile-time or return error, then $@ is set to the error message,
178 just as with an eval(). If there is no error, then the method returns
179 the value of the last expression evaluated, or a return statement may
180 be used, just as with subroutines and B<eval()>. Note that this
181 behaviour differs from the beta distribution of the Safe extension
182 where earlier versions of perl made it hard to mimic the return
183 behaviour of the eval() command.
187 This evaluates the contents of file FILENAME inside the compartment.
188 See above documentation on the B<reval> method for further details.
192 =head2 Subroutines in package Safe
194 The Safe package contains subroutines for manipulating operator
195 names and operator masks. All are available for export by the package.
196 The canonical list of operator names is the contents of the array
197 op_name defined and initialised in file F<opcode.h> of the Perl
202 =item ops_to_mask (OP, ...)
204 This takes a list of operator names and returns an operator mask
205 with precisely those operators masked.
207 =item mask_to_ops (MASK)
209 This takes an operator mask and returns a list of operator names
210 corresponding to those operators which are masked in MASK.
212 =item opcode (OP, ...)
214 This takes a list of operator names and returns the corresponding
215 list of opcodes (which can then be used as byte offsets into a mask).
217 =item opname (OP, ...)
219 This takes a list of opcodes and returns the corresponding list of
224 This just returns a mask which has all operators masked.
225 It returns the string "\1" x MAXO().
229 This just returns a mask which has all operators unmasked.
230 It returns the string "\0" x MAXO(). This is useful if you
231 want a compartment to make use of the namespace protection
232 features but do not want the default restrictive mask.
236 This returns the number of operators (and hence the length of an
237 operator mask). Note that, unlike the beta distributions of the
238 Safe extension, this is derived from a genuine integer variable
239 in the perl executable and not from a preprocessor constant.
240 This means that the Safe extension is more robust in the presence
241 of mismatched versions of the perl executable and the Safe extension.
245 This returns the operator mask which is actually in effect at the
246 time the invocation to the subroutine is compiled. In general,
247 this is probably not terribly useful.
253 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
257 my $default_root = 'Root000000000';
262 my($class, $root, $mask) = @_;
265 $obj->root(defined($root) ? $root : ("Safe::".$default_root++));
266 $obj->mask(defined($mask) ? $mask : $default_mask);
267 # We must share $_ and @_ with the compartment or else ops such
268 # as split, length and so on won't default to $_ properly, nor
269 # will passing argument to subroutines work (via @_). In fact,
270 # for reasons I don't completely understand, we need to share
271 # the whole glob *_ rather than $_ and @_ separately, otherwise
272 # @_ in non default packages within the compartment don't work.
273 *{$obj->root . "::_"} = *_;
279 my $root = $obj->root();
280 if ($root =~ /^Safe::(Root\d+)$/){
282 delete $ {"Safe::"}{"$root\::"};
289 $obj->{Root} = $_[0];
298 $obj->{Mask} = verify_mask($_[0]);
306 if (length($mask) != MAXO() || $mask !~ /^[\0\1]+$/) {
307 croak("argument is not a mask");
314 $obj->setmaskel("\1", @_);
319 $obj->setmaskel("\0", @_);
322 sub emptymask { "\0" x MAXO() }
323 sub fullmask { "\1" x MAXO() }
328 croak("bad value for mask element") unless $val eq "\0" || $val eq "\1";
329 my $maskref = \$obj->{Mask};
332 $opcode = ($op =~ /^\d/) ? $op : opcode($op);
333 substr($$maskref, $opcode, 1) = $val;
339 my $root = $obj->root();
343 ($var = $arg) =~ s/^(.)//;
345 *{$root."::$var"} = ($1 eq '$') ? \${$caller."::$var"}
346 : ($1 eq '@') ? \@{$caller."::$var"}
347 : ($1 eq '%') ? \%{$caller."::$var"}
348 : ($1 eq '*') ? *{$caller."::$var"}
349 : ($1 eq '&') ? \&{$caller."::$var"}
350 : croak(qq(No such variable type for "$1$var"));
355 my ($obj, $var) = @_;
356 return *{$obj->root()."::$var"};
360 my ($obj, $expr) = @_;
361 my $root = $obj->{Root};
362 my $mask = $obj->{Mask};
365 my $evalsub = eval sprintf(<<'EOT', $root);
371 return safe_call_sv($root, $mask, $evalsub);
375 my ($obj, $file) = @_;
376 my $root = $obj->{Root};
377 my $mask = $obj->{Mask};
380 $file =~ s/"/\\"/g; # just in case the filename contains any double quotes
381 my $evalsub = eval sprintf(<<'EOT', $root, $file);
387 return safe_call_sv($root, $mask, $evalsub);
390 bootstrap Safe $VERSION;
392 $default_mask = fullmask;
394 while (defined ($name = <DATA>)) {
396 next if $name =~ /^#/;
397 my $code = opcode($name);
398 substr($default_mask, $code, 1) = "\0";