Sharing leak root name into safe compartment

[p5pRT]

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

Searchable as RT3927$

[p5pRT]

From @gisle

Created by gisle@eik.g.aas.no

-------------------------------------------- use Safe;

my $sandbox = Safe->new; $sandbox->share("Foo​::something");

my $sub = $sandbox->reval(\<\<'EOT');

$foo = bless []\, "Foo"; $bar = bless []\, "Bar";

print "$foo\n$bar\n";

Foo​::something();

EOT die $@​ if $@​;

sub Foo​::something {   print "Hello\n"; } __END__ --------------------------------------------

The program above prints​:

  Safe​::Root0​::Foo=ARRAY(0x816cbe0)   Bar=ARRAY(0x816ccc4)   Hello

This patch appears to fix the problem (the last chunk only fix some strange indentation in &reval)​:

Inline Patch

```diff --- /local/perl/a6655_thr/lib/5.7.0/i686-linux-thread-multi/Safe.pm Thu Aug 17 09:53:36 2000 +++ Safe.pm Tue Aug 29 12:27:20 2000 @@ -167,13 +167,14 @@ my ($var, $type); $type = $1 if ($var = $arg) =~ s/^(\W)//; # warn "share_from $pkg $type $var"; - *{$root."::$var"} = (!$type) ? \&{$pkg."::$var"} + my $obj_to_share = (!$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)); + Opcode::_safe_call_sv($root, $obj->{Mask}, sub { *{$var} = $obj_to_share }); } $obj->share_record($pkg, $vars) unless $no_record or !$vars; } @@ -213,11 +214,11 @@ # 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) - my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); + my $evalcode = sprintf('package %s; sub { eval $expr; }', $root); my $evalsub; - if ($strict) { use strict; $evalsub = eval $evalcode; } - else { no strict; $evalsub = eval $evalcode; } + if ($strict) { use strict; $evalsub = eval $evalcode; } + else { no strict; $evalsub = eval $evalcode; } return Opcode::_safe_call_sv($root, $obj->{Mask}, $evalsub); } ```

Perl Info

``` Flags: category=library severity=low Site configuration information for perl v5.7.0: Configured by gisle at Thu Aug 17 09:40:27 CEST 2000. Summary of my perl5 (revision 5.0 version 7 subversion 0) configuration: Platform: osname=linux, osvers=2.2.14, archname=i686-linux-thread-multi uname='linux eik 2.2.14 #1 fri mar 17 11:59:50 gmt 2000 i686 unknown ' config_args='-Dprefix=/local/perl/a6655_thr -Dusethreads -Doptimize=-g' hint=recommended, useposix=true, d_sigaction=define usethreads=define use5005threads=undef useithreads=define usemultiplicity=define useperlio=undef d_sfio=undef uselargefiles=define use64bitint=undef use64bitall=undef uselongdouble=undef usesocks=undef Compiler: cc='cc', optimize='-g', gccversion=2.95.2 19991024 (release), gccosandvers= cppflags='-D_REENTRANT -DDEBUGGING -fno-strict-aliasing -I/usr/local/include' ccflags ='-D_REENTRANT -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' stdchar='char', d_stdstdio=define, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12 ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8 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 -ldbm -ldb -ldl -lm -lpthread -lc -lposix -lcrypt -lutil 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: SUIDMAIL - fixes for suidperl security DEVEL6654 @INC for perl v5.7.0: /local/perl/a6655_thr/lib/5.7.0/i686-linux-thread-multi /local/perl/a6655_thr/lib/5.7.0 /local/perl/a6655_thr/lib/site_perl/5.7.0/i686-linux-thread-multi /local/perl/a6655_thr/lib/site_perl/5.7.0 /local/perl/a6655_thr/lib/site_perl . Environment for perl v5.7.0: HOME=/home/gisle LANG=POSIX LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=/local/perl/a6655_thr/bin:... PERL_BADLANG (unset) SHELL=/bin/bash ```

[p5pRT]

From @jhi

This patch appears to fix the problem (the last chunk only fix some strange indentation in &reval)​:

Thanks\, applied.

[p5pRT]

From @gisle

Jarkko Hietaniemi \jhi@&#8203;iki\.fi writes​:

This patch appears to fix the problem (the last chunk only fix some strange indentation in &reval)​:

Thanks\, applied.

This patch pass the 't/lib/safe?.t' tests and also avoids all the eval "" calls in reval and rdo. I should probably also add some new test cases.

Does anybody know why the ->rdo() test at the end of t/lib/safe2.t is commented out?

Regards\, Gisle

*** perl-a6889-2/ext/Opcode/Safe.pm Tue Aug 29 16​:49​:05 2000 --- perl-a6889/ext/Opcode/Safe.pm Wed Aug 30 00​:23​:45 2000 *************** *** 152\,158 ****   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 --- 152\,157 ---- *************** *** 167\,179 ****   my ($var\, $type);   $type = $1 if ($var = $arg) =~ s/^(\W)//;   # warn "share_from $pkg $type $var"; ! *{$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;   } --- 166\,181 ----   my ($var\, $type);   $type = $1 if ($var = $arg) =~ s/^(\W)//;   # warn "share_from $pkg $type $var"; ! my $obj_to_share = (!$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)); + package main; + Opcode​::_safe_call_sv($obj->{Root}\, $obj->{Mask}\, + sub { *$var = $obj_to_share });   }   $obj->share_record($pkg\, $vars) unless $no_record or !$vars;   } *************** *** 208\,234 ****  
  sub reval {   my ($obj\, $expr\, $strict) = @​_; - my $root = $obj->{Root};  
! # 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) ! my $evalcode = sprintf('package %s; sub { eval $expr; }'\, $root); ! my $evalsub; ! ! if ($strict) { use strict; $evalsub = eval $evalcode; } ! else { no strict; $evalsub = eval $evalcode; } ! ! 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);   }  
 
--- 210\,234 ----  
  sub reval {   my ($obj\, $expr\, $strict) = @​_;  
! package main; ! if ($strict) { ! use strict; ! return Opcode​::_safe_call_sv($obj->{Root}\, $obj->{Mask}\, ! sub { eval $expr }); ! } ! else { ! no strict; ! return Opcode​::_safe_call_sv($obj->{Root}\, $obj->{Mask}\, ! sub { eval $expr }); ! }   }  
  sub rdo {   my ($obj\, $file) = @​_; ! package main; ! return Opcode​::_safe_call_sv($obj->{Root}\, $obj->{Mask}\, ! sub { do $file });   }  
 

[p5pRT]

From @jhi

On Wed\, Aug 30\, 2000 at 12​:33​:09AM +0200\, Gisle Aas wrote​:

Jarkko Hietaniemi \jhi@&#8203;iki\.fi writes​:

This patch appears to fix the problem (the last chunk only fix some strange indentation in &reval)​:

Thanks\, applied.

This patch pass the 't/lib/safe?.t' tests and also avoids all the eval

Nope.

lib/safe1............Use of uninitialized value in numeric eq (==) at lib/safe1.t line 42. FAILED at test 1 lib/safe2............Use of uninitialized value in string eq at (eval 2) line 1. Use of uninitialized value in print at (eval 3) line 8. Use of uninitialized value in print at lib/safe2.t line 86. FAILED at test 2

[p5pRT]

From @gisle

Jarkko Hietaniemi \jhi@&#8203;iki\.fi writes​:

On Wed\, Aug 30\, 2000 at 12​:33​:09AM +0200\, Gisle Aas wrote​:

Jarkko Hietaniemi \jhi@&#8203;iki\.fi writes​:

This patch appears to fix the problem (the last chunk only fix some strange indentation in &reval)​:

Thanks\, applied.

This patch pass the 't/lib/safe?.t' tests and also avoids all the eval

Nope.

lib/safe1............Use of uninitialized value in numeric eq (==) at lib/safe1.t line 42. FAILED at test 1 lib/safe2............Use of uninitialized value in string eq at (eval 2) line 1. Use of uninitialized value in print at (eval 3) line 8. Use of uninitialized value in print at lib/safe2.t line 86. FAILED at test 2

Argh!!

The patch works for ithreads-perl\, but not for a plain build. I think the reason is that ithreads-perl just store the cop-shash-name-pv and then do a name lookup each time while non-ithreads-perl have a pointer directly to the stash. That way cops of the sub passed to Opcode​::_safe_call_sv() continue to point to the main main​:: instead of the main​:: of the compartment.

Regards\, Gisle

[p5pRT]

From @gsar

On 30 Aug 2000 13​:37​:56 +0200\, Gisle Aas wrote​:

The patch works for ithreads-perl\, but not for a plain build. I think the reason is that ithreads-perl just store the cop-shash-name-pv and then do a name lookup each time while non-ithreads-perl have a pointer directly to the stash. That way cops of the sub passed to Opcode​::_safe_call_sv() continue to point to the main main​:: instead of the main​:: of the compartment.

Yes\, Safe is safer with ithreads than without. I tried to do the same sort of change to the non-ithreads world\, but it never really went anywhere. The use of stash pointers is too pervasive and this will be an efficiency hit.

Safe's patch to salvation lies in running compartments in independent interpreters.

Sarathy gsar@​ActiveState.com