Date: Mon, 15 Aug 2016 09:33:39 +0000 (UTC) From: Mathieu Arnold <mat@FreeBSD.org> To: ports-committers@freebsd.org, svn-ports-all@freebsd.org, svn-ports-head@freebsd.org Subject: svn commit: r420220 - in head/lang: perl5.18 perl5.18/files perl5.20 perl5.20/files Message-ID: <201608150933.u7F9Xd8K073266@repo.freebsd.org>
next in thread | raw e-mail | index | archive | help
Author: mat Date: Mon Aug 15 09:33:39 2016 New Revision: 420220 URL: https://svnweb.freebsd.org/changeset/ports/420220 Log: Fix the XSLoader thing in Perl 5.18 and 5.20. MFH: 2016Q3 Security: CVE-2016-6185 Sponsored by: Absolight Added: head/lang/perl5.18/files/patch-CVE-2016-6185 (contents, props changed) head/lang/perl5.20/files/patch-CVE-2016-6185 (contents, props changed) Modified: head/lang/perl5.18/Makefile (contents, props changed) head/lang/perl5.20/Makefile (contents, props changed) Modified: head/lang/perl5.18/Makefile ============================================================================== --- head/lang/perl5.18/Makefile Mon Aug 15 09:26:54 2016 (r420219) +++ head/lang/perl5.18/Makefile Mon Aug 15 09:33:39 2016 (r420220) @@ -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 Added: head/lang/perl5.18/files/patch-CVE-2016-6185 ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/lang/perl5.18/files/patch-CVE-2016-6185 Mon Aug 15 09:33:39 2016 (r420220) @@ -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); ++} Modified: head/lang/perl5.20/Makefile ============================================================================== --- head/lang/perl5.20/Makefile Mon Aug 15 09:26:54 2016 (r420219) +++ head/lang/perl5.20/Makefile Mon Aug 15 09:33:39 2016 (r420220) @@ -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 Added: head/lang/perl5.20/files/patch-CVE-2016-6185 ============================================================================== --- /dev/null 00:00:00 1970 (empty, because file is newly added) +++ head/lang/perl5.20/files/patch-CVE-2016-6185 Mon Aug 15 09:33:39 2016 (r420220) @@ -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); ++}
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?201608150933.u7F9Xd8K073266>