diff options
Diffstat (limited to 'lang/perl5.20')
| -rw-r--r-- | lang/perl5.20/Makefile | 2 | ||||
| -rw-r--r-- | lang/perl5.20/files/patch-CVE-2016-6185 | 90 |
2 files changed, 91 insertions, 1 deletions
diff --git a/lang/perl5.20/Makefile b/lang/perl5.20/Makefile index 2cc05b7..995fdb3 100644 --- a/lang/perl5.20/Makefile +++ b/lang/perl5.20/Makefile @@ -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 diff --git a/lang/perl5.20/files/patch-CVE-2016-6185 b/lang/perl5.20/files/patch-CVE-2016-6185 new file mode 100644 index 0000000..67ddca7 --- /dev/null +++ b/lang/perl5.20/files/patch-CVE-2016-6185 @@ -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); ++} |
