| Subject: | Loading modules in a regex can segfault old perl 5.8 |
If module loading is triggered inside a regex, this module can cause a segfault on older versions of perl 5.8. This is because the @INC hook uses a regex, and the regex engine is not reentrant on 5.8.
Attached is a patch that fixes this by avoiding using any regexes inside the @INC hook.
| Subject: | 0001-avoid-using-regexes-in-INC-hook.patch |
From 52b5a56c84c8085ebea2ac4e8a9915c9c661f80e Mon Sep 17 00:00:00 2001
From: Graham Knop <haarg@haarg.org>
Date: Wed, 20 Aug 2014 10:27:09 -0400
Subject: [PATCH] avoid using regexes in @INC hook
---
lib/Test/Without/Module.pm | 29 +++++++++++------------------
1 file changed, 11 insertions(+), 18 deletions(-)
diff --git a/lib/Test/Without/Module.pm b/lib/Test/Without/Module.pm
index 849d703..e3f240f 100755
--- a/lib/Test/Without/Module.pm
+++ b/lib/Test/Without/Module.pm
@@ -5,7 +5,7 @@ use Carp qw( croak );
use vars qw( $VERSION );
$VERSION = '0.17';
-use vars qw( %forbidden );
+use vars qw( %forbidden %fake_modules );
sub get_forbidden_list {
\%forbidden
@@ -18,6 +18,7 @@ sub import {
for (@forbidden_modules) {
$forbidden->{$_} = $INC{ module2file($_) };
+ $fake_modules{module2file($_)} = [ "package $_;", "0;" ];
};
# Scrub %INC, so that loaded modules disappear
@@ -32,13 +33,9 @@ sub fake_module {
my ($self,$module_file,$member_only) = @_;
# Don't touch $@, or .al files will not load anymore????
- my $forbidden = get_forbidden_list;
-
- my $modulename = file2module($module_file);
-
# Deliver a faked, nonworking module
- if (exists $forbidden->{$modulename}) {
- my @faked_module = ("package $modulename;","0;");
+ if (my $faked = $fake_modules{$module_file}) {
+ my @faked_module = @$faked;
return sub { defined ( $_ = shift @faked_module ) };
};
};
@@ -50,11 +47,12 @@ sub unimport {
for $module (@list) {
if (exists $forbidden->{$module}) {
- if (defined $forbidden->{$module}) {
- $INC{ module2file($module) } = delete $forbidden->{$module};
- } else {
- delete $forbidden->{$module};
- };
+ my $file = module2file($module);
+ delete $fake_modules{$file};
+ my $path = delete $forbidden->{$module};
+ if (defined $path) {
+ $INC{ $file } = $path;
+ }
} else {
croak "Can't allow non-forbidden module $module";
};
@@ -77,12 +75,7 @@ sub module2file {
sub scrub {
my ($module) = @_;
- for my $key (keys %INC) {
- my $fn = file2module($key);
- if ($fn eq $module) {
- delete $INC{$key};
- };
- };
+ delete $INC{module2file($module)};
};
1;
--
2.0.4