summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--meta/recipes-devtools/perl/perl/perl-fix-CVE-2016-6185.patch128
-rw-r--r--meta/recipes-devtools/perl/perl_5.22.1.bb1
2 files changed, 129 insertions, 0 deletions
diff --git a/meta/recipes-devtools/perl/perl/perl-fix-CVE-2016-6185.patch b/meta/recipes-devtools/perl/perl/perl-fix-CVE-2016-6185.patch
new file mode 100644
index 0000000000..2722af35bc
--- /dev/null
+++ b/meta/recipes-devtools/perl/perl/perl-fix-CVE-2016-6185.patch
@@ -0,0 +1,128 @@
1From 7cedaa8bc2ca9e63369d0e2d4c4c23af9febb93a Mon Sep 17 00:00:00 2001
2From: Father Chrysostomos <sprout@cpan.org>
3Date: Sat, 2 Jul 2016 22:56:51 -0700
4Subject: [PATCH] perl: fix CVE-2016-6185
5MIME-Version: 1.0
6
7Don't let XSLoader load relative paths
8
9[rt.cpan.org #115808]
10
11The logic in XSLoader for determining the library goes like this:
12
13 my $c = () = split(/::/,$caller,-1);
14 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
15 my $file = "$modlibname/auto/$modpname/$modfname.bundle";
16
17(That last line varies by platform.)
18
19$caller is the calling package. $modlibname is the calling file. It
20removes as many path segments from $modlibname as there are segments
21in $caller. So if you have Foo/Bar/XS.pm calling XSLoader from the
22Foo::Bar package, the $modlibname will end up containing the path in
23@INC where XS.pm was found, followed by "/Foo". Usually the fallback
24to Dynaloader::bootstrap_inherit, which does an @INC search, makes
25things Just Work.
26
27But if our hypothetical Foo/Bar/XS.pm actually calls
28XSLoader::load from inside a string eval, then path ends up being
29"(eval 1)/auto/Foo/Bar/Bar.bundle".
30
31So if someone creates a directory named '(eval 1)' with a naughty
32binary file in it, it will be loaded if a script using Foo::Bar is run
33in the parent directory.
34
35This commit makes XSLoader fall back to Dynaloader's @INC search if
36the calling file has a relative path that is not found in @INC.
37
38Backport patch from http://perl5.git.perl.org/perl.git/commitdiff/08e3451d7
39
40Upstream-Status: Backport
41CVE: CVE-2016-6185
42Signed-off-by: Mingli Yu <Mingli.Yu@windriver.com>
43---
44 dist/XSLoader/XSLoader_pm.PL | 25 +++++++++++++++++++++++++
45 dist/XSLoader/t/XSLoader.t | 27 ++++++++++++++++++++++++++-
46 2 files changed, 51 insertions(+), 1 deletion(-)
47
48diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL
49index 668411d..778e46b 100644
50--- a/dist/XSLoader/XSLoader_pm.PL
51+++ b/dist/XSLoader/XSLoader_pm.PL
52@@ -104,6 +104,31 @@ print OUT <<'EOT';
53 my $modpname = join('/',@modparts);
54 my $c = () = split(/::/,$caller,-1);
55 $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename
56+ # Does this look like a relative path?
57+ if ($modlibname !~ m|^[\\/]|) {
58+ # Someone may have a #line directive that changes the file name, or
59+ # may be calling XSLoader::load from inside a string eval. We cer-
60+ # tainly do not want to go loading some code that is not in @INC,
61+ # as it could be untrusted.
62+ #
63+ # We could just fall back to DynaLoader here, but then the rest of
64+ # this function would go untested in the perl core, since all @INC
65+ # paths are relative during testing. That would be a time bomb
66+ # waiting to happen, since bugs could be introduced into the code.
67+ #
68+ # So look through @INC to see if $modlibname is in it. A rela-
69+ # tive $modlibname is not a common occurrence, so this block is
70+ # not hot code.
71+ FOUND: {
72+ for (@INC) {
73+ if ($_ eq $modlibname) {
74+ last FOUND;
75+ }
76+ }
77+ # Not found. Fall back to DynaLoader.
78+ goto \&XSLoader::bootstrap_inherit;
79+ }
80+ }
81 EOT
82
83 my $dl_dlext = quotemeta($Config::Config{'dlext'});
84diff --git a/dist/XSLoader/t/XSLoader.t b/dist/XSLoader/t/XSLoader.t
85index 2ff11fe..1e86faa 100644
86--- a/dist/XSLoader/t/XSLoader.t
87+++ b/dist/XSLoader/t/XSLoader.t
88@@ -33,7 +33,7 @@ my %modules = (
89 'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep' ) |, # 5.7.3
90 );
91
92-plan tests => keys(%modules) * 3 + 9;
93+plan tests => keys(%modules) * 3 + 10;
94
95 # Try to load the module
96 use_ok( 'XSLoader' );
97@@ -125,3 +125,28 @@ XSLoader::load("Devel::Peek");
98 EOS
99 or ::diag $@;
100 }
101+
102+SKIP: {
103+ skip "File::Path not available", 1
104+ unless eval { require File::Path };
105+ my $name = "phooo$$";
106+ File::Path::make_path("$name/auto/Foo/Bar");
107+ open my $fh,
108+ ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
109+ close $fh;
110+ my $fell_back;
111+ local *XSLoader::bootstrap_inherit = sub {
112+ $fell_back++;
113+ # Break out of the calling subs
114+ goto the_test;
115+ };
116+ eval <<END;
117+#line 1 $name
118+package Foo::Bar;
119+XSLoader::load("Foo::Bar");
120+END
121+ the_test:
122+ ok $fell_back,
123+ 'XSLoader will not load relative paths based on (caller)[1]';
124+ File::Path::remove_tree($name);
125+}
126--
1272.8.1
128
diff --git a/meta/recipes-devtools/perl/perl_5.22.1.bb b/meta/recipes-devtools/perl/perl_5.22.1.bb
index 04a2b6f481..33cad9efec 100644
--- a/meta/recipes-devtools/perl/perl_5.22.1.bb
+++ b/meta/recipes-devtools/perl/perl_5.22.1.bb
@@ -66,6 +66,7 @@ SRC_URI += " \
66 file://perl-fix-conflict-between-skip_all-and-END.patch \ 66 file://perl-fix-conflict-between-skip_all-and-END.patch \
67 file://perl-test-customized.patch \ 67 file://perl-test-customized.patch \
68 file://perl-fix-CVE-2016-2381.patch \ 68 file://perl-fix-CVE-2016-2381.patch \
69 file://perl-fix-CVE-2016-6185.patch \
69" 70"
70 71
71# Fix test case issues 72# Fix test case issues