Can't perform unicode operations in Safe compartment #10188
Comments
From @timbunceBasic operations on unicode strings don't work inside a Safe compartment: perl -MSafe -MOpcode=full_opset -e '$a=Safe->new; $a->permit(full_opset()); Recent (unrelated) changes to Safe have exposed this problem in PostgreSQL The thread includes an outline of what I've learnt from my investigation into I developed a patch to Safe that works around the issue by only sharing On reflection though, I think it would be better for Safe to simply *always* I'll followup this post with a patch that does that. Perl Info |
From @timbunceOn Fri, Feb 19, 2010 at 05:25:33AM -0800, Tim Bunce wrote:
Here's the patch. Tim. |
From @timbunceSafe-2.22a-swashnew1.patchdiff --git a/Safe.pm b/Safe.pm
index 7453f24..c0a1d3d 100644
--- a/Safe.pm
+++ b/Safe.pm
@@ -41,6 +41,23 @@ use Opcode 1.01, qw(
*ops_to_opset = \&opset; # Temporary alias for old Penguins
+# Regular expressions and other unicode-aware code may need to call
+# utf8->SWASHNEW (via perl's utf8.c). That will fail unless we share the
+# SWASHNEW method.
+# Sadly we can't just add utf8::SWASHNEW to $default_share because perl's
+# utf8.c code does a fetchmethod on SWASHNEW to check if utf8.pm is loaded,
+# and sharing makes it look like the method exists.
+# The simplest and most robust fix is to ensure the utf8 module is loaded when
+# Safe is loaded. Then we can add utf8::SWASHNEW to $default_share.
+require utf8;
+# we must ensure that utf8_heavy.pl, where SWASHNEW is defined, is loaded
+# but without depending on knowledge of that implementation detail.
+# This code (//i on a unicode string) ensures utf8 is fully loaded
+# and also loads the ToFold SWASH.
+# (Swashes are cached internally by perl in PL_utf8_* variables
+# independent of being inside/outside of Safe. So once loaded they can be)
+do { my $unicode = pack('U',0xC4).'1a'; $unicode =~ /\xE4/i; };
+# now we can safely include utf8::SWASHNEW in $default_share defined below.
my $default_root = 0;
# share *_ and functions defined in universal.c
@@ -60,6 +77,7 @@ my $default_share = [qw[
&utf8::downgrade
&utf8::native_to_unicode
&utf8::unicode_to_native
+ &utf8::SWASHNEW
$version::VERSION
$version::CLASS
$version::STRICT
@@ -130,6 +148,7 @@ sub new {
# 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;
}
diff --git a/t/safeutf8.t b/t/safeutf8.t
new file mode 100644
index 0000000..28441da
--- /dev/null
+++ b/t/safeutf8.t
@@ -0,0 +1,46 @@
+#!perl -w
+$|=1;
+BEGIN {
+ require Config; import Config;
+ if ($Config{'extensions'} !~ /\bOpcode\b/ && $Config{'osname'} ne 'VMS') {
+ print "1..0\n";
+ exit 0;
+ }
+}
+
+use Test::More tests => 7;
+
+use Safe 1.00;
+use Opcode qw(full_opset);
+
+pass;
+
+my $safe = Safe->new('PLPerl');
+$safe->permit(qw(pack));
+
+# Expression that triggers require utf8 and call to SWASHNEW.
+# Fails with "Undefined subroutine PLPerl::utf8::SWASHNEW called"
+# if SWASHNEW is not shared, else returns true if unicode logic is working.
+my $trigger = q{ my $a = pack('U',0xC4); $a =~ /\\xE4/i };
+
+ok $safe->reval( $trigger ), 'trigger expression should return true';
+is $@, '', 'trigger expression should not die';
+
+# return a closure
+my $sub = $safe->reval(q{sub { warn pack('U',0xC4) }});
+
+# define code outside Safe that'll be triggered from inside
+my @warns;
+$SIG{__WARN__} = sub {
+ my $msg = shift;
+ # this regex requires a different SWASH digit data for \d)
+ # than the one used above and by the trigger code in Safe.pm
+ $msg =~ s/\(eval \d+\)/XXX/i; # uses IsDigit SWASH
+ push @warns, $msg;
+};
+
+is eval { $sub->() }, 1, 'warn should return 1';
+is $@, '', '__WARN__ hook should not die';
+is @warns, 1, 'should only be 1 warning';
+like $warns[0], qr/at XXX line/, 'warning should have been edited';
+
|
From badalex@gmail.comOn Fri, Feb 19, 2010 at 13:48, Tim Bunce <Tim.Bunce@pobox.com> wrote:
Tested on x86_64 with 5.10.1 and 5.8.9 and postgres 8.3 and 8.4. BTW 5.8.9 with Safe 2.16 fails with the below. I was surprised at |
|
The RT System itself - Status changed from 'new' to 'open' |
From @rgsI've applied the patch and released 2.23 to CPAN, thanks. This is not |
From [Unknown Contact. See original ticket]I've applied the patch and released 2.23 to CPAN, thanks. This is not |
|
@rgs - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#72942 (status was 'resolved')
Searchable as RT72942$
The text was updated successfully, but these errors were encountered: