summaryrefslogtreecommitdiffstats
path: root/meta/recipes-devtools/perl/perl/perl-fix-CVE-2016-6185.patch
blob: 2722af35bcd79ad1d1c2ab755aad2848a86078d1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
From 7cedaa8bc2ca9e63369d0e2d4c4c23af9febb93a Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 2 Jul 2016 22:56:51 -0700
Subject: [PATCH] perl: fix CVE-2016-6185
MIME-Version: 1.0

Don't let XSLoader load relative paths

[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.

Backport patch from http://perl5.git.perl.org/perl.git/commitdiff/08e3451d7

Upstream-Status: Backport
CVE: CVE-2016-6185
Signed-off-by: Mingli Yu <Mingli.Yu@windriver.com>
---
 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 668411d..778e46b 100644
--- a/dist/XSLoader/XSLoader_pm.PL
+++ b/dist/XSLoader/XSLoader_pm.PL
@@ -104,6 +104,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.8.1