1 From 08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee Mon Sep 17 00:00:00 2001

     2 From: Father Chrysostomos <[email protected]>

     3 Date: Sat, 2 Jul 2016 22:56:51 -0700

     4 Subject: [PATCH] =?utf8?q?Don=E2=80=99t=20let=20XSLoader=20load=20relative?=

     5  =?utf8?q?=20paths?=

     6 MIME-Version: 1.0

     7 Content-Type: text/plain; charset=utf8

     8 Content-Transfer-Encoding: 8bit

     9 

    10 [rt.cpan.org #115808]

    11 

    12 The logic in XSLoader for determining the library goes like this:

    13 

    14     my $c = () = split(/::/,$caller,-1);

    15     $modlibname =~ s,[\\/][^\\/]+$,, while $c--;    # Q&D basename

    16     my $file = "$modlibname/auto/$modpname/$modfname.bundle";

    17 

    18 (That last line varies by platform.)

    19 

    20 $caller is the calling package.  $modlibname is the calling file.  It

    21 removes as many path segments from $modlibname as there are segments

    22 in $caller.  So if you have Foo/Bar/XS.pm calling XSLoader from the

    23 Foo::Bar package, the $modlibname will end up containing the path in

    24 @INC where XS.pm was found, followed by "/Foo".  Usually the fallback

    25 to Dynaloader::bootstrap_inherit, which does an @INC search, makes

    26 things Just Work.

    27 

    28 But if our hypothetical Foo/Bar/XS.pm actually calls

    29 XSLoader::load from inside a string eval, then path ends up being

    30 "(eval 1)/auto/Foo/Bar/Bar.bundle".

    31 

    32 So if someone creates a directory named ‘(eval 1)’ with a naughty

    33 binary file in it, it will be loaded if a script using Foo::Bar is run

    34 in the parent directory.

    35 

    36 This commit makes XSLoader fall back to Dynaloader’s @INC search if

    37 the calling file has a relative path that is not found in @INC.

    38 ---

    39  dist/XSLoader/XSLoader_pm.PL | 25 +++++++++++++++++++++++++

    40  dist/XSLoader/t/XSLoader.t   | 27 ++++++++++++++++++++++++++-

    41  2 files changed, 51 insertions(+), 1 deletion(-)

    42 

    43 --- perl-5.12.5/dist/XSLoader/XSLoader_pm.PL.old

    44 +++ perl-5.12.5/dist/XSLoader/XSLoader_pm.PL

    45 @@ -74,6 +74,31 @@

    46      my $modlibname = (caller())[1];

    47      my $c = @modparts;

    48      $modlibname =~ s,[\\/][^\\/]+$,, while $c--;	# Q&D basename

    49 +    # Does this look like a relative path?

    50 +    if ($modlibname !~ m|^[\\/]|) {

    51 +        # Someone may have a #line directive that changes the file name, or

    52 +        # may be calling XSLoader::load from inside a string eval.  We cer-

    53 +        # tainly do not want to go loading some code that is not in @INC,

    54 +        # as it could be untrusted.

    55 +        #

    56 +        # We could just fall back to DynaLoader here, but then the rest of

    57 +        # this function would go untested in the perl core, since all @INC

    58 +        # paths are relative during testing.  That would be a time bomb

    59 +        # waiting to happen, since bugs could be introduced into the code.

    60 +        #

    61 +        # So look through @INC to see if $modlibname is in it.  A rela-

    62 +        # tive $modlibname is not a common occurrence, so this block is

    63 +        # not hot code.

    64 +        FOUND: {

    65 +            for (@INC) {

    66 +                if ($_ eq $modlibname) {

    67 +                    last FOUND;

    68 +                }

    69 +            }

    70 +            # Not found.  Fall back to DynaLoader.

    71 +            goto \&XSLoader::bootstrap_inherit;

    72 +        }

    73 +    }

    74      my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext";

    75  

    76  #   print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug;

    77 --- perl-5.12.5/dist/XSLoader/t/XSLoader.t.old

    78 +++ perl-5.12.5/dist/XSLoader/t/XSLoader.t

    79 @@ -30,7 +30,7 @@

    80      'Time::HiRes'=> q| ::can_ok( 'Time::HiRes' => 'usleep'  ) |,  # 5.7.3

    81  );

    82  

    83 -plan tests => keys(%modules) * 3 + 5;

    84 +plan tests => keys(%modules) * 3 + 6;

    85  

    86  # Try to load the module

    87  use_ok( 'XSLoader' );

    88 @@ -76,3 +76,27 @@

    89      }

    90  }

    91  

    92 +SKIP: {

    93 +  skip "File::Path not available", 1

    94 +    unless eval { require File::Path };

    95 +  my $name = "phooo$$";

    96 +  File::Path::make_path("$name/auto/Foo/Bar");

    97 +  open my $fh,

    98 +    ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";

    99 +  close $fh;

   100 +  my $fell_back;

   101 +  local *XSLoader::bootstrap_inherit = sub {

   102 +    $fell_back++;

   103 +    # Break out of the calling subs

   104 +    goto the_test;

   105 +  };

   106 +  eval <<END;

   107 +#line 1 $name

   108 +package Foo::Bar;

   109 +XSLoader::load("Foo::Bar");

   110 +END

   111 + the_test:

   112 +  ok $fell_back,

   113 +    'XSLoader will not load relative paths based on (caller)[1]';

   114 +  File::Path::remove_tree($name);

   115 +}