XSLoader: fix cpan #115808 security

Sync our c code with XSLoader 0.22.
Our code already had most of the old .pm problems already solved:
(eval \d) is already filtered out with cperl, just
relative #line \d filenames could lead to exploits.

See https://rt.cpan.org/Ticket/Display.html?id=115808

Make XSLoader fall back to Dynaloader’s @inc search if the calling file has a
relative path that is not found in @inc.
The filename before auto needs to be absolute and needs to end with a /.
Closes #184.

See http://perl5.git.perl.org/perl.git/commitdiff/08e3451d7b3b714ad63a27f1b9c2a23ee75d15ee
(initial fix)
and http://perl5.git.perl.org/perl.git/commitdiff/a651dcdf6a9151150dcf0fb6b18849d3e39b0811
(Windows drive letters as abs) for the perl5 fixes.

One other occurance in B::Stash already fixed with 5f8a169.

Author: Reini Urban

ext/DynaLoader/XSLoader.c

@@ -9,6 +9,12 @@
  * Licensed under the same terms as Perl itself.
  */
 
+#undef WINPATHSEP
+#if defined(WIN32) || defined(OS2) || defined(__CYGWIN__) || defined(DOSISH)
+    || defined(__SYMBIAN32__) || defined(__amigaos4__)
+#  define WINPATHSEP
+#endif
+
 /* A DynaLoader::bootstrap variant which takes the packagename name from caller() */
 XS(XS_XSLoader_load) {
     dVAR; dXSARGS;
@@ -47,7 +53,7 @@ XS(XS_XSLoader_load) {
     }
     if (!modlibname) {
         modlibname = OutCopFILE(PL_curcop);
-        if (memEQ(modlibname, "(eval ", strlen("(eval ")))
+        if (memEQ(modlibname, "(eval ", 6)) /* This catches RT #115808 */
             modlibname = NULL;
     }
     if (!module) {
@@ -69,22 +75,48 @@ XS(XS_XSLoader_load) {
     if (items >= 1) {
         SV *caller = newSVpvn_flags(HvNAME(stash), HvNAMELEN(stash), modlibutf8);
         modparts = dl_split_modparts(aTHX_ caller);
+        DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  caller %s => '%s'\n",
+                                SvPVX(caller), av_tostr(aTHX_ modparts)));
     }
     {
         SSize_t c = AvFILL(modparts) + 1;
         SSize_t i = SvCUR(file);
         char   *s = SvPVX_mutable(file);
         s += i-1;
         for (; c>0 && i>=0 && *s; s--, i--) {
-            if (*s == '/' || *s == '\\') {
+            if (*s == '/'
+#ifdef WINPATHSEP
+                || *s == '\\'
+#endif
+                ) {
                 c--;
                 if (c==0) {
                     s[1] = 0;
+                    /* ensures ending / */
                     SvCUR_set(file, i);
                     break;
                 }
             }
         }
+        if (!SvCUR(file))
+            goto not_found;
+        /* must be absolute. see RT #115808 */
+        s = SvPVX_mutable(file);
+        if (*s != '/'
+#ifdef WINPATHSEP
+            && *s != '\\'
+            && !(*(s+1) && (*(s+1) == ':') && (*s >= 'A' && *s >= 'Z'))
+#endif
+            )
+            goto not_found;
+        s = SvPVX_mutable(file) + SvCUR(file) - 1;
+        /* and must end with / */
+        if (*s != '/'
+#ifdef WINPATHSEP
+            && *s != '\\'
+#endif
+            )
+            goto not_found;
     }
     sv_catpv(file, "auto/");
     sv_catsv(file, modpname);
@@ -97,6 +129,7 @@ XS(XS_XSLoader_load) {
     if (fn_exists(SvPVX(file))) {
         DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  found '%s'\n", SvPVX(file)));
     } else {
+    not_found:
         DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  not found '%s'\n", SvPVX(file)));
         if (items < 1) {
             PUSHMARK(SP);

ext/DynaLoader/dlboot_c.PL

@@ -149,7 +149,7 @@ print OUT line_prefix(__LINE__, <<'EOT');
     newXS("XSLoader::load_file",           XS_XSLoader_load_file, xsloaderfile);
     newXS("XSLoader::bootstrap_inherit",   XS_XSLoader_bootstrap_inherit, xsloaderfile);
     /* TODO CM-604: broke t/comp/require.t test 53: require does not localise %^H at run time */
-    Perl_set_version(aTHX_ STR_WITH_LEN("XSLoader::VERSION"), STR_WITH_LEN("1.01c"), 1.01);
+    Perl_set_version(aTHX_ STR_WITH_LEN("XSLoader::VERSION"), STR_WITH_LEN("1.02c"), 1.02);
     (void)hv_store(inc_hv, "XSLoader.pm", sizeof("XSLoader.pm")-1,
                    SvREFCNT_inc_simple_NN(newSVpvs("XSLoader.c")), 0);
 

ext/DynaLoader/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 + 9;
+plan tests => keys(%modules) * 3 + 10;
 
 # Try to load the module
 use_ok( 'XSLoader' );
@@ -125,3 +125,33 @@ XSLoader::load("Devel::Peek");
 EOS
     or ::diag $@;
 }
+
+SKIP: {
+  skip "File::Path not available", 1
+    unless eval { require File::Path };
+  my $name = "evil$$";
+  my $fname = "$name/auto/Foo/Bar";
+  File::Path::mkpath("$name/auto/Foo/Bar");
+  $fname .= "Bar".$Config::Config{'dlext'};
+  open my $fh,
+    ">$name/auto/Foo/Bar/Bar.$Config::Config{'dlext'}";
+  close $fh;
+  chmod 0755, $fname;
+  my $fell_back;
+  local *XSLoader::bootstrap_inherit = sub {
+    $fell_back++;
+    # Break out of the calling subs
+    goto the_test;
+  };
+  # https://rt.cpan.org/Ticket/Display.html?id=115808
+  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]';
+  sleep(0.2);
+  File::Path::rmtree($name);
+}

pod/perlcdelta.pod

@@ -194,13 +194,23 @@ But no classes, methods and roles yet.
 
 =over 4
 
-=item Net-Cmd
+=item XSLoader 1.02c
+
+Fixed the C<#line relativefilename> part of the
+L<[cpan #115808]|https://rt.cpan.org/Ticket/Display.html?id=115808> security
+problem, the C<(eval 1)> part was already fixed in the cperl rewrite as
+XS.
+
+Ensure that the local stash filename part is absolute and ends with C</>,
+the part before "auto/" and before the fallback to the DynaLoader search.
+
+=item Net::Cmd
 
 Fixed utf8 handling, suse L<[bnc#493978]|https://bugzilla.opensuse.org/show_bug.cgi?id=493978>
 
 Note that libnet has hundreds of more L<open tickets|https://rt.cpan.org/Dist/Display.html?Name=libnet>
 
-=item Pod-Perldoc
+=item Pod::Perldoc
 
 Favor nroff over groff, suse perl-nroff.diff [bnc#463444]