Move Safe from ext/ to dist/

12 files changed, 1552 insertions, 0 deletions

diff --git a/dist/Safe/Changes b/dist/Safe/Changes
new file mode 100644
index 0000000000..36e9943d03
--- /dev/null
+++ b/dist/Safe/Changes
@@ -0,0 +1,108 @@
+2.19 Tue Aug 25 2009
+    t/safeuniversal.t failure under 5.8.9 (Jerry D. Hedden)
+
+2.18 released with perl 5.10.1
+    [perl #68530] "version::CLASS" warning in Safe.pm (Dave Mitchell)
+
+2.17 Sun Jun 28 2009
+    Sync with code reorganisation in bleadperl
+    Plus new tests
+
+2.16 Thu Mar 13 2008
+    Fix a few backcompat issues:
+
+    Change 33503 on 2008/03/13 by rgs@stcosmo
+	Regexp::DESTROY was only added in 5.8.1
+
+    Change 33278 on 2008/02/11 by rgs@stcosmo
+	Fix test to pass en 5.6.2 (unpack is needed by version.pm there)
+
+2.15 Wed Feb  6 2008
+    Change 33238 on 2008/02/05 by rgs@stcosmo
+	Adapt Safe innards to older (XS) versions of version.pm
+
+    Change 33237 on 2008/02/05 by rgs@stcosmo
+	Add a new test for Safe
+
+    Change 33236 on 2008/02/05 by rgs@stcosmo
+	Fix CPAN bug #32896: make version.pm loadable in a Safe compartment
+
+    Change 33170 on 2008/02/01 by nicholas@nicholas-bouvard
+	Break apart the list of functions defined in universal.c by perl
+	version (from 5.8.8 upwards)
+
+2.14 Mon Jan 30 2008
+	- Make Safe work with Perl 5.6 (changes 33102 and 33105 to perl)
+
+2.13 Mon Jan 28 2008
+	- Backport the bleadperl version to CPAN. Changes:
+
+    Change 33096 on 2008/01/28 by rgs@stcosmo
+
+	    Bump the version of Safe
+
+    Change 33093 on 2008/01/28 by rgs@stcosmo
+
+	    In Safe, load Carp::Heavy only if it exists (to remain
+	    compatible with older perls)
+
+    Change 32597 on 2007/12/08 by rgs@counterfly
+
+	    Change maintainer address for Safe.
+
+    Change 32103 on 2007/10/12 by rgs@counterfly
+
+	    Funny symbol table names can be shared, too
+
+    Change 32102 on 2007/10/12 by rgs@counterfly
+
+	    Share the internal XS functions defined in universal.c
+	    to Safe compartments
+
+    Change 31610 on 2007/07/13 by rgs@stcosmo
+
+	    Use new style L<> links in POD
+
+    Change 26814 on 2006/01/13 by rgs@stencil
+
+	    Add a link to the Opcode doc in Safe.
+	    (see RT CPAN ticket #8579)
+
+2.11 Fri Jul  2 2004
+	- Backport the bleadperl version to CPAN. Changes:
+
+    Change 22898 by rgs@valis on 2004/06/03 09:02:31
+
+	Carp was mostly unusable with Safe because it may require
+	Carp::Heavy at run-time (while require() is forbidden.)
+	Have Safe load Carp::Heavy.
+
+    Change 21063 by rgs@rgs-home on 2003/09/07 18:25:23
+
+	Subject: [PATCH] Re: [perl #23656] Safe reval bleeds local variable values
+	From: Dave Mitchell <davem@fdgroup.com>
+	Date: Sun, 7 Sep 2003 19:14:44 +0100
+	Message-ID: <20030907181444.GA7058@fdgroup.com>
+
+2.09 Sun Oct  6 14:12:40 CEST 2002
+	- Upgraded the Makefile.PL to install Safe.pm to the correct place.
+	- Made it work on 5.6 atleast, maybe even on 5.005?
+
+2.08 Sat Oct  5 18:05:32 CEST 2002
+	- First CPAN release, prompted by bug number 17744 on rt.perl.org.
+	  http://bugs6.perl.org/rt2/Ticket/Display.html?id=17744	
+	- Change 17977 by rgs@rgs-home on 2002/10/04 20:01:54
+	  Complement to change #17976 :
+	  there was a similar bug on rdo().
+	  Increment $Safe::VERSION.
+	- Change 17976 by rgs@rgs-home on 2002/10/04 19:44:48
+	  Fix bug #17744, suggested by Andreas Jurenda,
+	  tweaked by rgs (security hole in Safe).
+	- Change 17973 by rgs@rgs-home on 2002/10/03 20:34:13
+	  Change the warning message "%s trapped by operation mask"
+	  to include '' around the op name. Document it in perldiag.
+	- Change 17729 by hv@hv-star.knots.net on 2002/08/17 02:33:15
+	  Subject: [PATCH] Safe.pm documentation
+          From: Slaven Rezic <slaven.rezic@berlin.de>
+          Date: Sat, 10 Aug 2002 19:30:38 +0200 (CEST)
+          Message-id: <200208101730.g7AHUc9p001668@vran.herceg.de>
diff --git a/dist/Safe/MANIFEST b/dist/Safe/MANIFEST
new file mode 100644
index 0000000000..3f8b3f6df2
--- /dev/null
+++ b/dist/Safe/MANIFEST
@@ -0,0 +1,12 @@
+Changes
+MANIFEST			This list of files
+Makefile.PL
+README
+Safe.pm
+t/safe1.t
+t/safe2.t
+t/safe3.t
+t/safeload.t
+t/safeops.t
+t/safeuniversal.t
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/dist/Safe/META.yml b/dist/Safe/META.yml
new file mode 100644
index 0000000000..79cbd4dfcc
--- /dev/null
+++ b/dist/Safe/META.yml
@@ -0,0 +1,12 @@
+--- #YAML:1.0
+name:                Safe
+version:             2.19
+abstract:            ~
+license:             ~
+author:              ~
+generated_by:        ExtUtils::MakeMaker version 6.42
+distribution_type:   module
+requires:     
+meta-spec:
+    url:     http://module-build.sourceforge.net/META-spec-v1.3.html
+    version: 1.3
diff --git a/dist/Safe/Makefile.PL b/dist/Safe/Makefile.PL
new file mode 100644
index 0000000000..0463e9c7db
--- /dev/null
+++ b/dist/Safe/Makefile.PL
@@ -0,0 +1,10 @@
+use ExtUtils::MakeMaker;
+
+my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV;
+
+WriteMakefile(
+    NAME => 'Safe',
+    VERSION_FROM => 'Safe.pm',
+    INSTALLDIRS => 'perl',
+    ($core || $] >= 5.011) ? () : (INST_LIB => '$(INST_ARCHLIB)'),
+);
diff --git a/dist/Safe/README b/dist/Safe/README
new file mode 100644
index 0000000000..c19f3f10bf
--- /dev/null
+++ b/dist/Safe/README
@@ -0,0 +1,8 @@
+Safe.pm
+=======
+
+This is a backport to CPAN of the perl core module Safe.pm.
+
+It is currently maintained by the Perl 5 Porters. Thus, you should use
+the perlbug utility to report bugs in it.
+
diff --git a/dist/Safe/Safe.pm b/dist/Safe/Safe.pm
new file mode 100644
index 0000000000..6926a4e369
--- /dev/null
+++ b/dist/Safe/Safe.pm
@@ -0,0 +1,636 @@
+package Safe;
+
+use 5.003_11;
+use strict;
+
+$Safe::VERSION = "2.19";
+
+# *** Don't declare any lexicals above this point ***
+#
+# This function should return a closure which contains an eval that can't
+# see any lexicals in scope (apart from __ExPr__ which is unavoidable)
+
+sub lexless_anon_sub {
+		 # $_[0] is package;
+		 # $_[1] is strict flag;
+    my $__ExPr__ = $_[2];   # must be a lexical to create the closure that
+			    # can be used to pass the value into the safe
+			    # world
+
+    # Create anon sub ref in root of compartment.
+    # Uses a closure (on $__ExPr__) to pass in the code to be executed.
+    # (eval on one line to keep line numbers as expected by caller)
+    eval sprintf
+    'package %s; %s strict; sub { @_=(); eval q[my $__ExPr__;] . $__ExPr__; }',
+		$_[0], $_[1] ? 'use' : 'no';
+}
+
+use Carp;
+BEGIN { eval q{
+    use Carp::Heavy;
+} }
+
+use Opcode 1.01, qw(
+    opset opset_to_ops opmask_add
+    empty_opset full_opset invert_opset verify_opset
+    opdesc opcodes opmask define_optag opset_to_hex
+);
+
+*ops_to_opset = \&opset;   # Temporary alias for old Penguins
+
+
+my $default_root  = 0;
+# share *_ and functions defined in universal.c
+# Don't share stuff like *UNIVERSAL:: otherwise code from the
+# compartment can 0wn functions in UNIVERSAL
+my $default_share = [qw[
+    *_
+    &PerlIO::get_layers
+    &UNIVERSAL::isa
+    &UNIVERSAL::can
+    &UNIVERSAL::VERSION
+    &utf8::is_utf8
+    &utf8::valid
+    &utf8::encode
+    &utf8::decode
+    &utf8::upgrade
+    &utf8::downgrade
+    &utf8::native_to_unicode
+    &utf8::unicode_to_native
+    $version::VERSION
+    $version::CLASS
+    @version::ISA
+], ($] >= 5.008001 && qw[
+    &Regexp::DESTROY
+]), ($] >= 5.010 && qw[
+    &re::is_regexp
+    &re::regname
+    &re::regnames
+    &re::regnames_count
+    &Tie::Hash::NamedCapture::FETCH
+    &Tie::Hash::NamedCapture::STORE
+    &Tie::Hash::NamedCapture::DELETE
+    &Tie::Hash::NamedCapture::CLEAR
+    &Tie::Hash::NamedCapture::EXISTS
+    &Tie::Hash::NamedCapture::FIRSTKEY
+    &Tie::Hash::NamedCapture::NEXTKEY
+    &Tie::Hash::NamedCapture::SCALAR
+    &Tie::Hash::NamedCapture::flags
+    &UNIVERSAL::DOES
+    &version::()
+    &version::new
+    &version::(""
+    &version::stringify
+    &version::(0+
+    &version::numify
+    &version::normal
+    &version::(cmp
+    &version::(<=>
+    &version::vcmp
+    &version::(bool
+    &version::boolean
+    &version::(nomethod
+    &version::noop
+    &version::is_alpha
+    &version::qv
+]), ($] >= 5.011 && qw[
+    &re::regexp_pattern
+])];
+
+sub new {
+    my($class, $root, $mask) = @_;
+    my $obj = {};
+    bless $obj, $class;
+
+    if (defined($root)) {
+	croak "Can't use \"$root\" as root name"
+	    if $root =~ /^main\b/ or $root !~ /^\w[:\w]*$/;
+	$obj->{Root}  = $root;
+	$obj->{Erase} = 0;
+    }
+    else {
+	$obj->{Root}  = "Safe::Root".$default_root++;
+	$obj->{Erase} = 1;
+    }
+
+    # use permit/deny methods instead till interface issues resolved
+    # XXX perhaps new Safe 'Root', mask => $mask, foo => bar, ...;
+    croak "Mask parameter to new no longer supported" if defined $mask;
+    $obj->permit_only(':default');
+
+    # We must share $_ and @_ with the compartment or else ops such
+    # as split, length and so on won't default to $_ properly, nor
+    # will passing argument to subroutines work (via @_). In fact,
+    # for reasons I don't completely understand, we need to share
+    # the whole glob *_ rather than $_ and @_ separately, otherwise
+    # @_ in non default packages within the compartment don't work.
+    $obj->share_from('main', $default_share);
+    Opcode::_safe_pkg_prep($obj->{Root}) if($Opcode::VERSION > 1.04);
+    return $obj;
+}
+
+sub DESTROY {
+    my $obj = shift;
+    $obj->erase('DESTROY') if $obj->{Erase};
+}
+
+sub erase {
+    my ($obj, $action) = @_;
+    my $pkg = $obj->root();
+    my ($stem, $leaf);
+
+    no strict 'refs';
+    $pkg = "main::$pkg\::";	# expand to full symbol table name
+    ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/;
+
+    # The 'my $foo' is needed! Without it you get an
+    # 'Attempt to free unreferenced scalar' warning!
+    my $stem_symtab = *{$stem}{HASH};
+
+    #warn "erase($pkg) stem=$stem, leaf=$leaf";
+    #warn " stem_symtab hash ".scalar(%$stem_symtab)."\n";
+	# ", join(', ', %$stem_symtab),"\n";
+
+#    delete $stem_symtab->{$leaf};
+
+    my $leaf_glob   = $stem_symtab->{$leaf};
+    my $leaf_symtab = *{$leaf_glob}{HASH};
+#    warn " leaf_symtab ", join(', ', %$leaf_symtab),"\n";
+    %$leaf_symtab = ();
+    #delete $leaf_symtab->{'__ANON__'};
+    #delete $leaf_symtab->{'foo'};
+    #delete $leaf_symtab->{'main::'};
+#    my $foo = undef ${"$stem\::"}{"$leaf\::"};
+
+    if ($action and $action eq 'DESTROY') {
+        delete $stem_symtab->{$leaf};
+    } else {
+        $obj->share_from('main', $default_share);
+    }
+    1;
+}
+
+
+sub reinit {
+    my $obj= shift;
+    $obj->erase;
+    $obj->share_redo;
+}
+
+sub root {
+    my $obj = shift;
+    croak("Safe root method now read-only") if @_;
+    return $obj->{Root};
+}
+
+
+sub mask {
+    my $obj = shift;
+    return $obj->{Mask} unless @_;
+    $obj->deny_only(@_);
+}
+
+# v1 compatibility methods
+sub trap   { shift->deny(@_)   }
+sub untrap { shift->permit(@_) }
+
+sub deny {
+    my $obj = shift;
+    $obj->{Mask} |= opset(@_);
+}
+sub deny_only {
+    my $obj = shift;
+    $obj->{Mask} = opset(@_);
+}
+
+sub permit {
+    my $obj = shift;
+    # XXX needs testing
+    $obj->{Mask} &= invert_opset opset(@_);
+}
+sub permit_only {
+    my $obj = shift;
+    $obj->{Mask} = invert_opset opset(@_);
+}
+
+
+sub dump_mask {
+    my $obj = shift;
+    print opset_to_hex($obj->{Mask}),"\n";
+}
+
+
+
+sub share {
+    my($obj, @vars) = @_;
+    $obj->share_from(scalar(caller), \@vars);
+}
+
+sub share_from {
+    my $obj = shift;
+    my $pkg = shift;
+    my $vars = shift;
+    my $no_record = shift || 0;
+    my $root = $obj->root();
+    croak("vars not an array ref") unless ref $vars eq 'ARRAY';
+    no strict 'refs';
+    # Check that 'from' package actually exists
+    croak("Package \"$pkg\" does not exist")
+	unless keys %{"$pkg\::"};
+    my $arg;
+    foreach $arg (@$vars) {
+	# catch some $safe->share($var) errors:
+	my ($var, $type);
+	$type = $1 if ($var = $arg) =~ s/^(\W)//;
+	# warn "share_from $pkg $type $var";
+	for (1..2) { # assign twice to avoid any 'used once' warnings
+	    *{$root."::$var"} = (!$type)       ? \&{$pkg."::$var"}
+			  : ($type eq '&') ? \&{$pkg."::$var"}
+			  : ($type eq '$') ? \${$pkg."::$var"}
+			  : ($type eq '@') ? \@{$pkg."::$var"}
+			  : ($type eq '%') ? \%{$pkg."::$var"}
+			  : ($type eq '*') ?  *{$pkg."::$var"}
+			  : croak(qq(Can't share "$type$var" of unknown type));
+	}
+    }
+    $obj->share_record($pkg, $vars) unless $no_record or !$vars;
+}
+
+sub share_record {
+    my $obj = shift;
+    my $pkg = shift;
+    my $vars = shift;
+    my $shares = \%{$obj->{Shares} ||= {}};
+    # Record shares using keys of $obj->{Shares}. See reinit.
+    @{$shares}{@$vars} = ($pkg) x @$vars if @$vars;
+}
+sub share_redo {
+    my $obj = shift;
+    my $shares = \%{$obj->{Shares} ||= {}};
+    my($var, $pkg);
+    while(($var, $pkg) = each %$shares) {
+	# warn "share_redo $pkg\:: $var";
+	$obj->share_from($pkg,  [ $var ], 1);
+    }
+}
+sub share_forget {
+    delete shift->{Shares};
+}
+
+sub varglob {
+    my ($obj, $var) = @_;
+    no strict 'refs';
+    return *{$obj->root()."::$var"};
+}
+
+
+sub reval {
+    my ($obj, $expr, $strict) = @_;
+    my $root = $obj->{Root};
+
+    my $evalsub = lexless_anon_sub($root,$strict, $expr);
+    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+}
+
+sub rdo {
+    my ($obj, $file) = @_;
+    my $root = $obj->{Root};
+
+    my $evalsub = eval
+	    sprintf('package %s; sub { @_ = (); do $file }', $root);
+    return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub);
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Safe - Compile and execute code in restricted compartments
+
+=head1 SYNOPSIS
+
+  use Safe;
+
+  $compartment = new Safe;
+
+  $compartment->permit(qw(time sort :browse));
+
+  $result = $compartment->reval($unsafe_code);
+
+=head1 DESCRIPTION
+
+The Safe extension module allows the creation of compartments
+in which perl code can be evaluated. Each compartment has
+
+=over 8
+
+=item a new namespace
+
+The "root" of the namespace (i.e. "main::") is changed to a
+different package and code evaluated in the compartment cannot
+refer to variables outside this namespace, even with run-time
+glob lookups and other tricks.
+
+Code which is compiled outside the compartment can choose to place
+variables into (or I<share> variables with) the compartment's namespace
+and only that data will be visible to code evaluated in the
+compartment.
+
+By default, the only variables shared with compartments are the
+"underscore" variables $_ and @_ (and, technically, the less frequently
+used %_, the _ filehandle and so on). This is because otherwise perl
+operators which default to $_ will not work and neither will the
+assignment of arguments to @_ on subroutine entry.
+
+=item an operator mask
+
+Each compartment has an associated "operator mask". Recall that
+perl code is compiled into an internal format before execution.
+Evaluating perl code (e.g. via "eval" or "do 'file'") causes
+the code to be compiled into an internal format and then,
+provided there was no error in the compilation, executed.
+Code evaluated in a compartment compiles subject to the
+compartment's operator mask. Attempting to evaluate code in a
+compartment which contains a masked operator will cause the
+compilation to fail with an error. The code will not be executed.
+
+The default operator mask for a newly created compartment is
+the ':default' optag.
+
+It is important that you read the L<Opcode> module documentation
+for more information, especially for detailed definitions of opnames,
+optags and opsets.
+
+Since it is only at the compilation stage that the operator mask
+applies, controlled access to potentially unsafe operations can
+be achieved by having a handle to a wrapper subroutine (written
+outside the compartment) placed into the compartment. For example,
+
+    $cpt = new Safe;
+    sub wrapper {
+        # vet arguments and perform potentially unsafe operations
+    }
+    $cpt->share('&wrapper');
+
+=back
+
+
+=head1 WARNING
+
+The authors make B<no warranty>, implied or otherwise, about the
+suitability of this software for safety or security purposes.
+
+The authors shall not in any case be liable for special, incidental,
+consequential, indirect or other similar damages arising from the use
+of this software.
+
+Your mileage will vary. If in any doubt B<do not use it>.
+
+
+=head2 RECENT CHANGES
+
+The interface to the Safe module has changed quite dramatically since
+version 1 (as supplied with Perl5.002). Study these pages carefully if
+you have code written to use Safe version 1 because you will need to
+makes changes.
+
+
+=head2 Methods in class Safe
+
+To create a new compartment, use
+
+    $cpt = new Safe;
+
+Optional argument is (NAMESPACE), where NAMESPACE is the root namespace
+to use for the compartment (defaults to "Safe::Root0", incremented for
+each new compartment).
+
+Note that version 1.00 of the Safe module supported a second optional
+parameter, MASK.  That functionality has been withdrawn pending deeper
+consideration. Use the permit and deny methods described below.
+
+The following methods can then be used on the compartment
+object returned by the above constructor. The object argument
+is implicit in each case.
+
+
+=over 8
+
+=item permit (OP, ...)
+
+Permit the listed operators to be used when compiling code in the
+compartment (in I<addition> to any operators already permitted).
+
+You can list opcodes by names, or use a tag name; see
+L<Opcode/"Predefined Opcode Tags">.
+
+=item permit_only (OP, ...)
+
+Permit I<only> the listed operators to be used when compiling code in
+the compartment (I<no> other operators are permitted).
+
+=item deny (OP, ...)
+
+Deny the listed operators from being used when compiling code in the
+compartment (other operators may still be permitted).
+
+=item deny_only (OP, ...)
+
+Deny I<only> the listed operators from being used when compiling code
+in the compartment (I<all> other operators will be permitted).
+
+=item trap (OP, ...)
+
+=item untrap (OP, ...)
+
+The trap and untrap methods are synonyms for deny and permit
+respectfully.
+
+=item share (NAME, ...)
+
+This shares the variable(s) in the argument list with the compartment.
+This is almost identical to exporting variables using the L<Exporter>
+module.
+
+Each NAME must be the B<name> of a non-lexical variable, typically
+with the leading type identifier included. A bareword is treated as a
+function name.
+
+Examples of legal names are '$foo' for a scalar, '@foo' for an
+array, '%foo' for a hash, '&foo' or 'foo' for a subroutine and '*foo'
+for a glob (i.e.  all symbol table entries associated with "foo",
+including scalar, array, hash, sub and filehandle).
+
+Each NAME is assumed to be in the calling package. See share_from
+for an alternative method (which share uses).
+
+=item share_from (PACKAGE, ARRAYREF)
+
+This method is similar to share() but allows you to explicitly name the
+package that symbols should be shared from. The symbol names (including
+type characters) are supplied as an array reference.
+
+    $safe->share_from('main', [ '$foo', '%bar', 'func' ]);
+
+
+=item varglob (VARNAME)
+
+This returns a glob reference for the symbol table entry of VARNAME in
+the package of the compartment. VARNAME must be the B<name> of a
+variable without any leading type marker. For example,
+
+    $cpt = new Safe 'Root';
+    $Root::foo = "Hello world";
+    # Equivalent version which doesn't need to know $cpt's package name:
+    ${$cpt->varglob('foo')} = "Hello world";
+
+
+=item reval (STRING, STRICT)
+
+This evaluates STRING as perl code inside the compartment.
+
+The code can only see the compartment's namespace (as returned by the
+B<root> method). The compartment's root package appears to be the
+C<main::> package to the code inside the compartment.
+
+Any attempt by the code in STRING to use an operator which is not permitted
+by the compartment will cause an error (at run-time of the main program
+but at compile-time for the code in STRING).  The error is of the form
+"'%s' trapped by operation mask...".
+
+If an operation is trapped in this way, then the code in STRING will
+not be executed. If such a trapped operation occurs or any other
+compile-time or return error, then $@ is set to the error message, just
+as with an eval().
+
+If there is no error, then the method returns the value of the last
+expression evaluated, or a return statement may be used, just as with
+subroutines and B<eval()>. The context (list or scalar) is determined
+by the caller as usual.
+
+This behaviour differs from the beta distribution of the Safe extension
+where earlier versions of perl made it hard to mimic the return
+behaviour of the eval() command and the context was always scalar.
+
+The formerly undocumented STRICT argument sets strictness: if true
+'use strict;' is used, otherwise it uses 'no strict;'. B<Note>: if
+STRICT is omitted 'no strict;' is the default.
+
+Some points to note:
+
+If the entereval op is permitted then the code can use eval "..." to
+'hide' code which might use denied ops. This is not a major problem
+since when the code tries to execute the eval it will fail because the
+opmask is still in effect. However this technique would allow clever,
+and possibly harmful, code to 'probe' the boundaries of what is
+possible.
+
+Any string eval which is executed by code executing in a compartment,
+or by code called from code executing in a compartment, will be eval'd
+in the namespace of the compartment. This is potentially a serious
+problem.
+
+Consider a function foo() in package pkg compiled outside a compartment
+but shared with it. Assume the compartment has a root package called
+'Root'. If foo() contains an eval statement like eval '$foo = 1' then,
+normally, $pkg::foo will be set to 1.  If foo() is called from the
+compartment (by whatever means) then instead of setting $pkg::foo, the
+eval will actually set $Root::pkg::foo.
+
+This can easily be demonstrated by using a module, such as the Socket
+module, which uses eval "..." as part of an AUTOLOAD function. You can
+'use' the module outside the compartment and share an (autoloaded)
+function with the compartment. If an autoload is triggered by code in
+the compartment, or by any code anywhere that is called by any means
+from the compartment, then the eval in the Socket module's AUTOLOAD
+function happens in the namespace of the compartment. Any variables
+created or used by the eval'd code are now under the control of
+the code in the compartment.
+
+A similar effect applies to I<all> runtime symbol lookups in code
+called from a compartment but not compiled within it.
+
+
+
+=item rdo (FILENAME)
+
+This evaluates the contents of file FILENAME inside the compartment.
+See above documentation on the B<reval> method for further details.
+
+=item root (NAMESPACE)
+
+This method returns the name of the package that is the root of the
+compartment's namespace.
+
+Note that this behaviour differs from version 1.00 of the Safe module
+where the root module could be used to change the namespace. That
+functionality has been withdrawn pending deeper consideration.
+
+=item mask (MASK)
+
+This is a get-or-set method for the compartment's operator mask.
+
+With no MASK argument present, it returns the current operator mask of
+the compartment.
+
+With the MASK argument present, it sets the operator mask for the
+compartment (equivalent to calling the deny_only method).
+
+=back
+
+
+=head2 Some Safety Issues
+
+This section is currently just an outline of some of the things code in
+a compartment might do (intentionally or unintentionally) which can
+have an effect outside the compartment.
+
+=over 8
+
+=item Memory
+
+Consuming all (or nearly all) available memory.
+
+=item CPU
+
+Causing infinite loops etc.
+
+=item Snooping
+
+Copying private information out of your system. Even something as
+simple as your user name is of value to others. Much useful information
+could be gleaned from your environment variables for example.
+
+=item Signals
+
+Causing signals (especially SIGFPE and SIGALARM) to affect your process.
+
+Setting up a signal handler will need to be carefully considered
+and controlled.  What mask is in effect when a signal handler
+gets called?  If a user can get an imported function to get an
+exception and call the user's signal handler, does that user's
+restricted mask get re-instated before the handler is called?
+Does an imported handler get called with its original mask or
+the user's one?
+
+=item State Changes
+
+Ops such as chdir obviously effect the process as a whole and not just
+the code in the compartment. Ops such as rand and srand have a similar
+but more subtle effect.
+
+=back
+
+=head2 AUTHOR
+
+Originally designed and implemented by Malcolm Beattie.
+
+Reworked to use the Opcode module and other changes added by Tim Bunce.
+
+Currently maintained by the Perl 5 Porters, <perl5-porters@perl.org>.
+
+=cut
+
diff --git a/dist/Safe/t/safe1.t b/dist/Safe/t/safe1.t
new file mode 100644
index 0000000000..385d6610c5
--- /dev/null
+++ b/dist/Safe/t/safe1.t
@@ -0,0 +1,67 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+
+}
+
+# Tests Todo:
+#	'main' as root
+
+package test;	# test from somewhere other than main
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+	opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+my $t = 1;
+my $cpt;
+# create and destroy some automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root" or die;
+
+foreach(1..3) {
+	$foo = 42;
+
+	$cpt->share(qw($foo));
+
+	print ${$cpt->varglob('foo')}       == 42 ? "ok $t\n" : "not ok $t\n"; $t++;
+
+	${$cpt->varglob('foo')} = 9;
+
+	print $foo == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+
+	print $cpt->reval('$foo')       == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	# check 'main' has been changed:
+	print $cpt->reval('$::foo')     == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	print $cpt->reval('$main::foo') == 9	? "ok $t\n" : "not ok $t\n"; $t++;
+	# check we can't see our test package:
+	print $cpt->reval('$test::foo')     	? "not ok $t\n" : "ok $t\n"; $t++;
+	print $cpt->reval('${"test::foo"}')		? "not ok $t\n" : "ok $t\n"; $t++;
+
+	$cpt->erase;	# erase the compartment, e.g., delete all variables
+
+	print $cpt->reval('$foo') ? "not ok $t\n" : "ok $t\n"; $t++;
+
+	# Note that we *must* use $cpt->varglob here because if we used
+	# $Root::foo etc we would still see the original values!
+	# This seems to be because the compiler has created an extra ref.
+
+	print ${$cpt->varglob('foo')} ? "not ok $t\n" : "ok $t\n"; $t++;
+}
+
+print "ok $last_test\n";
+BEGIN { $last_test = 28 }
diff --git a/dist/Safe/t/safe2.t b/dist/Safe/t/safe2.t
new file mode 100644
index 0000000000..2548dcc6e8
--- /dev/null
+++ b/dist/Safe/t/safe2.t
@@ -0,0 +1,153 @@
+#!./perl -w
+$|=1;
+BEGIN {
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n";
+        exit 0;
+    }
+}
+
+# Tests Todo:
+#	'main' as root
+
+use vars qw($bar);
+
+use Opcode 1.00, qw(opdesc opset opset_to_ops opset_to_hex
+	opmask_add full_opset empty_opset opcodes opmask define_optag);
+
+use Safe 1.00;
+
+my $last_test; # initalised at end
+print "1..$last_test\n";
+
+# Set up a package namespace of things to be visible to the unsafe code
+$Root::foo = "visible";
+$bar = "invisible";
+
+# Stop perl from moaning about identifies which are apparently only used once
+$Root::foo .= "";
+
+my $cpt;
+# create and destroy a couple of automatic Safe compartments first
+$cpt = new Safe or die;
+$cpt = new Safe or die;
+
+$cpt = new Safe "Root";
+
+$cpt->permit(qw(:base_io));
+
+$cpt->reval(q{ system("echo not ok 1"); });
+if ($@ =~ /^'?system'? trapped by operation mask/) {
+    print "ok 1\n";
+} else {
+    print "#$@" if $@;
+    print "not ok 1\n";
+}
+
+$cpt->reval(q{
+    print $foo eq 'visible'		? "ok 2\n" : "not ok 2\n";
+    print $main::foo  eq 'visible'	? "ok 3\n" : "not ok 3\n";
+    print defined($bar)			? "not ok 4\n" : "ok 4\n";
+    print defined($::bar)		? "not ok 5\n" : "ok 5\n";
+    print defined($main::bar)		? "not ok 6\n" : "ok 6\n";
+});
+print $@ ? "not ok 7\n#$@" : "ok 7\n";
+
+$foo = "ok 8\n";
+%bar = (key => "ok 9\n");
+@baz = (); push(@baz, "o", "10"); $" = 'k ';
+$glob = "ok 11\n";
+@glob = qw(not ok 16);
+
+sub sayok { print "ok @_\n" }
+
+$cpt->share(qw($foo %bar @baz *glob sayok));
+$cpt->share('$"') unless $Config{use5005threads};
+
+$cpt->reval(q{
+    package other;
+    sub other_sayok { print "ok @_\n" }
+    package main;
+    print $foo ? $foo : "not ok 8\n";
+    print $bar{key} ? $bar{key} : "not ok 9\n";
+    (@baz) ? print "@baz\n" : print "not ok 10\n";
+    print $glob;
+    other::other_sayok(12);
+    $foo =~ s/8/14/;
+    $bar{new} = "ok 15\n";
+    @glob = qw(ok 16);
+});
+print $@ ? "not ok 13\n#$@" : "ok 13\n";
+$" = ' ';
+print $foo, $bar{new}, "@glob\n";
+
+$Root::foo = "not ok 17";
+@{$cpt->varglob('bar')} = qw(not ok 18);
+${$cpt->varglob('foo')} = "ok 17";
+@Root::bar = "ok";
+push(@Root::bar, "18"); # Two steps to prevent "Identifier used only once..."
+
+print "$Root::foo\n";
+print "@{$cpt->varglob('bar')}\n";
+
+use strict;
+
+print 1 ? "ok 19\n" : "not ok 19\n";
+print 1 ? "ok 20\n" : "not ok 20\n";
+
+my $m1 = $cpt->mask;
+$cpt->trap("negate");
+my $m2 = $cpt->mask;
+my @masked = opset_to_ops($m1);
+print $m2 eq opset("negate", @masked) ? "ok 21\n" : "not ok 21\n";
+
+print eval { $cpt->mask("a bad mask") } ? "not ok 22\n" : "ok 22\n";
+
+print $cpt->reval("2 + 2") == 4 ? "ok 23\n" : "not ok 23\n";
+
+$cpt->mask(empty_opset);
+my $t_scalar = $cpt->reval('print wantarray ? "not ok 24\n" : "ok 24\n"');
+print $cpt->reval('@ary=(6,7,8);@ary') == 3 ? "ok 25\n" : "not ok 25\n";
+my @t_array  = $cpt->reval('print wantarray ? "ok 26\n" : "not ok 26\n"; (2,3,4)');
+print $t_array[2] == 4 ? "ok 27\n" : "not ok 27\n";
+
+my $t_scalar2 = $cpt->reval('die "foo bar"; 1');
+print defined $t_scalar2 ? "not ok 28\n" : "ok 28\n";
+print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n";
+
+# --- rdo
+  
+my $t = 30;
+$! = 0;
+my $nosuch = '/non/existant/file.name';
+open(NOSUCH, $nosuch);
+if ($@) {
+    my $errno  = $!;
+    die "Eek! Attempting to open $nosuch failed, but \$! is still 0" unless $!;
+    $! = 0;
+    $cpt->rdo($nosuch);
+    print $! == $errno ? "ok $t\n" : sprintf "not ok $t # \"$!\" is %d (expected %d)\n", $!, $errno; $t++;
+} else {
+    die "Eek! Didn't expect $nosuch to be there.";
+}
+close(NOSUCH);
+
+# test #31 is gone.
+print "ok $t\n"; $t++;
+  
+#my $rdo_file = "tmp_rdo.tpl";
+#if (open X,">$rdo_file") {
+#    print X "999\n";
+#    close X;
+#    $cpt->permit_only('const', 'leaveeval');
+#    print  $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++;
+#    unlink $rdo_file;
+#}
+#else {
+#    print "# test $t skipped, can't open file: $!\nok $t\n"; $t++;
+#}
+
+
+print "ok $last_test\n";
+BEGIN { $last_test = 32 }
diff --git a/dist/Safe/t/safe3.t b/dist/Safe/t/safe3.t
new file mode 100644
index 0000000000..1f99f49ed9
--- /dev/null
+++ b/dist/Safe/t/safe3.t
@@ -0,0 +1,46 @@
+#!perl -w
+
+BEGIN {
+    require Config; import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/
+	&& $Config{'extensions'} !~ /\bPOSIX\b/
+	&& $Config{'osname'} ne 'VMS')
+    {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use POSIX qw(ceil);
+use Test::More tests => 2;
+use Safe;
+
+my $safe = new Safe;
+$safe->deny('add');
+
+my $masksize = ceil( Opcode::opcodes / 8 );
+# Attempt to change the opmask from within the safe compartment
+$safe->reval( qq{\$_[1] = qq/\0/ x } . $masksize );
+
+# Check that it didn't work
+$safe->reval( q{$x + $y} );
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
+	    'opmask still in place with reval' );
+
+my $safe2 = new Safe;
+$safe2->deny('add');
+
+open my $fh, '>nasty.pl' or die "Can't write nasty.pl: $!\n";
+print $fh <<EOF;
+\$_[1] = "\0" x $masksize;
+EOF
+close $fh;
+$safe2->rdo('nasty.pl');
+$safe2->reval( q{$x + $y} );
+# Written this way to keep the Test::More that comes with perl 5.6.2 happy
+ok( $@ =~ /^'?addition \(\+\)'? trapped by operation mask/,
+	    'opmask still in place with rdo' );
+END { unlink 'nasty.pl' }
diff --git a/dist/Safe/t/safeload.t b/dist/Safe/t/safeload.t
new file mode 100644
index 0000000000..2d2c3ccb4a
--- /dev/null
+++ b/dist/Safe/t/safeload.t
@@ -0,0 +1,26 @@
+#!perl
+
+BEGIN {
+    require Config;
+    import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+    # Can we load the version module ?
+    eval { require version; 1 } or do {
+	print "1..0 # no version.pm\n";
+	exit 0;
+    };
+    delete $INC{"version.pm"};
+}
+
+use strict;
+use Test::More;
+use Safe;
+plan(tests => 1);
+
+my $c = new Safe;
+$c->permit(qw(require caller entereval unpack));
+my $r = $c->reval(q{ use version; 1 });
+ok( defined $r, "Can load version.pm in a Safe compartment" ) or diag $@;
diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t
new file mode 100644
index 0000000000..bd8217d8dc
--- /dev/null
+++ b/dist/Safe/t/safeops.t
@@ -0,0 +1,428 @@
+#!perl
+# Tests that all ops can be trapped by a Safe compartment
+
+BEGIN {
+    unless ($ENV{PERL_CORE}) {
+	# this won't work outside of the core, so exit
+        print "1..0 # skipped: PERL_CORE unset\n"; exit 0;
+    }
+}
+use Config;
+BEGIN {
+    if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+        print "1..0\n"; exit 0;
+    }
+}
+
+use strict;
+use Test::More;
+use Safe;
+
+# Read the op names and descriptions directly from opcode.pl
+my @op;
+my %code;
+
+while (<DATA>) {
+    chomp;
+    die "Can't match $_" unless /^([a-z_0-9]+)\t+(.*)/;
+    $code{$1} = $2;
+}
+
+open my $fh, '<', '../../opcode.pl' or die "Can't open opcode.pl: $!";
+while (<$fh>) {
+    last if /^__END__/;
+}
+while (<$fh>) {
+    chomp;
+    next if !$_ or /^#/;
+    my ($op, $opname) = split /\t+/;
+    push @op, [$op, $opname, $code{$op}];
+}
+close $fh;
+
+plan(tests => scalar @op);
+
+sub testop {
+    my ($op, $opname, $code) = @_;
+    pass("$op : skipped") and return if $code =~ /^SKIP/;
+    pass("$op : skipped") and return if $code =~ m://|~~: && $] < 5.010;
+    my $c = new Safe;
+    $c->deny_only($op);
+    $c->reval($code);
+    like($@, qr/'\Q$opname\E' trapped by operation mask/, $op);
+}
+
+foreach (@op) {
+    if ($_->[2]) {
+	testop @$_;
+    } else {
+	local $TODO = "No test yet for $_->[1]";
+	fail();
+    }
+}
+
+# things that begin with SKIP are skipped, for various reasons (notably
+# optree modified by the optimizer -- Safe checks are done before the
+# optimizer modifies the optree)
+
+__DATA__
+null		SKIP
+stub		SKIP
+scalar		scalar $x
+pushmark	print @x
+wantarray	wantarray
+const		42
+gvsv		SKIP (set by optimizer) $x
+gv		SKIP *x
+gelem		*x{SCALAR}
+padsv		SKIP my $x
+padav		SKIP my @x
+padhv		SKIP my %x
+padany		SKIP (not implemented)
+pushre		SKIP split /foo/
+rv2gv		*x
+rv2sv		$x
+av2arylen	$#x
+rv2cv		f()
+anoncode	sub { }
+prototype	prototype 'foo'
+refgen		\($x,$y)
+srefgen		SKIP \$x
+ref		ref
+bless		bless
+backtick	qx/ls/
+glob		<*.c>
+readline	<FH>
+rcatline	SKIP (set by optimizer) $x .= <F>
+regcmaybe	SKIP (internal)
+regcreset	SKIP (internal)
+regcomp		SKIP (internal)
+match		/foo/
+qr		qr/foo/
+subst		s/foo/bar/
+substcont	SKIP (set by optimizer)
+trans		y:z:t:
+sassign		$x = $y
+aassign		@x = @y
+chop		chop @foo
+schop		chop
+chomp		chomp @foo
+schomp		chomp
+defined		defined
+undef		undef
+study		study
+pos		pos
+preinc		++$i
+i_preinc	SKIP (set by optimizer)
+predec		--$i
+i_predec	SKIP (set by optimizer)
+postinc		$i++
+i_postinc	SKIP (set by optimizer)
+postdec		$i--
+i_postdec	SKIP (set by optimizer)
+pow		$x ** $y
+multiply	$x * $y
+i_multiply	SKIP (set by optimizer)
+divide		$x / $y
+i_divide	SKIP (set by optimizer)
+modulo		$x % $y
+i_modulo	SKIP (set by optimizer)
+repeat		$x x $y
+add		$x + $y
+i_add		SKIP (set by optimizer)
+subtract	$x - $y
+i_subtract	SKIP (set by optimizer)
+concat		$x . $y
+stringify	"$x"
+left_shift	$x << 1
+right_shift	$x >> 1
+lt		$x < $y
+i_lt		SKIP (set by optimizer)
+gt		$x > $y
+i_gt		SKIP (set by optimizer)
+le		$i <= $y
+i_le		SKIP (set by optimizer)
+ge		$i >= $y
+i_ge		SKIP (set by optimizer)
+eq		$x == $y
+i_eq		SKIP (set by optimizer)
+ne		$x != $y
+i_ne		SKIP (set by optimizer)
+ncmp		$i <=> $y
+i_ncmp		SKIP (set by optimizer)
+slt		$x lt $y
+sgt		$x gt $y
+sle		$x le $y
+sge		$x ge $y
+seq		$x eq $y
+sne		$x ne $y
+scmp		$x cmp $y
+bit_and		$x & $y
+bit_xor		$x ^ $y
+bit_or		$x | $y
+negate		-$x
+i_negate	SKIP (set by optimizer)
+not		!$x
+complement	~$x
+atan2		atan2 1
+sin		sin 1
+cos		cos 1
+rand		rand
+srand		srand
+exp		exp 1
+log		log 1
+sqrt		sqrt 1
+int		int
+hex		hex
+oct		oct
+abs		abs
+length		length
+substr		substr $x, 1
+vec		vec
+index		index
+rindex		rindex
+sprintf		sprintf '%s', 'foo'
+formline	formline
+ord		ord
+chr		chr
+crypt		crypt 'foo','bar'
+ucfirst		ucfirst
+lcfirst		lcfirst
+uc		uc
+lc		lc
+quotemeta	quotemeta
+rv2av		@a
+aelemfast	SKIP (set by optimizer)
+aelem		$a[1]
+aslice		@a[1,2]
+each		each %h
+values		values %h
+keys		keys %h
+delete		delete $h{Key}
+exists		exists $h{Key}
+rv2hv		%h
+helem		$h{kEy}
+hslice		@h{kEy}
+unpack		unpack
+pack		pack
+split		split /foo/
+join		join $a, @b
+list		@x = (1,2)
+lslice		SKIP @x[1,2]
+anonlist	[1,2]
+anonhash	{ a => 1 }
+splice		splice @x, 1, 2, 3
+push		push @x, $x
+pop		pop @x
+shift		shift @x
+unshift		unshift @x
+sort		sort @x
+reverse		reverse @x
+grepstart	grep { $_ eq 'foo' } @x
+grepwhile	SKIP grep { $_ eq 'foo' } @x
+mapstart	map $_ + 1, @foo
+mapwhile	SKIP (set by optimizer)
+range		SKIP
+flip		1..2
+flop		1..2
+and		$x && $y
+or		$x || $y
+xor		$x xor $y
+cond_expr	$x ? 1 : 0
+andassign	$x &&= $y
+orassign	$x ||= $y
+method		Foo->$x()
+entersub	f()
+leavesub	sub f{} f()
+leavesublv	sub f:lvalue{return $x} f()
+caller		caller
+warn		warn
+die		die
+reset		reset
+lineseq		SKIP
+nextstate	SKIP
+dbstate		SKIP (needs debugger)
+unstack		while(0){}
+enter		SKIP
+leave		SKIP
+scope		SKIP
+enteriter	SKIP
+iter		SKIP
+enterloop	SKIP
+leaveloop	SKIP
+return		return
+last		last
+next		next
+redo		redo THIS
+dump		dump
+goto		goto THERE
+exit		exit 0
+open		open FOO
+close		close FOO
+pipe_op		pipe FOO,BAR
+fileno		fileno FOO
+umask		umask 0755, 'foo'
+binmode		binmode FOO
+tie		tie
+untie		untie
+tied		tied
+dbmopen		dbmopen
+dbmclose	dbmclose
+sselect		SKIP (set by optimizer)
+select		select FOO
+getc		getc FOO
+read		read FOO
+enterwrite	write
+leavewrite	SKIP
+prtf		printf
+print		print
+sysopen		sysopen
+sysseek		sysseek
+sysread		sysread
+syswrite	syswrite
+send		send
+recv		recv
+eof		eof FOO
+tell		tell
+seek		seek FH, $pos, $whence
+truncate	truncate FOO, 42
+fcntl		fcntl
+ioctl		ioctl
+flock		flock FOO, 1
+socket		socket
+sockpair	socketpair
+bind		bind
+connect		connect
+listen		listen
+accept		accept
+shutdown	shutdown
+gsockopt	getsockopt
+ssockopt	setsockopt
+getsockname	getsockname
+getpeername	getpeername
+lstat		lstat FOO
+stat		stat FOO
+ftrread		-R
+ftrwrite	-W
+ftrexec		-X
+fteread		-r
+ftewrite	-w
+fteexec		-x
+ftis		-e
+fteowned	SKIP -O
+ftrowned	SKIP -o
+ftzero		-z
+ftsize		-s
+ftmtime		-M
+ftatime		-A
+ftctime		-C
+ftsock		-S
+ftchr		-c
+ftblk		-b
+ftfile		-f
+ftdir		-d
+ftpipe		-p
+ftlink		-l
+ftsuid		-u
+ftsgid		-g
+ftsvtx		-k
+fttty		-t
+fttext		-T
+ftbinary	-B
+chdir		chdir '/'
+chown		chown
+chroot		chroot
+unlink		unlink 'foo'
+chmod		chmod 511, 'foo'
+utime		utime
+rename		rename 'foo', 'bar'
+link		link 'foo', 'bar'
+symlink		symlink 'foo', 'bar'
+readlink	readlink 'foo'
+mkdir		mkdir 'foo'
+rmdir		rmdir 'foo'
+open_dir	opendir DIR
+readdir		readdir DIR
+telldir		telldir DIR
+seekdir		seekdir DIR, $pos
+rewinddir	rewinddir DIR
+closedir	closedir DIR
+fork		fork
+wait		wait
+waitpid		waitpid
+system		system
+exec		exec
+kill		kill
+getppid		getppid
+getpgrp		getpgrp
+setpgrp		setpgrp
+getpriority	getpriority
+setpriority	setpriority
+time		time
+tms		times
+localtime	localtime
+gmtime		gmtime
+alarm		alarm
+sleep		sleep 1
+shmget		shmget
+shmctl		shmctl
+shmread		shmread
+shmwrite	shmwrite
+msgget		msgget
+msgctl		msgctl
+msgsnd		msgsnd
+msgrcv		msgrcv
+semget		semget
+semctl		semctl
+semop		semop
+require		use strict
+dofile		do 'file'
+entereval	eval "1+1"
+leaveeval	eval "1+1"
+entertry	SKIP eval { 1+1 }
+leavetry	SKIP eval { 1+1 }
+ghbyname	gethostbyname 'foo'
+ghbyaddr	gethostbyaddr 'foo'
+ghostent	gethostent
+gnbyname	getnetbyname 'foo'
+gnbyaddr	getnetbyaddr 'foo'
+gnetent		getnetent
+gpbyname	getprotobyname 'foo'
+gpbynumber	getprotobynumber 42
+gprotoent	getprotoent
+gsbyname	getservbyname 'name', 'proto'
+gsbyport	getservbyport 'a', 'b'
+gservent	getservent
+shostent	sethostent
+snetent		setnetent
+sprotoent	setprotoent
+sservent	setservent
+ehostent	endhostent
+enetent		endnetent
+eprotoent	endprotoent
+eservent	endservent
+gpwnam		getpwnam
+gpwuid		getpwuid
+gpwent		getpwent
+spwent		setpwent
+epwent		endpwent
+ggrnam		getgrnam
+ggrgid		getgrgid
+ggrent		getgrent
+sgrent		setgrent
+egrent		endgrent
+getlogin	getlogin
+syscall		syscall
+lock		SKIP
+threadsv	SKIP
+setstate	SKIP
+method_named	$x->y()
+dor		$x // $y
+dorassign	$x //= $y
+once		SKIP {use feature 'state'; state $foo = 42;}
+say		SKIP {use feature 'say'; say "foo";}
+smartmatch	$x ~~ $y
+aeach		SKIP each @t
+akeys		SKIP keys @t
+avalues		SKIP values @t
+custom		SKIP (no way)
diff --git a/dist/Safe/t/safeuniversal.t b/dist/Safe/t/safeuniversal.t
new file mode 100644
index 0000000000..95867c5a1f
--- /dev/null
+++ b/dist/Safe/t/safeuniversal.t
@@ -0,0 +1,46 @@
+#!perl
+
+BEGIN {
+    require Config;
+    import Config;
+    if ($Config{'extensions'} !~ /\bOpcode\b/) {
+	print "1..0\n";
+	exit 0;
+    }
+}
+
+use strict;
+use warnings;
+use Test::More;
+use Safe;
+plan(tests => 6);
+
+my $c = new Safe;
+$c->permit(qw(require caller));
+
+my $no_warn_redef = ($] != 5.008009)
+    ? q(no warnings 'redefine';)
+    : q($SIG{__WARN__}=sub{};);
+my $r = $c->reval($no_warn_redef . q!
+    sub UNIVERSAL::isa { "pwned" }
+    (bless[],"Foo")->isa("Foo");
+!);
+
+is( $r, "pwned", "isa overriden in compartment" );
+is( (bless[],"Foo")->isa("Foo"), 1, "... but not outside" );
+
+sub Foo::foo {}
+
+$r = $c->reval($no_warn_redef . q!
+    sub UNIVERSAL::can { "pwned" }
+    (bless[],"Foo")->can("foo");
+!);
+
+is( $r, "pwned", "can overriden in compartment" );
+is( (bless[],"Foo")->can("foo"), \&Foo::foo, "... but not outside" );
+
+$r = $c->reval(q!
+    utf8::is_utf8("\x{100}");
+!);
+is( $@, '', 'can call utf8::is_valid' );
+is( $r, 1, '... returns 1' );