components/perl512/patches/0004-perl.git-08e3451d7.patch
changeset 6442 f900f128dbb9
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/components/perl512/patches/0004-perl.git-08e3451d7.patch	Tue Jul 19 15:22:15 2016 +0200
@@ -0,0 +1,115 @@
+From 08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee Mon Sep 17 00:00:00 2001
+From: Father Chrysostomos <[email protected]>
+Date: Sat, 2 Jul 2016 22:56:51 -0700
+Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20let=20XSLoader=20load=20relative?=
+ =?utf8?q?=20paths?=
+MIME-Version: 1.0
+Content-Type: text/plain; charset=utf8
+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(-)
+
+--- perl-5.12.5/dist/XSLoader/XSLoader_pm.PL.old
++++ perl-5.12.5/dist/XSLoader/XSLoader_pm.PL
+@@ -74,6 +74,31 @@
+     my $modlibname = (caller())[1];
+     my $c = @modparts;
+     $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;
++        }
++    }
+     my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";
+ 
+ #   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;
+--- perl-5.12.5/dist/XSLoader/t/XSLoader.t.old
++++ perl-5.12.5/dist/XSLoader/t/XSLoader.t
+@@ -30,7 +30,7 @@
+     'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3
+ );
+ 
+-plan tests => keys(%modules) * 3 + 5;
++plan tests => keys(%modules) * 3 + 6;
+ 
+ # Try to load the module
+ use_ok( 'XSLoader' );
+@@ -76,3 +76,27 @@
+     }
+ }
+ 
++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);
++}