mirror of
https://git.FreeBSD.org/ports.git
synced 2024-10-20 20:09:11 +00:00
Fix the XSLoader thing in Perl 5.18 and 5.20.
MFH: 2016Q3 Security: CVE-2016-6185 Sponsored by: Absolight
This commit is contained in:
Mathieu Arnold
parent
21de84e6ba
commit
227031f906
Notes:
svn2git
2021-03-31 03:12:20 +00:00
svn path=/head/; revision=420220
@ -3,7 +3,7 @@
|
||||
|
||||
PORTNAME= perl
|
||||
PORTVERSION= ${PERL_VERSION}
|
||||
PORTREVISION= 23
|
||||
PORTREVISION= 24
|
||||
CATEGORIES= lang devel perl5
|
||||
MASTER_SITES= CPAN/../../src/5.0
|
||||
DIST_SUBDIR= perl
|
||||
|
||||
90
lang/perl5.18/files/patch-CVE-2016-6185
Normal file
90
lang/perl5.18/files/patch-CVE-2016-6185
Normal file
@ -0,0 +1,90 @@
|
||||
diff --git dist/XSLoader/XSLoader_pm.PL dist/XSLoader/XSLoader_pm.PL
|
||||
index 8a8852e..09f9d4b 100644
|
||||
--- dist/XSLoader/XSLoader_pm.PL
|
||||
+++ dist/XSLoader/XSLoader_pm.PL
|
||||
@@ -93,6 +93,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";
|
||||
diff --git dist/XSLoader/t/XSLoader.t dist/XSLoader/t/XSLoader.t
|
||||
index 2ff11fe..1e86faa 100644
|
||||
--- dist/XSLoader/t/XSLoader.t
|
||||
+++ 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 + 8;
|
||||
+plan tests => keys(%modules) * 3 + 9;
|
||||
|
||||
# Try to load the module
|
||||
use_ok( 'XSLoader' );
|
||||
@@ -95,3 +95,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);
|
||||
+}
|
||||
@ -3,7 +3,7 @@
|
||||
|
||||
PORTNAME= perl
|
||||
PORTVERSION= ${PERL_VERSION}
|
||||
PORTREVISION= 14
|
||||
PORTREVISION= 15
|
||||
CATEGORIES= lang devel perl5
|
||||
MASTER_SITES= CPAN/../../src/5.0
|
||||
DIST_SUBDIR= perl
|
||||
|
||||
90
lang/perl5.20/files/patch-CVE-2016-6185
Normal file
90
lang/perl5.20/files/patch-CVE-2016-6185
Normal file
@ -0,0 +1,90 @@
|
||||
diff --git dist/XSLoader/XSLoader_pm.PL dist/XSLoader/XSLoader_pm.PL
|
||||
index 8a8852e..09f9d4b 100644
|
||||
--- dist/XSLoader/XSLoader_pm.PL
|
||||
+++ dist/XSLoader/XSLoader_pm.PL
|
||||
@@ -93,6 +93,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";
|
||||
diff --git dist/XSLoader/t/XSLoader.t dist/XSLoader/t/XSLoader.t
|
||||
index 2ff11fe..1e86faa 100644
|
||||
--- dist/XSLoader/t/XSLoader.t
|
||||
+++ 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 + 8;
|
||||
+plan tests => keys(%modules) * 3 + 9;
|
||||
|
||||
# Try to load the module
|
||||
use_ok( 'XSLoader' );
|
||||
@@ -95,3 +95,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);
|
||||
+}
|
||||
Loading…
Reference in New Issue
Block a user