File perl-xsloadereval.diff of Package perl.6851

Overview Repositories Revisions Requests Users Attributes Meta

File perl-xsloadereval.diff of Package perl.6851

--- ./dist/XSLoader/XSLoader_pm.PL.orig	2016-08-03 14:56:37.057045072 +0000
+++ ./dist/XSLoader/XSLoader_pm.PL	2016-08-03 14:56:29.802045085 +0000
@@ -86,6 +86,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";

Places

File perl-xsloadereval.diff of Package perl.6851

Places