Skip site navigation (1)Skip section navigation (2)
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>