Merge branch 'bug/secure_require'

Changes

@@ -2,6 +2,7 @@
   New Features
   * %hash->each() is guaranteed to iterate through the entire hash.
     [github 142]
+  * $string->is_module_name() checks if a string is a valid module name.
 
   Doc Changes
   * Document the very useful %hash->each( func ($k, $v) { ... } ).
@@ -17,6 +18,9 @@
   Bug Fixes
   * Depend on the newest version of Child. (Chad Granum)
 
+  Security Fixes
+  * require() will now only require modules.  [github #204]
+
 
 2.8.0  Sat Sep 24 21:36:32 PDT 2011
   Bug Fixes

lib/perl5i.pm

@@ -503,6 +503,16 @@ For example,
     "Foo::Bar"->module2path;  # "Foo/Bar.pm"
 
 
+=head3 is_module_name
+
+    my $is_valid = $string->is_module_name;
+
+Will return true if the $string is a valid module name.
+
+    "Foo::Bar"->is_module_name;  # true
+    "Foo/Bar"->is_module_name;   # false
+
+
 =head3 group_digits
 
     my $number_grouped     = $number->group_digits;

lib/perl5i/2/SCALAR.pm

@@ -253,13 +253,34 @@ sub path2module {
 
     $file =~ s{\.pm$}{};
 
-    return join "::", @dirs, $file;
+    my $module = join "::", @dirs, $file;
+    Carp::croak("'$module' is not a valid module name") unless $module->is_module_name;
+
+    return $module;
+}
+
+
+sub is_module_name {
+    my $name = shift;
+
+    return 0 unless defined($name);
+
+    return 0 unless $name =~ qr{\A 
+                                [[:alpha:]_]            # Must start with an alpha or _
+                                [[:word:]]*             # Then any number of alpha numerics or _
+                                (?: :: [[:word:]]+ )*   # Then optional ::word's
+                                \z
+                              }x;
+
+    return 1;
 }
 
 
 sub module2path {
     my $module = shift;
 
+    Carp::croak("'$module' is not a valid module name") unless $module->is_module_name;
+
     my @parts = split /::/, $module;
     $parts[-1] .= ".pm";
 

t/is_module_name.t

@@ -0,0 +1,33 @@
+#!perl
+
+# Before Test::More is loaded so it is utf8'd.
+use perl5i::latest;
+use Test::More;
+
+my @valid_names = (
+    "foo",
+    "bar123",
+    "Foo213::456",
+    "f",
+    "a::b",
+    "öø::bår",
+);
+
+my @invalid_names = (
+    "::a::c",
+    "123",
+    "1abc",
+    'foo$bar',
+    '$foo::bar',
+    'foo/bar'
+);
+
+for my $name (@valid_names) {
+    ok $name->is_module_name, "valid: $name";
+} 
+
+for my $name (@invalid_names) {
+    ok !$name->is_module_name, "invalid: $name";
+} 
+
+done_testing;

t/module2path.t

@@ -7,12 +7,12 @@ use Test::More;
 use Test::perl5i;
 
 
-# Test some simple symetrical conversions
-{
+note "Test some simple symetrical conversions"; {
     my %mod2path = (
         CGI                 => "CGI.pm",
         "File::Spec"        => "File/Spec.pm",
         "A::B::C"           => "A/B/C.pm",
+        "å::1::2"           => "å/1/2.pm",
     );
 
     for my $mod (keys %mod2path) {
@@ -24,8 +24,7 @@ use Test::perl5i;
 }
 
 
-# Invalid module paths
-{
+note "Invalid module paths"; {
     my @bad_paths = (
         "/foo/bar/baz.pm",
         "Not/A/Module",
@@ -38,4 +37,16 @@ use Test::perl5i;
 }
 
 
+note "Invalid module names"; {
+    my @bad_modules = (
+        "::tmp::owned",
+        "f/../../owned",
+        "/tmp::LOL::PWNED",
+    );
+
+    for my $module (@bad_modules) {
+        throws_ok { $module->module2path } qr/^'\Q$module\E' is not a valid module name/;
+    }
+}
+
 done_testing();

t/require.t

@@ -3,8 +3,7 @@
 use perl5i::latest;
 use Test::More;
 
-# Test successful require
-{
+note "Successful require"; {
     local $!;
     local $@ = "hubba bubba";
 
@@ -19,8 +18,8 @@ use Test::More;
     ok defined &shellwords,         "  default import";
 }
 
-# And a failed on
-{
+
+note "Module doesn't exist"; {
     local $!;
     local @INC = qw(no thing);
     ok !eval { "I::Sure::Dont::Exist"->require; };
@@ -30,4 +29,11 @@ use Test::More;
     ok !$!, "errno didn't leak out";
 }
 
+
+note "Invalid module name"; {
+    ok !eval { "/tmp::LOL::PWNED"->require };
+    like $@, qr{^'/tmp::LOL::PWNED' is not a valid module name };
+}
+
+
 done_testing;