XSLoader: allow relative file if in @inc

and add ENTER/LEAVE to for external callbacks
and the main xs

Author: Reini Urban

ext/DynaLoader/XSLoader.c

@@ -26,6 +26,7 @@ XS(XS_XSLoader_load) {
     SV *modfname, *modpname, *boots;
     int modlibutf8 = 0;
 
+    ENTER;
     if (items < 1) {
         modlibutf8 = HvNAMEUTF8(stash);
         module = newSVpvn_flags(HvNAME(stash), HvNAMELEN(stash), modlibutf8);
@@ -47,25 +48,35 @@ XS(XS_XSLoader_load) {
     boots = pv_copy(module);
     sv_catpvs(boots, "::bootstrap");
     if ((bootc = get_cv(SvPV_nolen_const(boots), 0))) {
+        ENTER; SAVETMPS;
         PUSHMARK(MARK); /* goto &$boots */
         PUTBACK;
-        XSRETURN(call_sv(MUTABLE_SV(bootc), GIMME));
+        items = call_sv(MUTABLE_SV(bootc), GIMME);
+        SPAGAIN;
+        FREETMPS; LEAVE;
+        LEAVE;
+        XSRETURN(items);
     }
     if (!modlibname) {
         modlibname = OutCopFILE(PL_curcop);
         if (memEQ(modlibname, "(eval ", 6)) /* This catches RT #115808 */
             modlibname = NULL;
     }
     if (!module) {
+        ENTER; SAVETMPS;
         PUSHMARK(MARK);
         PUTBACK;
-        XSRETURN(call_pv("XSLoader::bootstrap_inherit", GIMME));
+        items = call_pv("XSLoader::bootstrap_inherit", GIMME);
+        SPAGAIN;
+        PUTBACK; FREETMPS; LEAVE;
+        LEAVE;
+        XSRETURN(items);
     }
     modparts = dl_split_modparts(aTHX_ module);
     modfname = AvARRAY(modparts)[AvFILLp(modparts)];
     modpname = dl_construct_modpname(aTHX_ modparts);
-    DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  modpname (%s) => '%s'\n",
-            av_tostr(aTHX_ modparts), modlibname));
+    DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  modpname (%s) => '%s','%s'\n",
+                            av_tostr(aTHX_ modparts), modlibname, SvPVX(modpname)));
     file = modlibname ? newSVpvn_flags(modlibname, strlen(modlibname), modlibutf8)
                       : newSVpvs("");
 
@@ -75,7 +86,7 @@ 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",
+        DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  caller %s => (%s)\n",
                                 SvPVX(caller), av_tostr(aTHX_ modparts)));
     }
     {
@@ -100,24 +111,52 @@ XS(XS_XSLoader_load) {
         }
         if (!SvCUR(file))
             goto not_found;
-        /* must be absolute. see RT #115808 */
+        /* Must be absolute or in @INC. See RT #115808
+         * 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.
+         */
         s = SvPVX_mutable(file);
         if (*s != '/'
 #ifdef WINPATHSEP
             && *s != '\\'
             && !(*(s+1) && (*(s+1) == ':') && (*s >= 'A' && *s >= 'Z'))
 #endif
-            )
+            ) {
+            /* but allow relative file if in @INC */
+            c = SvCUR(file)-1;
+            if (c<1) goto not_found;
+            for (i=0; i<AvFILL(GvAV(PL_incgv)); i++) {
+                SV * const dirsv = *av_fetch(GvAV(PL_incgv), i, TRUE);
+                SvGETMAGIC(dirsv);
+                /* ignore av and cv refs here. they will be caught later in DynaLoader */
+                if (SvPOK(dirsv)
+                    && SvCUR(dirsv) >= (Size_t)c
+                    && memEQ(SvPVX(file), SvPVX(dirsv), c))
+                    goto found;
+            }
             goto not_found;
+        }
         s = SvPVX_mutable(file) + SvCUR(file) - 1;
-        /* and must end with / */
+        /* And must end with /. Disallow "." in @INC for local XS libs */
         if (*s != '/'
 #ifdef WINPATHSEP
             && *s != '\\'
 #endif
             )
             goto not_found;
     }
+  found:
     sv_catpv(file, "auto/");
     sv_catsv(file, modpname);
     sv_catpv(file, "/");
@@ -131,18 +170,29 @@ XS(XS_XSLoader_load) {
     } else {
     not_found:
         DLDEBUG(3,PerlIO_printf(Perl_debug_log, "  not found '%s'\n", SvPVX(file)));
+        ENTER; SAVETMPS;
         if (items < 1) {
             PUSHMARK(SP);
             XPUSHs(module);
         } else {
             PUSHMARK(MARK);
         }
         PUTBACK;
-        XSRETURN(call_pv("XSLoader::bootstrap_inherit", GIMME));
+        SvREFCNT_dec(file);
+        items = call_pv("XSLoader::bootstrap_inherit", GIMME);
+        SPAGAIN;
+        PUTBACK; FREETMPS; LEAVE;
+
+        LEAVE;
+        XSRETURN(items);
     }
     if ((items = dl_load_file(aTHX_ ax, file, module, GIMME))) {
+        LEAVE;
+        SvREFCNT_dec(file);
         XSRETURN(items);
     } else {
+        LEAVE;
+        SvREFCNT_dec(file);
         XSRETURN_UNDEF;
     }
 }
@@ -153,6 +203,7 @@ XS(XS_XSLoader_load_file) {
 
     if (items < 2)
         die("Usage: XSLoader::load_file($module, $sofile)\n");
+    ENTER; SAVETMPS;
     module = ST(0);
     file = ST(1);
 
@@ -163,8 +214,10 @@ XS(XS_XSLoader_load_file) {
     }
     PL_stack_sp--;
     if ((items = dl_load_file(aTHX_ ax, file, module, GIMME))) {
+        FREETMPS; LEAVE;
         XSRETURN(items);
     } else {
+        FREETMPS; LEAVE;
         XSRETURN_UNDEF;
     }
 }
@@ -176,10 +229,14 @@ XS(XS_XSLoader_bootstrap_inherit) {
                             SvPVX(ST(0)), (int)items));
     if (items < 1 || !SvPOK(ST(0)))
         Perl_die(aTHX_ "Usage: XSLoader::bootstrap_inherit($packagename [,$VERSION])\n");
+    ENTER; SAVETMPS;
     PUSHMARK(MARK);
     PUTBACK;
-    if ((items = call_pv("DynaLoader::bootstrap_inherit", GIMME)))
+    if ((items = call_pv("DynaLoader::bootstrap_inherit", GIMME))) {
+        FREETMPS; LEAVE;
         XSRETURN(items);
-    else
+    } else {
+        FREETMPS; LEAVE;
         XSRETURN_UNDEF;
+    }
 }