5 @ISA = qw(Exporter DynaLoader);
6 @EXPORT_OK = qw(op_mask ops_to_mask mask_to_ops opcode opname
7 MAXO emptymask fullmask);
11 Safe - Safe extension module for Perl
15 The Safe extension module allows the creation of compartments
16 in which perl code can be evaluated. Each compartment has
22 The "root" of the namespace (i.e. "main::") is changed to a
23 different package and code evaluated in the compartment cannot
24 refer to variables outside this namespace, even with run-time
25 glob lookups and other tricks. Code which is compiled outside
26 the compartment can choose to place variables into (or share
27 variables with) the compartment's namespace and only that
28 data will be visible to code evaluated in the compartment.
30 By default, the only variables shared with compartments are the
31 "underscore" variables $_ and @_ (and, technically, the much less
32 frequently used %_, the _ filehandle and so on). This is because
33 otherwise perl operators which default to $_ will not work and neither
34 will the assignment of arguments to @_ on subroutine entry.
36 =item an operator mask
38 Each compartment has an associated "operator mask". Recall that
39 perl code is compiled into an internal format before execution.
40 Evaluating perl code (e.g. via "eval" or "do 'file'") causes
41 the code to be compiled into an internal format and then,
42 provided there was no error in the compilation, executed.
43 Code evaulated in a compartment compiles subject to the
44 compartment's operator mask. Attempting to evaulate code in a
45 compartment which contains a masked operator will cause the
46 compilation to fail with an error. The code will not be executed.
48 By default, the operator mask for a newly created compartment masks
49 out all operations which give "access to the system" in some sense.
50 This includes masking off operators such as I<system>, I<open>,
51 I<chown>, and I<shmget> but does not mask off operators such as
52 I<print>, I<sysread> and I<E<lt>HANDLE<gt>>. Those file operators
53 are allowed since for the code in the compartment to have access
54 to a filehandle, the code outside the compartment must have explicitly
55 placed the filehandle variable inside the compartment.
57 Since it is only at the compilation stage that the operator mask
58 applies, controlled access to potentially unsafe operations can
59 be achieved by having a handle to a wrapper subroutine (written
60 outside the compartment) placed into the compartment. For example,
64 # vet arguments and perform potentially unsafe operations
66 $cpt->share('&wrapper');
72 An operator mask exists at user-level as a string of bytes of length
73 MAXO, each of which is either 0x00 or 0x01. Here, MAXO is the number
74 of operators in the current version of perl. The subroutine MAXO()
75 (available for export by package Safe) returns the number of operators
76 in the current version of perl. Note that, unlike the beta versions of
77 the Safe extension, this is a reliable count of the number of
78 operators in the currently running perl executable. The presence of a
79 0x01 byte at offset B<n> of the string indicates that operator number
80 B<n> should be masked (i.e. disallowed). The Safe extension makes
81 available routines for converting from operator names to operator
82 numbers (and I<vice versa>) and for converting from a list of operator
83 names to the corresponding mask (and I<vice versa>).
85 =head2 Methods in class Safe
87 To create a new compartment, use
91 Optional arguments are (NAMESPACE, MASK), where
97 is the root namespace to use for the compartment (defaults to
98 "Safe::Root000000000", auto-incremented for each new compartment); and
102 is the operator mask to use (defaults to a fairly restrictive set).
106 The following methods can then be used on the compartment
107 object returned by the above constructor. The object argument
108 is implicit in each case.
112 =item root (NAMESPACE)
114 This is a get-or-set method for the compartment's namespace. With the
115 NAMESPACE argument present, it sets the root namespace for the
116 compartment. With no NAMESPACE argument present, it returns the
117 current root namespace of the compartment.
121 This is a get-or-set method for the compartment's operator mask.
122 With the MASK argument present, it sets the operator mask for the
123 compartment. With no MASK argument present, it returns the
124 current operator mask of the compartment.
128 This sets bits in the compartment's operator mask corresponding
129 to each operator named in the list of arguments. Each OP can be
130 either the name of an operation or its number. See opcode.h or
131 opcode.pl in the main perl distribution for a canonical list of
134 =item untrap (OP, ...)
136 This resets bits in the compartment's operator mask corresponding
137 to each operator named in the list of arguments. Each OP can be
138 either the name of an operation or its number. See opcode.h or
139 opcode.pl in the main perl distribution for a canonical list of
142 =item share (VARNAME, ...)
144 This shares the variable(s) in the argument list with the compartment.
145 Each VARNAME must be the B<name> of a variable with a leading type
146 identifier included. Examples of legal variable names are '$foo' for
147 a scalar, '@foo' for an array, '%foo' for a hash, '&foo' for a
148 subroutine and '*foo' for a glob (i.e. all symbol table entries
149 associated with "foo", including scalar, array, hash, sub and filehandle).
151 =item varglob (VARNAME)
153 This returns a glob for the symbol table entry of VARNAME in the package
154 of the compartment. VARNAME must be the B<name> of a variable without
155 any leading type marker. For example,
157 $cpt = new Safe 'Root';
158 $Root::foo = "Hello world";
159 # Equivalent version which doesn't need to know $cpt's package name:
160 ${$cpt->varglob('foo')} = "Hello world";
165 This evaluates STRING as perl code inside the compartment. The code
166 can only see the compartment's namespace (as returned by the B<root>
167 method). Any attempt by code in STRING to use an operator which is
168 in the compartment's mask will cause an error (at run-time of the
169 main program but at compile-time for the code in STRING). The error
170 is of the form "%s trapped by operation mask operation...". If an
171 operation is trapped in this way, then the code in STRING will not
172 be executed. If such a trapped operation occurs or any other
173 compile-time or return error, then $@ is set to the error message,
174 just as with an eval(). If there is no error, then the method returns
175 the value of the last expression evaluated, or a return statement may
176 be used, just as with subroutines and B<eval()>. Note that this
177 behaviour differs from the beta distribution of the Safe extension
178 where earlier versions of perl made it hard to mimic the return
179 behaviour of the eval() command.
183 This evaluates the contents of file FILENAME inside the compartment.
184 See above documentation on the B<reval> method for further details.
188 =head2 Subroutines in package Safe
190 The Safe package contains subroutines for manipulating operator
191 names and operator masks. All are available for export by the package.
192 The canonical list of operator names is the contents of the array
193 op_name defined and initialised in file F<opcode.h> of the Perl
198 =item ops_to_mask (OP, ...)
200 This takes a list of operator names and returns an operator mask
201 with precisely those operators masked.
203 =item mask_to_ops (MASK)
205 This takes an operator mask and returns a list of operator names
206 corresponding to those operators which are masked in MASK.
208 =item opcode (OP, ...)
210 This takes a list of operator names and returns the corresponding
211 list of opcodes (which can then be used as byte offsets into a mask).
213 =item opname (OP, ...)
215 This takes a list of opcodes and returns the corresponding list of
220 This just returns a mask which has all operators masked.
221 It returns the string "\1" x MAXO().
225 This just returns a mask which has all operators unmasked.
226 It returns the string "\0" x MAXO(). This is useful if you
227 want a compartment to make use of the namespace protection
228 features but do not want the default restrictive mask.
232 This returns the number of operators (and hence the length of an
233 operator mask). Note that, unlike the beta distributions of the
234 Safe extension, this is derived from a genuine integer variable
235 in the perl executable and not from a preprocessor constant.
236 This means that the Safe extension is more robust in the presence
237 of mismatched versions of the perl executable and the Safe extension.
241 This returns the operator mask which is actually in effect at the
242 time the invocation to the subroutine is compiled. In general,
243 this is probably not terribly useful.
249 Malcolm Beattie, mbeattie@sable.ox.ac.uk.
253 my $safes = "1111111111111111111111101111111111111111111111111111111111111111"
254 . "1111111111111111111111111111111111111111111111111111111111111111"
255 . "1111110011111111111011111111111111111111111111111111111101001010"
256 . "0110111111111111111111110011111111100001000000000000000000000100"
257 . "0000000000000111110000001111111110100000000000001111111111111111"
258 . "11111111111111111110";
260 my $default_root = 'Safe::Root000000000';
263 my($class, $root, $mask) = @_;
266 $obj->root(defined($root) ? $root : $default_root++);
267 $obj->mask(defined($mask) ? $mask : $default_mask);
268 # We must share $_ and @_ with the compartment or else ops such
269 # as split, length and so on won't default to $_ properly, nor
270 # will passing argument to subroutines work (via @_). In fact,
271 # for reasons I don't completely understand, we need to share
272 # the whole glob *_ rather than $_ and @_ separately, otherwise
273 # @_ in non default packages within the compartment don't work.
274 *{$obj->root . "::_"} = *_;
281 $obj->{Root} = $_[0];
290 $obj->{Mask} = verify_mask($_[0]);
298 if (length($mask) != MAXO() || $mask !~ /^[\0\1]+$/) {
299 croak("argument is not a mask");
306 $obj->setmaskel("\1", @_);
311 $obj->setmaskel("\0", @_);
314 sub emptymask { "\0" x MAXO() }
315 sub fullmask { "\1" x MAXO() }
320 croak("bad value for mask element") unless $val eq "\0" || $val eq "\1";
321 my $maskref = \$obj->{Mask};
324 $opcode = ($op =~ /^\d/) ? $op : opcode($op);
325 substr($$maskref, $opcode, 1) = $val;
331 my $root = $obj->root();
335 ($var = $arg) =~ s/^(.)//;
337 *{$root."::$var"} = ($1 eq '$') ? \${$caller."::$var"}
338 : ($1 eq '@') ? \@{$caller."::$var"}
339 : ($1 eq '%') ? \%{$caller."::$var"}
340 : ($1 eq '*') ? *{$caller."::$var"}
341 : ($1 eq '&') ? \&{$caller."::$var"}
342 : croak(qq(No such variable type for "$1$var"));
347 my ($obj, $var) = @_;
348 return *{$obj->root()."::$var"};
352 my ($obj, $expr) = @_;
353 my $root = $obj->{Root};
354 my $mask = $obj->{Mask};
357 my $evalsub = eval sprintf(<<'EOT', $root);
363 return safe_call_sv($root, $mask, $evalsub);
367 my ($obj, $file) = @_;
368 my $root = $obj->{Root};
369 my $mask = $obj->{Mask};
372 $file =~ s/"/\\"/g; # just in case the filename contains any double quotes
373 my $evalsub = eval sprintf(<<'EOT', $root, $file);
379 return safe_call_sv($root, $mask, $evalsub);
384 $safes .= "0" x (MAXO() - length($safes));
385 ($default_mask = $safes) =~ tr/01/\1\0/; # invert for mask