5 $VERSION = $VERSION = "1.00";
6 @ISA = qw(Exporter DynaLoader);
7 @EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname opdesc
8 MAXO emptymask fullmask);
12 Safe - Safe extension module for Perl
16 The Safe extension module allows the creation of compartments
17 in which perl code can be evaluated. Each compartment has
23 The "root" of the namespace (i.e. "main::") is changed to a
24 different package and code evaluated in the compartment cannot
25 refer to variables outside this namespace, even with run-time
26 glob lookups and other tricks. Code which is compiled outside
27 the compartment can choose to place variables into (or share
28 variables with) the compartment's namespace and only that
29 data will be visible to code evaluated in the compartment.
31 By default, the only variables shared with compartments are the
32 "underscore" variables $_ and @_ (and, technically, the much less
33 frequently used %_, the _ filehandle and so on). This is because
34 otherwise perl operators which default to $_ will not work and neither
35 will the assignment of arguments to @_ on subroutine entry.
37 =item an operator mask
39 Each compartment has an associated "operator mask". Recall that
40 perl code is compiled into an internal format before execution.
41 Evaluating perl code (e.g. via "eval" or "do 'file'") causes
42 the code to be compiled into an internal format and then,
43 provided there was no error in the compilation, executed.
44 Code evaulated in a compartment compiles subject to the
45 compartment's operator mask. Attempting to evaulate code in a
46 compartment which contains a masked operator will cause the
47 compilation to fail with an error. The code will not be executed.
49 By default, the operator mask for a newly created compartment masks
50 out all operations which give "access to the system" in some sense.
51 This includes masking off operators such as I<system>, I<open>,
52 I<chown>, and I<shmget> but does not mask off operators such as
53 I<print>, I<sysread> and I<E<lt>HANDLE<gt>>. Those file operators
54 are allowed since for the code in the compartment to have access
55 to a filehandle, the code outside the compartment must have explicitly
56 placed the filehandle variable inside the compartment.
58 Since it is only at the compilation stage that the operator mask
59 applies, controlled access to potentially unsafe operations can
60 be achieved by having a handle to a wrapper subroutine (written
61 outside the compartment) placed into the compartment. For example,
65 # vet arguments and perform potentially unsafe operations
67 $cpt->share('&wrapper');
73 An operator mask exists at user-level as a string of bytes of length
74 MAXO, each of which is either 0x00 or 0x01. Here, MAXO is the number
75 of operators in the current version of perl. The subroutine MAXO()
76 (available for export by package Safe) returns the number of operators
77 in the current version of perl. Note that, unlike the beta versions of
78 the Safe extension, this is a reliable count of the number of
79 operators in the currently running perl executable. The presence of a
80 0x01 byte at offset B<n> of the string indicates that operator number
81 B<n> should be masked (i.e. disallowed). The Safe extension makes
82 available routines for converting from operator names to operator
83 numbers (and I<vice versa>) and for converting from a list of operator
84 names to the corresponding mask (and I<vice versa>).
86 =head2 Methods in class Safe
88 To create a new compartment, use
92 Optional arguments are (NAMESPACE, MASK), where
98 is the root namespace to use for the compartment (defaults to
99 "Safe::Root000000000", auto-incremented for each new compartment); and
103 is the operator mask to use (defaults to a fairly restrictive set).
107 The following methods can then be used on the compartment
108 object returned by the above constructor. The object argument
109 is implicit in each case.
113 =item root (NAMESPACE)
115 This is a get-or-set method for the compartment's namespace. With the
116 NAMESPACE argument present, it sets the root namespace for the
117 compartment. With no NAMESPACE argument present, it returns the
118 current root namespace of the compartment.
122 This is a get-or-set method for the compartment's operator mask.
123 With the MASK argument present, it sets the operator mask for the
124 compartment. With no MASK argument present, it returns the
125 current operator mask of the compartment.
129 This sets bits in the compartment's operator mask corresponding
130 to each operator named in the list of arguments. Each OP can be
131 either the name of an operation or its number. See opcode.h or
132 opcode.pl in the main perl distribution for a canonical list of
135 =item untrap (OP, ...)
137 This resets bits in the compartment's operator mask corresponding
138 to each operator named in the list of arguments. Each OP can be
139 either the name of an operation or its number. See opcode.h or
140 opcode.pl in the main perl distribution for a canonical list of
143 =item share (VARNAME, ...)
145 This shares the variable(s) in the argument list with the compartment.
146 Each VARNAME must be the B<name> of a variable with a leading type
147 identifier included. Examples of legal variable names are '$foo' for
148 a scalar, '@foo' for an array, '%foo' for a hash, '&foo' for a
149 subroutine and '*foo' for a glob (i.e. all symbol table entries
150 associated with "foo", including scalar, array, hash, sub and filehandle).
152 =item varglob (VARNAME)
154 This returns a glob for the symbol table entry of VARNAME in the package
155 of the compartment. VARNAME must be the B<name> of a variable without
156 any leading type marker. For example,
158 $cpt = new Safe 'Root';
159 $Root::foo = "Hello world";
160 # Equivalent version which doesn't need to know $cpt's package name:
161 ${$cpt->varglob('foo')} = "Hello world";
166 This evaluates STRING as perl code inside the compartment. The code
167 can only see the compartment's namespace (as returned by the B<root>
168 method). Any attempt by code in STRING to use an operator which is
169 in the compartment's mask will cause an error (at run-time of the
170 main program but at compile-time for the code in STRING). The error
171 is of the form "%s trapped by operation mask operation...". If an
172 operation is trapped in this way, then the code in STRING will not
173 be executed. If such a trapped operation occurs or any other
174 compile-time or return error, then $@ is set to the error message,
175 just as with an eval(). If there is no error, then the method returns
176 the value of the last expression evaluated, or a return statement may
177 be used, just as with subroutines and B<eval()>. Note that this
178 behaviour differs from the beta distribution of the Safe extension
179 where earlier versions of perl made it hard to mimic the return
180 behaviour of the eval() command.
184 This evaluates the contents of file FILENAME inside the compartment.
185 See above documentation on the B<reval> method for further details.
189 =head2 Subroutines in package Safe
191 The Safe package contains subroutines for manipulating operator
192 names and operator masks. All are available for export by the package.
193 The canonical list of operator names is the contents of the array
194 op_name defined and initialised in file F<opcode.h> of the Perl
199 =item ops_to_mask (OP, ...)
201 This takes a list of operator names and returns an operator mask
202 with precisely those operators masked.
204 =item mask_to_ops (MASK)
206 This takes an operator mask and returns a list of operator names
207 corresponding to those operators which are masked in MASK.
209 =item opcode (OP, ...)
211 This takes a list of operator names and returns the corresponding
212 list of opcodes (which can then be used as byte offsets into a mask).
214 =item opname (OP, ...)
216 This takes a list of opcodes and returns the corresponding list of
221 This just returns a mask which has all operators masked.
222 It returns the string "\1" x MAXO().
226 This just returns a mask which has all operators unmasked.
227 It returns the string "\0" x MAXO(). This is useful if you
228 want a compartment to make use of the namespace protection
229 features but do not want the default restrictive mask.
233 This returns the number of operators (and hence the length of an
234 operator mask). Note that, unlike the beta distributions of the
235 Safe extension, this is derived from a genuine integer variable
236 in the perl executable and not from a preprocessor constant.
237 This means that the Safe extension is more robust in the presence
238 of mismatched versions of the perl executable and the Safe extension.
242 This returns the operator mask which is actually in effect at the
243 time the invocation to the subroutine is compiled. In general,
244 this is probably not terribly useful.
250 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
254 my $default_root = 'Root000000000';
259 my($class, $root, $mask) = @_;
262 $obj->root(defined($root) ? $root : ("Safe::".$default_root++));
263 $obj->mask(defined($mask) ? $mask : $default_mask);
264 # We must share $_ and @_ with the compartment or else ops such
265 # as split, length and so on won't default to $_ properly, nor
266 # will passing argument to subroutines work (via @_). In fact,
267 # for reasons I don't completely understand, we need to share
268 # the whole glob *_ rather than $_ and @_ separately, otherwise
269 # @_ in non default packages within the compartment don't work.
270 *{$obj->root . "::_"} = *_;
276 my $root = $obj->root();
277 if ($root =~ /^Safe::(Root\d+)$/){
279 delete $ {"Safe::"}{"$root\::"};
286 $obj->{Root} = $_[0];
295 $obj->{Mask} = verify_mask($_[0]);
303 if (length($mask) != MAXO() || $mask !~ /^[\0\1]+$/) {
304 croak("argument is not a mask");
311 $obj->setmaskel("\1", @_);
316 $obj->setmaskel("\0", @_);
319 sub emptymask { "\0" x MAXO() }
320 sub fullmask { "\1" x MAXO() }
325 croak("bad value for mask element") unless $val eq "\0" || $val eq "\1";
326 my $maskref = \$obj->{Mask};
329 $opcode = ($op =~ /^\d/) ? $op : opcode($op);
330 substr($$maskref, $opcode, 1) = $val;
336 my $root = $obj->root();
340 ($var = $arg) =~ s/^(.)//;
342 *{$root."::$var"} = ($1 eq '$') ? \${$caller."::$var"}
343 : ($1 eq '@') ? \@{$caller."::$var"}
344 : ($1 eq '%') ? \%{$caller."::$var"}
345 : ($1 eq '*') ? *{$caller."::$var"}
346 : ($1 eq '&') ? \&{$caller."::$var"}
347 : croak(qq(No such variable type for "$1$var"));
352 my ($obj, $var) = @_;
353 return *{$obj->root()."::$var"};
357 my ($obj, $expr) = @_;
358 my $root = $obj->{Root};
359 my $mask = $obj->{Mask};
362 my $evalsub = eval sprintf(<<'EOT', $root);
368 return safe_call_sv($root, $mask, $evalsub);
372 my ($obj, $file) = @_;
373 my $root = $obj->{Root};
374 my $mask = $obj->{Mask};
377 $file =~ s/"/\\"/g; # just in case the filename contains any double quotes
378 my $evalsub = eval sprintf(<<'EOT', $root, $file);
384 return safe_call_sv($root, $mask, $evalsub);
389 $default_mask = fullmask;
391 while (defined ($name = <DATA>)) {
393 next if $name =~ /^#/;
394 my $code = opcode($name);
395 substr($default_mask, $code, 1) = "\0";