don't allow require STR within string eval to inject arbitrary code

3 files changed, 22 insertions, 9 deletions

diff --git a/lib/circular/require.pm b/lib/circular/require.pm
index 3c65846..5cc4657 100644
--- a/lib/circular/require.pm
+++ b/lib/circular/require.pm
@@ -80,10 +80,11 @@ sub _require {
     # but we're not in an eval anymore
     # fake it up so that this looks the same
     if (defined((caller(1))[6])) {
-        my $mod = _pm2mod($file);
+        require B;
+        my $str = B::perlstring($file);
         $ret = $saved_require_hook
             ? $saved_require_hook->($file)
-            : (eval "CORE::require $mod" || die $@);
+            : (eval "CORE::require($str)" || die $@);
     }
     else {
         $ret = $saved_require_hook
@@ -125,13 +126,6 @@ sub _mod2pm {
     return $mod;
 }
 
-sub _pm2mod {
-    my ($file) = @_;
-    $file =~ s+/+::+g;
-    $file =~ s+\.pm$++;
-    return $file;
-}
-
 =head1 CAVEATS
 
 This module works by overriding C<CORE::GLOBAL::require>, and so other modules
diff --git a/t/injection.t b/t/injection.t
new file mode 100644
index 0000000..5e33406
--- /dev/null
+++ b/t/injection.t
@@ -0,0 +1,17 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+use lib 't/injection';
+
+no circular::require;
+
+eval "require('Foo; die q[bar]'); 1";
+like($@, qr/Can't locate Foo; die q\[bar\] in \@INC/,
+     "can't inject extra code via require");
+
+eval 'require(q[Foo$bar])';
+like($@, qr/Can't locate Foo\$bar in \@INC/,
+     "can't inject extra code via require");
+
+done_testing;
diff --git a/t/injection/Foo.pm b/t/injection/Foo.pm
new file mode 100644
index 0000000..336f337
--- /dev/null
+++ b/t/injection/Foo.pm
@@ -0,0 +1,2 @@
+package Foo;
+1;