In perl.git, the branch maint-5.22 has been updated <http://perl5.git.perl.org/perl.git/commitdiff/82b41950cac22300bf881a79b1912f53ab35e280?hp=69786aa7e563ebda50aadaaead54c0f4e9bd6393>
- Log ----------------------------------------------------------------- commit 82b41950cac22300bf881a79b1912f53ab35e280 Author: Steve Hay <[email protected]> Date: Thu Jul 21 22:20:14 2016 +0100 Add rt.perl.org link for XSLoader fix M pod/perldelta.pod commit 73971c96f5b62c5b839e6f04ab7ac1a47d86a5d0 Author: Father Chrysostomos <[email protected]> Date: Thu Jul 21 21:44:48 2016 +0100 perldelta for previous three commits (manually cherry picked from commit 8da8adf3c3d9a4b3a0b4fde347690723a404a523) M pod/perldelta.pod commit 4906af99ca0d3b9c85773a56e2821442dce282f1 Author: Steve Hay <[email protected]> Date: Thu Jul 21 21:30:23 2016 +0100 $VERSION++ for XSLoader Manual change in lieu of cherry-picking 5993d6620f29d22b0a72701f4f0fdacff3d25460 and part of ae635bbffa4769051671b9832a7472b9d977c198 since maint-5.22 has an older version of XSLoader. M dist/XSLoader/XSLoader_pm.PL commit 0305f4018f7ef3523ba67f7bb072c25abe890067 Author: Father Chrysostomos <[email protected]> Date: Mon Jul 4 08:48:57 2016 -0700 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. (cherry picked from commit a651dcdf6a9151150dcf0fb6b18849d3e39b0811) M dist/XSLoader/XSLoader_pm.PL commit 7b5003b4f4213ca694d03577b95244f70a5e170c Author: Father Chrysostomos <[email protected]> Date: Sat Jul 2 22:56:51 2016 -0700 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. (cherry picked from commit 08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee) M dist/XSLoader/XSLoader_pm.PL M dist/XSLoader/t/XSLoader.t ----------------------------------------------------------------------- Summary of changes: dist/XSLoader/XSLoader_pm.PL | 41 +++++++++++++++++++++++++++++++++++++++-- dist/XSLoader/t/XSLoader.t | 27 ++++++++++++++++++++++++++- pod/perldelta.pod | 7 +++++++ 3 files changed, 72 insertions(+), 3 deletions(-) diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL index 414eaf2..d4ed2c7 100644 --- a/dist/XSLoader/XSLoader_pm.PL +++ b/dist/XSLoader/XSLoader_pm.PL @@ -10,7 +10,7 @@ print OUT <<'EOT'; package XSLoader; -$VERSION = "0.20"; +$VERSION = "0.20_01"; #use strict; @@ -92,6 +92,43 @@ print OUT <<'EOT'; $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename EOT +my $to_print = <<'EOT'; + # Does this look like a relative path? + 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, + # 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'}); print OUT <<"EOT"; @@ -208,7 +245,7 @@ XSLoader - Dynamically load C libraries into Perl code =head1 VERSION -Version 0.17 +Version 0.20_01 =head1 SYNOPSIS 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); +} diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 601fe02..11a8f7e 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -48,6 +48,13 @@ L</Reporting Bugs> below. L<Module::CoreList> has been upgraded from version 5.20160429 to 5.20160730_22. +=item * + +L<XSLoader> has been upgraded from version 0.20 to 0.20_01, fixing a security +hole in which binary files could be loaded from a path outside of +L<C<@INC>|perlvar/@INC>. +L<[perl #128528]|https://rt.perl.org/Public/Bug/Display.html?id=128528> + =back =head1 Documentation -- Perl5 Master Repository
