use in Safe compartments

[p5pRT]

Migrated from rt.perl.org#2288 (status was 'resolved')

Searchable as RT2288$

[p5pRT]

From matt@sergeant.org

Created by matt@sergeant.org

Witness​:

use Safe; my $c = Safe->new; $c->permit(qw/​:browse require/); $c->share('$$'); $c->reval('use English; print $PID;'); die $@​ if $@​ __END__ Undefined subroutine &Exporter​::import called at /usr/lib/perl5/5.00503/English.pm line 47. BEGIN failed--compilation aborted at (eval 2) line 1.

The problem is that 'use' in a safe compartment doesn't remove the barrier that safe compartments can't look in other packages\, so

use Exporter;

doesn't allow you to call &Exporter​::import like you can outside of a safe compartment.

My theory is that we need a sort of peephole\, so that if you allow the require permit\, and you use() a module\, you should get a peephole into that package's namespace.

(The motivation for this is a Safe compartment for mod_perl - without this functionality it's useless).

Perl Info

``` This perlbug was built using Perl 5.00503 - Tue Apr 13 04:04:31 CEST 1999 It is being executed now by Perl 5.00557 - Fri Jul 16 22:00:43 /etc/localtime 1999. Site configuration information for perl 5.00503: Configured by root at Tue Apr 13 04:04:31 CEST 1999. Summary of my perl5 (5.0 patchlevel 5 subversion 3) configuration: Platform: osname=linux, osvers=2.2.5-4, archname=i386-linux uname='linux vador 2.2.5-4 #1 tue apr 6 19:46:00 edt 1999 i686 unknown ' hint=recommended, useposix=true, d_sigaction=define usethreads=undef useperlio=undef d_sfio=undef Compiler: cc='cc', optimize='-O2', gccversion=pgcc-2.91.60 19981201 (egcs-1.1.1 release) cppflags='-Dbool=char -DHAS_BOOL -I/usr/local/include' ccflags ='-Dbool=char -DHAS_BOOL -I/usr/local/include' stdchar='char', d_stdstdio=undef, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 alignbytes=4, usemymalloc=n, prototype=define Linker and Libraries: ld='cc', ldflags =' -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib libs=-lnsl -lndbm -lgdbm -ldb -ldl -lm -lc -lposix -lcrypt libc=, so=so, useshrplib=false, libperl=libperl.a Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic' cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib' Locally applied patches: @INC for perl 5.00503: /usr/lib/perl5/5.00503/i386-linux /usr/lib/perl5/5.00503 /usr/lib/perl5/site_perl/5.005/i386-linux /usr/lib/perl5/site_perl/5.005 . Environment for perl 5.00503: HOME=/home/matt LANG (unset) LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/usr/local/bin:/bin:/usr/bin::/usr/X11R6/bin:/var/qmail/bin:/usr/local/sbin:/usr/local/jdk1.2/bin:/opt/sybase/bin:/home/matt/bin:/usr/local/jdk1.2/bin:/opt/sybase/bin PERL_BADLANG (unset) SHELL=/bin/bash ```

[p5pRT]

From [Unknown Contact. See original ticket]

You can't (easily) do that. It's a long story\, and I have plenty of write-up on it. It's not really easily fixable until the rewrite of Safe.

--tom

[p5pRT]

From [Unknown Contact. See original ticket]

On Wed\, 08 Mar 2000\, Tom Christiansen wrote​:

You can't (easily) do that. It's a long story\, and I have plenty of write-up on it. It's not really easily fixable until the rewrite of Safe.

Any volunteers?

PS​: If you know where your write-up's are\, I'd appreciate a forward of them.

-- \

Details​: FastNet Software Ltd - XML\, Perl\, Databases. Tagline​: High Performance Web Solutions Web Sites​: http​://come.to/fastnet http​://sergeant.org Available for Consultancy\, Contracts and Training.

[p5pRT]

From [Unknown Contact. See original ticket]

On Wed\, 08 Mar 2000\, Tom Christiansen wrote​:

You can't (easily) do that. It's a long story\, and I have plenty of write-up on it. It's not really easily fixable until the rewrite of Safe.

Any volunteers?

It's my understanding that Sarathy has plans involving multiple interpreters.

PS​: If you know where your write-up's are\, I'd appreciate a forward of them.

Ok. Here it is\, in two messages\, slightly edited. Don't get too in a tizzy\, though. The bad-news summary is that Safe is broken\, in a bunch of ways. The good-news summary is that it's it's scheduled for rewrite. It's unclear how much the API will change. I'm hoping that ->new\, ->reval\, and ->rdo will all stay\, but much won't\, like maybe the permit/deny stuff; and probably ->new won't take packages so you'll have to bounce through ->varglob to diddle.

  # don't do this​:   use Safe;   my $sandbox = Safe->new("Dungeon");   $Dungeon​::foo = 1;

  # do this​:   use Safe;   my $sandbox = Safe->new();   ${ $sandbox->varglob('foo') } = 1;

I do not know any of this\, though\, and it's mostly just figments from my fevered brain.

--tom

From​: tchrist Date​: Wed\, 01 Mar 2000 11​:17​:00 MST

Sarathy wrote\, regarding the future of Safe​:

Most of the current confusion stems from the fact that we resolve the globs at compile-time and don't ever *invalidate them for safe compartments*. IOW\, the compiled optree is pointing into the stashes directly instead of keeping the symbolic names. What this means is that when the notion of "root" for the symbol table changes\, the compiled optree has no hope of coping with the change\, because it already resolved all the stash pointers when it got compiled.

Perhaps what I'm about to explain is part of what you just said. But I think it's closer to the old dumbness of

  package Alpha;   require 'foo.pl'; # imports stuff into caller\, ie Alpha

  package Beta;   require 'foo.pl'; # ignored\, because foo.pl already loaded

Importing doesn't work in safe. Watch​:

  use strict;   use Safe;

  my $box = Safe->new();   $box->permit(qw/​:default require/);

  $box->reval( q{use Carp;}\, 1);   warn "FIRST​: $@​" if $@​;

  $box->reval( q{carp "try this";}\, 1);   warn "SECOND​: $@​" if $@​;

  $box->reval( q{use Carp qw/cluck/; cluck "darn it!"}\, 1);   warn "THIRD $@​" if $@​;

That produces​: (in pl650)

  String found where operator expected at (eval 4) line 1\, near "carp "try this""   (Do you need to predeclare carp?)   SECOND​: syntax error at (eval 4) line 1\, near "carp "try this""   String found where operator expected at (eval 6) line 1\, near "cluck "darn it!""   (Do you need to predeclare cluck?)   THIRD syntax error at (eval 6) line 1\, near "cluck "darn it!""

This is because Carp.pm was already loaded (verifiable by inspecting %INC) by loading Safe.pm.

I tried $box->share_from( Carp => [ \@​Carp​::EXPORTS ) to no avail.

Notice also that something is during the compilation leaking. I have not tried 670 yet\, but I seem to recall your having fixed some of these.

If you try doing something like

  $sandbox->permit_only(qw/​:default :base_math/);   $sandbox->reval("use Math​::Trig"\, 1); die if $@​;

you get

  Can't locate object method "unimport" via package "strict" at lib/constant.pm line 91.   BEGIN failed--compilation aborted at lib/constant.pm line 91.   Compilation failed in require at lib/Math/Trig.pm line 41.   BEGIN failed--compilation aborted at lib/Math/Trig.pm line 41.   Compilation failed in require at (eval 2) line 2.   BEGIN failed--compilation aborted at (eval 2) line 2.   ...propagated at /tmp/ot1 line 13.

I tried this​:

  $sandbox->share_from('strict'\, [ qw/import unimport/ ]);

But that didn't do any good.

What did work was this​:

  $sandbox = Safe->new("Safe_Calc");   $sandbox->permit_only(qw/​:default :base_math/);   $sandbox->permit(qw/require caller/); # caller is for overload.pm   *Safe_Calc​::strict​::import = \&strict​::import;   *Safe_Calc​::strict​::unimport = \&strict​::unimport;   $sandbox->reval("use Math​::Trig"\, 1); die if $@​;

Well\, "kind" of work. It actually did this​:

  Bareword "pi" not allowed while "strict subs" in use at lib/Math/Trig.pm line 39.   BEGIN not safe after errors--compilation aborted at lib/Math/Trig.pm line 41.   Compilation failed in require at (eval 2) line 2.   BEGIN failed--compilation aborted at (eval 2) line 2.   ...propagated at /tmp/ot1 line 12.

And *that* happened because inside Math/Trig.pm\, this call

  use Math​::Complex qw(​:trig);

did not work\, but neither did it complain! Is this not a bug? This is rather annoying​:

  % perl -e 'use DynaLoader qw/What are you looking at?/'

See\, no complaint. No joy\, either.

Yes\, I know why it's there. It's so you can say "use Module" and the Module\, if it has no import()\, is still allowed to proceed unmolested. This still hardly seems sporting to me.

I believe that when it comes to Safe\, anything that does caller and package manipulation\, like Exporter.pm and overload.pm\, is broken. I'm not even sure whether %INC is being treated "right".

If I am in a Safe compartment named "Box"\, and then use Foo\, then I don't have a %main​::Foo​:: symbol table. I have a %Box​::Foo​:: symbol table instead. Which means that if something outside decides to use Foo again\, it won't find the right package to import from! Likewise\, if something outside did a use Foo\, then if you do it again inside\, Foo->import is really the outside's Box​::Foo->import. Which isn't there.

What it comes down to is that even if I can get the require to work\, I can't get the import to work. And that makes many\, many things not work.

Oh\, have I mentioned hints bits yet?

  use strict;   use Safe;

  my $sandbox = Safe->new("Safe_Calc");   $sandbox->permit_only(qw/​:default :base_math/);

  $sandbox->permit(qw/require caller unpack/);
  $sandbox->reval("use Math​::BigInt qw/​:constant/"\, 1);   die "FIRST​: $@​" if $@​;

  $sandbox->reval("use Math​::BigInt qw/​:constant/; print 2**100"\, 1);   die "SECOND​: $@​" if $@​;

Produces​:

  SECOND​: constant(undef)​: %^H is not defined at (eval 4) line 1\, at end of line   constant(undef)​: %^H is not defined at (eval 4) line 1\, at end of line

  use strict;   use Safe;   my $sandbox = Safe->new();   while (1) {   print "Input​: ";   my $expr = \;   exit unless defined $expr;   chomp($expr);   print "$expr produces ";   local $SIG{__WARN__} = sub { die @​_ };   my $result = $sandbox->reval($expr\, 1);   if ($@​ =~ s/at \(eval \d+\).*//) {   printf "[%s]​: %s"\, $@​ =~ /trapped by operation mask/   ? "Security Violation" : "Exception"\, $@​;   }   else {   print "[Normal Result] $result\n";   }   }

=================================== From​: tchrist Date​: Wed\, 01 Mar 2000 06​:44​:23 MST

That brings me to an important bug​: when in a Safe compartment\, you access a punctuational variable\, it's as though you had really gotten the one from the true main symbol table (although it's actually more complicated than that\, as described below).

For one thing\, this is not documented.

  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.

For another thing\, even if it were documented\, it's wrong. You just don't want that to happen.

Now\, why is this happening?

First\, some anecdotal evidence. If in the compartment\, you print out a magic var's glob\, like C\<*\,>'s glob\, it comes out as C\<*Safe​::Root0​::\,> as you would expect. Likewise\, the \ref to a special variable taken from within the compartment produces a different address than the \ref to the same variable outside the compartment. Therefore\, the faking out of PL_defstash in Opcode's _safe_call_sv is working correctly.

If you need more evidence\, here's the trivial test case​:

  % perl -le '${"Icky​::\,"} = " *SPLAT* "; print 1\,2\,3'   1 *SPLAT* 2 *SPLAT* 3

So\, what's really up?

What's up is that\, thanks to PL_magic_set\, the magically-named variable's side-effecting data value is not stored on that SV itself\, nor is PL_defstash later consulted when you need a magical value. For example\, in the case of the C\<$\,> variable that's been bugging me\, it gets squirrelled away in PL_ofs. When it's time to do printing\, it is PL_ofs which is consulted\, and this is not related to any *{"main​::\,"} value in PL_defstash--although it is related to the current thread pointer\, since it's really vTHX->Tofs. Perhaps it's because these are per-thread variables that this funny little issue comes up.

I do not know the best solution to this is. You can only do so much in the way of documenting it\, but this still doesn't rescue Safe->reval(). After the application of your patch to correctly localize ${^WARNING_BITS} rather than dumping core\, my work-around below inside my safe_reval() *does* appear to work right.

However\, I don't know what I'm not thinking about. Well\, yes I do. For one thing\, I'm not thinking about uid/gid magic variables\, particularly\, because if somebody sets $\< = $> = 23 or whatnot\, no local in the world will restore those to 0 when its scope terminates. For another\, because %SIG is magical\, it has the same issues has silly little C\<$\,> has.

I'm sure I've forgotten some variables that needed mirrored localization\, or at least\, that come some future release\, another will appear that I haven't planned for. I think that at the least\, something like this mass-mirroring local() of mine needs to find its way into Safe->reval and its filevalling pal\, Safe->rdo.

I don't like having to list all the names. What happens if the code gets cut and pasted? And you put it all in a Perl subroutine\, because you've got the wrong scope\, and you can't upscope from Perl. Perhaps using something like your Alias.pm trick\, one could do so from C\, and should\, so that we could just call a function that says to save away all the magical globals stuff.

I'm in no fashion convinced that I've fully thought through this whole matter with all its subtle ramifications. I'm not at all ready to propose any sort of broad solution that would radically alter the way magical values are accessed from within perl's API\, especially as it touches on threading issues. I hope\, though\, that simply applying the appropriate band-aide to on Safe->reval (and Safe->rdo\, of course)\, should be enough to insulate one from the current infelicity. But I'm quite willing to believe that even that little bit is less than the whole of the matter.

#!/usr/bin/perl -w

use strict; use Safe;

$SIG{__WARN__} = sub { die "[Fatal Warning] @​_" };

my $result;

my $sandbox = Safe->new("touchmenot");

$\, = ''; print "TEST 1​: Trying assignment to \$\,\n"; $result = $sandbox->reval('$\, = " *SPLAT* "'); if ($@​) { print "GOTCHA1​: $@​"; } elsif ($\, =~ /SPLAT/) { print "Naughty reval touched my variable!\n" } else { print "result was $result\n"; }

$\, = ''; print "\nTEST 2​: Trying assignment to \${main​::\,}\n"; # can't use "$​::\," so bounce through $result = $sandbox->reval('${"main​::\,"} = " *SPLAT* "'); if ($@​) { print "GOTCHA2​: $@​"; } elsif ($\, =~ /SPLAT/) { print "Naughty reval touched my variable!\n" } else { print "Cool result was $result\n"; }

$\, = ''; print "\nTEST 3​: Trying assignment to \$​::\,\n"; # can't use "$​::\," so bounce through $result = $sandbox->reval('${"​::\,"} = " *SPLAT* "'); if ($@​) { print "GOTCHA3​: $@​"; } elsif ($\, =~ /SPLAT/) { print "Naughty reval touched my variable!\n" } else { print "Cool result was $result\n"; }

$\, = ''; print "\nTEST 4​: Trying \$\, again through safe_reval\n"; $result = safe_reval($sandbox\, '$\, = " *SPLAT* "'); if ($@​) { print "GOTCHA4​: $@​"; } elsif ($\, =~ /SPLAT/) { print "Naughty reval touched my variable!\n" } else { print "Cool result was $result\n"; }

sub safe_reval {   my $box = shift;   my $code = shift;

  # this is just to silence warnings in the big local()   # while touching deprecated variables; it doesn't reach   # down into the reval\, as that's a different scope   no warnings;

  # create doppelglobals so reval can't overreach   # can't preserve $@​ or lose detection of reval failure   local (   $0 \, $! \, $" \, $# \, $$ \, $\, \, $. \, $/ \, $​: \,   $; \, $? \, $\ \, $] \, $^A \, $^C \, $^D \, $^E \,   $^F \, $^H \, $^I \, $^L \, $^M \, $^O \, $^P \, $^R \, $^S \,   $^T \, $^V \, $^W \, $^X \,   ${^WARNING_BITS}\, ${^WIDE_SYSTEM_CALLS}\,   $SIG{__WARN__}\, $SIG{__DIE__}\,

  ) = (   $0 \, $! \, $" \, $# \, $$ \, $\, \, $. \, $/ \, $​: \,   $; \, $? \, $\ \, $] \, $^A \, $^C \, $^D \, $^E \,   $^F \, $^H \, $^I \, $^L \, $^M \, $^O \, $^P \, $^R \, $^S \,   $^T \, $^V \, $^W \, $^X \,   ${^WARNING_BITS}\, ${^WIDE_SYSTEM_CALLS}\,   $SIG{__WARN__}\, $SIG{__DIE__}\,   );

  return $box->reval($code\, 1);

# saved globals restored here upon sub scope exit

}