From 690183398177fb96326841c2b6666f11b7bfcf85 Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jples...@redhat.com>
Date: Thu, 7 Jul 2016 13:30:02 +0200
Subject: Do not let XSLoader load relative paths (bz #1353238)
---
....2-Don-t-let-XSLoader-load-relative-paths.patch | 237 +++++++++++++++++++++
perl.spec | 11 +-
2 files changed, 247 insertions(+), 1 deletion(-)
create mode 100644 perl-5.25.2-Don-t-let-XSLoader-load-relative-paths.patch
diff --git a/perl-5.25.2-Don-t-let-XSLoader-load-relative-paths.patch
b/perl-5.25.2-Don-t-let-XSLoader-load-relative-paths.patch
new file mode 100644
index 0000000..b5559d8
--- /dev/null
+++ b/perl-5.25.2-Don-t-let-XSLoader-load-relative-paths.patch
@@ -0,0 +1,237 @@
+From 08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <spr...@cpan.org>
+Date: Sat, 2 Jul 2016 22:56:51 -0700
+Subject: [PATCH 1/4] =?UTF-8?q?Don=E2=80=99t=20let=20XSLoader=20load=20rel?=
+ =?UTF-8?q?ative=20paths?=
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+[rt.cpan.org #115808]
+
+The logic in XSLoader for determining the library goes like this:
+
+ my $c = () = split(/::/,$caller,-1);
+ $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
+ my $file = "$modlibname/auto/$modpname/$modfname.bundle";
+
+(That last line varies by platform.)
+
+$caller is the calling package. $modlibname is the calling file. It
+removes as many path segments from $modlibname as there are segments
+in $caller. So if you have Foo/Bar/XS.pm calling XSLoader from the
+Foo::Bar package, the $modlibname will end up containing the path in
+@INC where XS.pm was found, followed by "/Foo". Usually the fallback
+to Dynaloader::bootstrap_inherit, which does an @INC search, makes
+things Just Work.
+
+But if our hypothetical Foo/Bar/XS.pm actually calls
+XSLoader::load from inside a string eval, then path ends up being
+"(eval 1)/auto/Foo/Bar/Bar.bundle".
+
+So if someone creates a directory named ‘(eval 1)’ with a naughty
+binary file in it, it will be loaded if a script using Foo::Bar is run
+in the parent directory.
+
+This commit makes XSLoader fall back to Dynaloader’s @INC search if
+the calling file has a relative path that is not found in @INC.
+---
+ dist/XSLoader/XSLoader_pm.PL | 25 +++++++++++++++++++++++++
+ dist/XSLoader/t/XSLoader.t | 27 ++++++++++++++++++++++++++-
+ 2 files changed, 51 insertions(+), 1 deletion(-)
+
+diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
+index 8a8852e..749f72d 100644
+--- a/dist/XSLoader/XSLoader_pm.PL
++++ b/dist/XSLoader/XSLoader_pm.PL
+@@ -91,6 +91,31 @@ print OUT <<'EOT';
+ my $modpname = join('/',@modparts);
+ my $c = () = split(/::/,$caller,-1);
+ $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
++ # Does this look like a relative path?
++ if ($modlibname !~ m|^[\\/]|) {
++ # Someone may have a #line directive that changes the file name, or
++ # may be calling XSLoader::load from inside a string eval. We cer-
++ # tainly do not want to go loading some code that is not in @INC,
++ # as it could be untrusted.
++ #
++ # We could just fall back to DynaLoader here, but then the rest of
++ # this function would go untested in the perl core, since all @INC
++ # paths are relative during testing. That would be a time bomb
++ # waiting to happen, since bugs could be introduced into the code.
++ #
++ # So look through @INC to see if $modlibname is in it. A rela-
++ # tive $modlibname is not a common occurrence, so this block is
++ # not hot code.
++ FOUND: {
++ for (@INC) {
++ if ($_ eq $modlibname) {
++ last FOUND;
++ }
++ }
++ # Not found. Fall back to DynaLoader.
++ goto \&XSLoader::bootstrap_inherit;
++ }
++ }
+ EOT
+
+ my $dl_dlext = quotemeta($Config::Config{'dlext'});
+diff --git a/dist/XSLoader/t/XSLoader.t b/dist/XSLoader/t/XSLoader.t
+index 2ff11fe..1e86faa 100644
+--- a/dist/XSLoader/t/XSLoader.t
++++ b/dist/XSLoader/t/XSLoader.t
+@@ -33,7 +33,7 @@ my %modules = (
+ 'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3
+ );
+
+-plan tests => keys(%modules) * 3 + 9;
++plan tests => keys(%modules) * 3 + 10;
+
+ # Try to load the module
+ use_ok( 'XSLoader' );
+@@ -125,3 +125,28 @@ XSLoader::load("Devel::Peek");
+ EOS
+ or ::diag $@;
+ }
++
++SKIP: {
++ skip "File::Path not available", 1
++ unless eval { require File::Path };
++ my $name = "phooo$$";
++ File::Path::make_path("$name/auto/Foo/Bar");
++ open my $fh,
++ ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
++ close $fh;
++ my $fell_back;
++ local *XSLoader::bootstrap_inherit = sub {
++ $fell_back++;
++ # Break out of the calling subs
++ goto the_test;
++ };
++ eval <<END;
++#line 1 $name
++package Foo::Bar;
++XSLoader::load("Foo::Bar");
++END
++ the_test:
++ ok $fell_back,
++ 'XSLoader will not load relative paths based on (caller)[1]';
++ File::Path::remove_tree($name);
++}
+--
+2.5.5
+
+From 5993d6620f29d22b0a72701f4f0fdacff3d25460 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <spr...@cpan.org>
+Date: Sat, 2 Jul 2016 22:57:46 -0700
+Subject: [PATCH 2/4] Increase $XSLoader::VERSION to 0.22
+
+---
+ dist/XSLoader/XSLoader_pm.PL | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
+index 749f72d..7e24b83 100644
+--- a/dist/XSLoader/XSLoader_pm.PL
++++ b/dist/XSLoader/XSLoader_pm.PL
+@@ -11,7 +11,7 @@ print OUT <<'EOT';
+
+ package XSLoader;
+
+-$VERSION = "0.21";
++$VERSION = "0.22";
+
+ #use strict;
+
+--
+2.5.5
+
+From a651dcdf6a9151150dcf0fb6b18849d3e39b0811 Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <spr...@cpan.org>
+Date: Mon, 4 Jul 2016 08:48:57 -0700
+Subject: [PATCH 3/4] Fix XSLoader to recognize drive letters
+
+Commit 08e3451d made XSLoader confirm that the file path it got
+from (caller)[2] was in @INC if it looked like a relative path.
+Not taking drive letters into account, it made that @INC search
+mandatory on Windows and some other systems. It still worked, but
+was slightly slower.
+---
+ dist/XSLoader/XSLoader_pm.PL | 14 +++++++++++++-
+ 1 file changed, 13 insertions(+), 1 deletion(-)
+
+diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
+index 7e24b83..2efb99e 100644
+--- a/dist/XSLoader/XSLoader_pm.PL
++++ b/dist/XSLoader/XSLoader_pm.PL
+@@ -91,8 +91,20 @@ print OUT <<'EOT';
+ my $modpname = join('/',@modparts);
+ my $c = () = split(/::/,$caller,-1);
+ $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
++EOT
++
++my $to_print = <<'EOT';
+ # Does this look like a relative path?
+- if ($modlibname !~ m|^[\\/]|) {
++ if ($modlibname !~ m{regexp}) {
++EOT
++
++$to_print =~ s~regexp~
++ $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'amigaos'
++ ? '^(?:[A-Za-z]:)?[\\\/]' # Optional drive letter
++ : '^/'
++~e;
++
++print OUT $to_print, <<'EOT';
+ # Someone may have a #line directive that changes the file name, or
+ # may be calling XSLoader::load from inside a string eval. We cer-
+ # tainly do not want to go loading some code that is not in @INC,
+--
+2.5.5
+
+From ae635bbffa4769051671b9832a7472b9d977c198 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?S=C3=A9bastien=20Aperghis-Tramoni?= <sebast...@aperghis.net>
+Date: Tue, 5 Jul 2016 14:53:08 -0700
+Subject: [PATCH 4/4] Synchronize blead with CPAN XSLoader 0.22
+
+---
+ dist/XSLoader/XSLoader_pm.PL | 2 +-
+ dist/XSLoader/t/XSLoader.t | 4 ++--
+ 2 files changed, 3 insertions(+), 3 deletions(-)
+
+diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
+index 2efb99e..09f9d4b 100644
+--- a/dist/XSLoader/XSLoader_pm.PL
++++ b/dist/XSLoader/XSLoader_pm.PL
+@@ -255,7 +255,7 @@ XSLoader - Dynamically load C libraries into Perl code
+
+ =head1 VERSION
+
+-Version 0.17
++Version 0.22
+
+ =head1 SYNOPSIS
+
+diff --git a/dist/XSLoader/t/XSLoader.t b/dist/XSLoader/t/XSLoader.t
+index 1e86faa..d3538b8 100644
+--- a/dist/XSLoader/t/XSLoader.t
++++ b/dist/XSLoader/t/XSLoader.t
+@@ -130,7 +130,7 @@ SKIP: {
+ skip "File::Path not available", 1
+ unless eval { require File::Path };
+ my $name = "phooo$$";
+- File::Path::make_path("$name/auto/Foo/Bar");
++ File::Path::mkpath("$name/auto/Foo/Bar");
+ open my $fh,
+ ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
+ close $fh;
+@@ -148,5 +148,5 @@ END
+ the_test:
+ ok $fell_back,
+ 'XSLoader will not load relative paths based on (caller)[1]';
+- File::Path::remove_tree($name);
++ File::Path::rmtree($name);
+ }
+--
+2.5.5
+
diff --git a/perl.spec b/perl.spec
index fca59b3..a6be3f8 100644
--- a/perl.spec
+++ b/perl.spec
@@ -28,7 +28,7 @@
Name: perl
Version: %{perl_version}
# release number must be even higher, because dual-lived modules will be
broken otherwise
-Release: 370%{?dist}
+Release: 371%{?dist}
Epoch: %{perl_epoch}
Summary: Practical Extraction and Report Language
Group: Development/Languages
@@ -142,6 +142,10 @@ Patch37:
perl-5.25.2-perl-128238-Crash-with-non-stash-in-stash.patch
# Fix line numbers with perl -x, RT#128508, in upstream after 5.25.2
Patch38: perl-5.25.2-perl-128508-Fix-line-numbers-with-perl-x.patch
+# Do not let XSLoader load relative paths, RT#115808,
+# in upstream after 5.25.2
+Patch39: perl-5.25.2-Don-t-let-XSLoader-load-relative-paths.patch
+
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200:
perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@@ -2799,6 +2803,7 @@ Perl extension for Version Objects
%patch36 -p1
%patch37 -p1
%patch38 -p1
+%patch39 -p1
%patch200 -p1
%patch201 -p1
@@ -2828,6 +2833,7 @@ perl -x patchlevel.h \
'Fedora Patch36: Do not treat %: as a stash (RT#128238)' \
'Fedora Patch37: Do not crash when inserting a non-stash into a stash
(RT#128238)' \
'Fedora Patch38: Fix line numbers with perl -x (RT#128508)' \
+ 'Fedora Patch39: Do not let XSLoader load relative paths (RT#115808)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on
Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@@ -5094,6 +5100,9 @@ popd
# Old changelog entries are preserved in CVS.
%changelog
+* Thu Jul 07 2016 Jitka Plesnikova <jples...@redhat.com> - 4:5.24.0-371
+- Do not let XSLoader load relative paths (RT#115808)
+
* Mon Jul 04 2016 Petr Pisar <ppi...@redhat.com> - 4:5.24.0-370
- Fix line numbers with perl -x (RT#128508)
--
cgit v0.12
http://pkgs.fedoraproject.org/cgit/perl.git/commit/?h=master&id=690183398177fb96326841c2b6666f11b7bfcf85
--
Fedora Extras Perl SIG
http://www.fedoraproject.org/wiki/Extras/SIGs/Perl
perl-devel mailing list
perl-devel@lists.fedoraproject.org
https://lists.fedoraproject.org/admin/lists/perl-devel@lists.fedoraproject.org
