Skip to content

Commit b69a5a9

Browse files
karenetheridgekarenetheridge
committed
extract version much more safely
1 parent db72135 commit b69a5a9

File tree

3 files changed

+164
-73
lines changed

3 files changed

+164
-73
lines changed

‎Changes

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
Revision history for Module-Metadata
22

33
{{$NEXT}}
4+
- now extracting module version a Safe compartment in a subprocess
5+
(RT#89283)
46

57
1.000027 2015-04-11 00:21:26Z
68
- work around issues with an unconfigured Log::Contextual (Kent Fredric)

‎lib/Module/Metadata.pm

Lines changed: 3 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -602,23 +602,13 @@ sub _parse_fh {
602602
$need_vers = 0 if $version_package eq $package;
603603

604604
unless ( defined $vers_raw{$version_package}[0] && length $vers_raw{$version_package}[0] ) {
605-
$vers_raw{$version_package} = [ eval_version(
606-
sigil => $version_sigil,
607-
variable_name => $version_fullname,
608-
string => $line,
609-
filename => $self->{filename},
610-
), $line ];
605+
$vers_raw{$version_package} = [ eval_version($line), $line ];
611606
}
612607

613608
# first non-comment line in undeclared package main is VERSION
614609
} elsif ( $package eq 'main' && $version_fullname && !exists($vers_raw{main}[0]) ) {
615610
$need_vers = 0;
616-
my $v = eval_version(
617-
sigil => $version_sigil,
618-
variable_name => $version_fullname,
619-
string => $line,
620-
filename => $self->{filename},
621-
);
611+
my $v = eval_version($line);
622612
$vers_raw{$package} = [ $v, $line ];
623613
push( @packages, 'main' );
624614

@@ -631,12 +621,7 @@ sub _parse_fh {
631621
# only keep if this is the first $VERSION seen
632622
} elsif ( $version_fullname && $need_vers ) {
633623
$need_vers = 0;
634-
my $v = eval_version(
635-
sigil => $version_sigil,
636-
variable_name => $version_fullname,
637-
string => $line,
638-
filename => $self->{filename},
639-
);
624+
my $v = eval_version($line);
640625

641626
unless ( exists $vers_raw{$package}[0] && length $vers_raw{$package}[0] ) {
642627
$vers_raw{$package} = [ $v, $line ];

‎lib/Module/Metadata/ExtractVersion.pm

Lines changed: 159 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -11,74 +11,178 @@ our $VERSION = '1.000028';
1111
use base 'Exporter';
1212
our @EXPORT_OK = qw/eval_version/;
1313

14-
use Carp qw/croak/;
15-
use version 0.87;
14+
use File::Spec;
15+
use File::Temp 0.18;
16+
use IPC::Open3 qw(open3);
17+
use Symbol 'gensym';
18+
19+
# Win32 is slow to spawn processes
20+
my $TIMEOUT = $^O eq 'MSWin32' ? 5 : 2;
1621

1722
=func eval_version
1823
24+
my $version = eval_version( q[our $VERSION = "1.23"] );
25+
1926
Given a (decoded) string (usually a single line) that contains a C<$VERSION>
2027
declaration, this function will evaluate it in a L<Safe> compartment in a
21-
separate process. If the C<$VERSION> is a valid version string according to
22-
L<version>, it will return it as a string, otherwise, it will return undef.
28+
separate process. The extracted string is returned; it is B<not> validated
29+
against required syntax for versions at this level, so the caller should
30+
normally do something like C<< version::is_lax($version) >> before proceeding
31+
to use this data.
2332
2433
=cut
2534

2635
sub eval_version
2736
{
28-
my (%args) = @_;
29-
30-
return _evaluate_version_line(
31-
$args{sigil},
32-
$args{variable_name},
33-
$args{string},
34-
$args{filename},
35-
);
37+
my ( $string, $timeout ) = @_;
38+
$timeout = $TIMEOUT unless defined $timeout;
39+
40+
# what $VERSION are we looking for?
41+
my ( $sigil, $var ) = $string =~ /([\$*])((?:[\w\:\']*)\bVERSION)\b.*\=/;
42+
return unless $sigil && $var;
43+
44+
# munge string: remove "use version" as we do that already and the "use"
45+
# will get stopped by the Safe compartment
46+
$string =~ s/(?:use|require)\s+version[^;]*/1/;
47+
48+
# create test file
49+
my $temp = File::Temp->new;
50+
print {$temp} _pl_template( $string, $sigil, $var );
51+
close $temp;
52+
53+
my $rc;
54+
my $result;
55+
my $err = gensym;
56+
my $pid = open3(my $in, my $out, $err, $^X, $temp);
57+
my $killer;
58+
if ($^O eq 'MSWin32') {
59+
$killer = fork;
60+
if (!defined $killer) {
61+
die "Can't fork: $!";
62+
}
63+
elsif ($killer == 0) {
64+
sleep $timeout;
65+
kill 'KILL', $pid;
66+
exit 0;
67+
}
68+
}
69+
my $got = eval {
70+
local $SIG{ALRM} = sub { die "alarm\n" };
71+
alarm $timeout;
72+
local $/;
73+
$result = readline $out;
74+
my $c = waitpid $pid, 0;
75+
alarm 0;
76+
( $c != $pid ) || $?;
77+
};
78+
if ( $@ eq "alarm\n" ) {
79+
kill 'KILL', $pid;
80+
waitpid $pid, 0;
81+
$rc = $?;
82+
}
83+
else {
84+
$rc = $got;
85+
}
86+
if ($killer) {
87+
kill 'KILL', $killer;
88+
waitpid $killer, 0;
89+
}
90+
91+
return if $rc || !defined $result; # error condition
92+
93+
## print STDERR "# C<< $string >> --> $result" if $result =~ /^ERROR/;
94+
return if $result =~ /^ERROR/;
95+
96+
$result =~ s/[\r\n]+\z//;
97+
98+
# treat '' the same as undef: no version was found
99+
undef $result if $result eq '';
100+
101+
return $result;
36102
}
37103

38-
# transported directly from Module::Metadata
39-
40-
{
41-
my $pn = 0;
42-
sub _evaluate_version_line {
43-
my( $sigil, $variable_name, $line, $filename ) = @_;
44-
45-
# We compile into a local sub because 'use version' would cause
46-
# compiletime/runtime issues with local()
47-
$pn++; # everybody gets their own package
48-
my $eval = qq{ my \$dummy = q# Hide from _packages_inside()
49-
#; package Module::Metadata::_version::p${pn};
50-
use version;
51-
sub {
52-
local $sigil$variable_name;
53-
$line;
54-
\$$variable_name
104+
sub _pl_template {
105+
my ( $string, $sigil, $var ) = @_;
106+
return <<"HERE"
107+
use version;
108+
use Safe;
109+
use File::Spec;
110+
open STDERR, '>', File::Spec->devnull;
111+
open STDIN, '<', File::Spec->devnull;
112+
113+
my \$comp = Safe->new;
114+
\$comp->permit("entereval"); # for MBARBON/Module-Info-0.30.tar.gz
115+
\$comp->share("*version::new");
116+
\$comp->share("*version::numify");
117+
\$comp->share_from('main', ['*version::',
118+
'*Exporter::',
119+
'*DynaLoader::']);
120+
\$comp->share_from('version', ['&qv']);
121+
122+
my \$code = <<'END';
123+
local $sigil$var;
124+
\$$var = undef;
125+
do {
126+
$string
55127
};
56-
};
57-
58-
$eval = $1 if $eval =~ m{^(.+)}s;
59-
60-
local $^W;
61-
# Try to get the $VERSION
62-
my $vsub = __clean_eval($eval);
63-
# some modules say $VERSION <equal sign> $Foo::Bar::VERSION, but Foo::Bar isn't
64-
# installed, so we need to hunt in ./lib for it
65-
if ( $@ =~ /Can't locate/ && -d 'lib' ) {
66-
local @INC = ('lib',@INC);
67-
$vsub = __clean_eval($eval);
68-
}
69-
warn "Error evaling version line '$eval' in $filename: $@\n"
70-
if $@;
71-
72-
(ref($vsub) eq 'CODE') or
73-
croak "failed to build version sub for $filename";
74-
75-
my $result = eval { $vsub->() };
76-
# FIXME: $eval is not the right thing to print here
77-
croak "Could not get version from $filename by executing:\n$eval\n\nThe fatal error was: $@\n"
78-
if $@;
79-
80-
return $result;
81-
}
128+
\$$var;
129+
END
130+
131+
my \$result = \$comp->reval(\$code);
132+
print "ERROR: \$@\n" if \$@;
133+
exit unless defined \$result;
134+
135+
eval { \$result = version->parse(\$result)->stringify };
136+
print \$result;
137+
138+
HERE
82139
}
83140

84141
1;
142+
143+
=head1 SYNOPSIS
144+
145+
use Version::Eval qw/eval_version/;
146+
147+
my $version = eval_version( $unsafe_string );
148+
149+
=head1 DESCRIPTION
150+
151+
Package versions are defined by a string such as this:
152+
153+
package Foo;
154+
our $VERSION = "1.23";
155+
156+
If we want to know the version of a F<.pm> file, we can
157+
load it and check C<Foo->VERSION> for the package. But that means any
158+
buggy or hostile code in F<Foo.pm> gets run.
159+
160+
The safe thing to do is to parse out a string that looks like an assignment
161+
to C<$VERSION> and then evaluate it. But even that could be hostile:
162+
163+
package Foo;
164+
our $VERSION = do { my $n; $n++ while 1 }; # infinite loop
165+
166+
This module executes a potential version string in a separate process in
167+
a L<Safe> compartment with a timeout to avoid as much risk as possible.
168+
169+
Hostile code might still attempt to consume excessive resources, but the
170+
timeout should limit the problem.
171+
172+
=head1 SEE ALSO
173+
174+
=over 4
175+
176+
* L<Parse::PMFile>
177+
178+
* L<V>
179+
180+
* L<use Module::Info>
181+
182+
* L<Module::InstalledVersion>
183+
184+
* L<Module::Version>
185+
186+
=back
187+
188+
=cut

0 commit comments

Comments
 (0)