From a34674a79ebf731818680b349345a9be3bf83fab Mon Sep 17 00:00:00 2001 From: nilusyi Date: Mon, 25 Nov 2024 17:10:28 +0800 Subject: [PATCH] fix CVE-2024-10224 Signed-off-by: nilusyi --- 0001-use-three-argument-open.patch | 25 +++ 0002-replace-eval-.-constructs.patch | 224 +++++++++++++++++++++++++++ perl-Module-ScanDeps.spec | 10 +- 3 files changed, 257 insertions(+), 2 deletions(-) create mode 100644 0001-use-three-argument-open.patch create mode 100644 0002-replace-eval-.-constructs.patch diff --git a/0001-use-three-argument-open.patch b/0001-use-three-argument-open.patch new file mode 100644 index 0000000..8f71e76 --- /dev/null +++ b/0001-use-three-argument-open.patch @@ -0,0 +1,25 @@ +From 282c0669e57a0e5b1e109d9a8c47018b2c949857 Mon Sep 17 00:00:00 2001 +From: rschupp +Date: Mon, 21 Oct 2024 14:03:19 +0200 +Subject: [PATCH 1/2] use three-argument open() + +--- + lib/Module/ScanDeps.pm | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/lib/Module/ScanDeps.pm b/lib/Module/ScanDeps.pm +index d79f52d..98775ee 100644 +--- a/lib/Module/ScanDeps.pm ++++ b/lib/Module/ScanDeps.pm +@@ -865,7 +865,7 @@ sub scan_deps_runtime { + sub scan_file{ + my $file = shift; + my %found; +- open my $fh, $file or die "Cannot open $file: $!"; ++ open my $fh, "<", $file or die "Cannot open $file: $!"; + + $SeenTk = 0; + # Line-by-line scanning +-- +2.41.1 + diff --git a/0002-replace-eval-.-constructs.patch b/0002-replace-eval-.-constructs.patch new file mode 100644 index 0000000..1f2b432 --- /dev/null +++ b/0002-replace-eval-.-constructs.patch @@ -0,0 +1,224 @@ +From 37bc6c5028f745ed09b75ca2ce096efb09d1e5de Mon Sep 17 00:00:00 2001 +From: rschupp +Date: Mon, 21 Oct 2024 14:08:01 +0200 +Subject: [PATCH 2/2] replace 'eval "..."' constructs + +--- + lib/Module/ScanDeps.pm | 122 ++++++++++++++++++++++++++--------------- + 1 file changed, 78 insertions(+), 44 deletions(-) + +diff --git a/lib/Module/ScanDeps.pm b/lib/Module/ScanDeps.pm +index 98775ee..f6064d5 100644 +--- a/lib/Module/ScanDeps.pm ++++ b/lib/Module/ScanDeps.pm +@@ -226,8 +226,8 @@ my $SeenTk; + my %SeenRuntimeLoader; + + # match "use LOADER LIST" chunks; sets $1 to LOADER and $2 to LIST +-my $LoaderRE = +- qr/^ use \s+ ++my $LoaderRE = ++ qr/^ use \s+ + ( asa + | base + | parent +@@ -711,19 +711,14 @@ sub scan_deps { + require FindBin; + + local $FindBin::Bin; +- local $FindBin::RealBin; +- local $FindBin::Script; +- local $FindBin::RealScript; ++ #local $FindBin::RealBin; ++ #local $FindBin::Script; ++ #local $FindBin::RealScript; + + my $_0 = $args{files}[0]; + local *0 = \$_0; + FindBin->again(); + +- our $Bin = $FindBin::Bin; +- our $RealBin = $FindBin::RealBin; +- our $Script = $FindBin::Script; +- our $RealScript = $FindBin::RealScript; +- + scan_deps_static(\%args); + } + +@@ -933,40 +928,26 @@ sub scan_line { + # be specified for the "autouse" and "if" pragmas, e.g. + # use autouse Module => qw(func1 func2); + # use autouse "Module", qw(func1); +- # To avoid to parse them ourself, we simply try to eval the +- # string after the pragma (in a list context). The MODULE +- # should be the first ("autouse") or second ("if") element +- # of the list. + my $module; +- { +- no strict; no warnings; +- if ($pragma eq "autouse") { +- ($module) = eval $args; +- } +- else { +- # The syntax of the "if" pragma is +- # use if COND, MODULE => ARGUMENTS +- # The COND may contain undefined functions (i.e. undefined +- # in Module::ScanDeps' context) which would throw an +- # exception. Sneak "1 || " in front of COND so that +- # COND will not be evaluated. This will work in most +- # cases, but there are operators with lower precedence +- # than "||" which will cause this trick to fail. +- (undef, $module) = eval "1 || $args"; +- } +- # punt if there was a syntax error +- return if $@ or !defined $module; +- }; ++ if ($pragma eq "autouse") { ++ ($module) = _parse_module_list($args); ++ } ++ else { ++ # The syntax of the "if" pragma is ++ # use if COND, MODULE => ARGUMENTS ++ (undef, $module) = _parse_module_list($args); ++ } + $found{_mod2pm($pragma)}++; +- $found{_mod2pm($module)}++; ++ $found{_mod2pm($module)}++ if $module; + next CHUNK; + } + +- if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s+ ,) (.+)/x) ++ if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s*,\s*) (.+)/x) + { + my $archname = defined($Config{archname}) ? $Config{archname} : ''; + my $ver = defined($Config{version}) ? $Config{version} : ''; +- foreach my $dir (do { no strict; no warnings; eval $libs }) { ++ while ((my $dir, $libs) = _parse_libs($libs)) ++ { + next unless defined $dir; + my @dirs = $dir; + push @dirs, "$dir/$ver", "$dir/$archname", "$dir/$ver/$archname" +@@ -992,8 +973,8 @@ sub _mod2pm { + return "$mod.pm"; + } + +-# parse a comma-separated list of string literals and qw() lists +-sub _parse_list { ++# parse a comma-separated list of module names (as string literals or qw() lists) ++sub _parse_module_list { + my $list = shift; + + # split $list on anything that's not a word character or ":" +@@ -1001,6 +982,59 @@ sub _parse_list { + return grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $list); + } + ++# incrementally parse a comma separated list library paths: ++# returning a pair: the contents of the first strings literal and the remainder of the string ++# - for "string", 'string', q/string/, qq/string/ also unescape \\ and \) ++# - for qw(foo bar quux) return ("foo", qw(bar quux)) ++# - otherwise skip over the first comma and return (undef, "remainder") ++# - return () if the string is exhausted ++# - as a special case, if the string starts with $FindBin::Bin, replace it with our $Bin ++sub _parse_libs { ++ local $_ = shift; ++ ++ s/^[\s,()]*//; ++ return if $_ eq ""; ++ ++ if (s/^(['"]) ((?:\\.|.)*?) \1//x) { ++ return (_unescape($1, $2), $_); ++ } ++ if (s/^qq? \s* (\W)//x) { ++ my $opening_delim = $1; ++ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:; ++ s/^((?:\\.|.)*?) \Q$closing_delim\E//x; ++ return (_unescape($opening_delim, $1), $_); ++ } ++ ++ if (s/^qw \s* (\W)//x) { ++ my $opening_delim = $1; ++ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:; ++ s/^((?:\\.|.)*?) \Q$closing_delim\E//x; ++ my $contents = $1; ++ my @list = split(" ", $contents); ++ return (undef, $_) unless @list; ++ my $first = shift @list; ++ return (_unescape($opening_delim, $first), ++ @list ? "qw${opening_delim}@list${closing_delim}$_" : $_); ++ } ++ ++ # nothing recognizable in the first list item, skip to the next ++ if (s/^.*? ,//x) { ++ return (undef, $_); ++ } ++ return; # list exhausted ++} ++ ++ ++sub _unescape { ++ my ($delim, $str) = @_; ++ $str =~ s/\\([\\\Q$delim\E])/$1/g; ++ $str =~ s/^\$FindBin::Bin\b/$FindBin::Bin/; ++ ++ return $str; ++} ++ ++ ++ + sub scan_chunk { + my $chunk = shift; + +@@ -1022,14 +1056,14 @@ sub scan_chunk { + # "use LOADER LIST" + # TODO: There's many more of these "loader" type modules on CPAN! + if (my ($loader, $list) = $_ =~ $LoaderRE) { +- my @mods = _parse_list($list); ++ my @mods = _parse_module_list($list); + + if ($loader eq "Catalyst") { + # "use Catalyst 'Foo'" looks for "Catalyst::Plugin::Foo", + # but "use Catalyst +Foo" looks for "Foo" + @mods = map { + ($list =~ /([+-])\Q$_\E(?:$|[^\w:])/) +- ? ($1 eq "-" ++ ? ($1 eq "-" + ? () # "-Foo": it's a flag, eg. "-Debug", skip it + : $_) # "+Foo": look for "Foo" + : "Catalyst::Plugin::$_" +@@ -1041,12 +1075,12 @@ sub scan_chunk { + + if (/^use \s+ Class::Autouse \b \s* (.*)/sx + or /^Class::Autouse \s* -> \s* autouse \s* (.*)/sx) { +- return [ map { _mod2pm($_) } "Class::Autouse", _parse_list($1) ]; ++ return [ map { _mod2pm($_) } "Class::Autouse", _parse_module_list($1) ]; + } + + # generic "use ..." + if (s/^(?:use|no) \s+//x) { +- my ($mod) = _parse_list($_); # just the first word ++ my ($mod) = _parse_module_list($_); # just the first word + return _mod2pm($mod); + } + +@@ -1065,7 +1099,7 @@ sub scan_chunk { + + # Moose/Moo/Mouse style inheritance or composition + if (s/^(with|extends)\s+//) { +- return [ map { _mod2pm($_) } _parse_list($_) ]; ++ return [ map { _mod2pm($_) } _parse_module_list($_) ]; + } + + # check for stuff like +@@ -1626,7 +1660,7 @@ sub _info2rv { + foreach my $key (keys %{ $info->{'%INC'} }) { + (my $path = $info->{'%INC'}{$key}) =~ s|\\|/|g; + +- # NOTE: %INC may contain (as keys) absolute pathnames, ++ # NOTE: %INC may contain (as keys) absolute pathnames, + # e.g. for autosplit .ix and .al files. In the latter case, + # the key may also start with "./" if found via a relative path in @INC. + $key =~ s|\\|/|g; +-- +2.41.1 + diff --git a/perl-Module-ScanDeps.spec b/perl-Module-ScanDeps.spec index e8556c6..8ed1b8f 100644 --- a/perl-Module-ScanDeps.spec +++ b/perl-Module-ScanDeps.spec @@ -5,11 +5,14 @@ Summary: Recursively scan Perl code for dependencies Name: perl-Module-ScanDeps Version: 1.35 -Release: 3%{?dist} +Release: 4%{?dist} License: GPL+ or Artistic URL: https://metacpan.org/release/Module-ScanDeps Source0: https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-%{version}.tar.gz +Patch0001: 0001-use-three-argument-open.patch +Patch0002: 0002-replace-eval-.-constructs.patch + BuildRequires: coreutils make perl-generators perl-interpreter perl(ExtUtils::MakeMaker) BuildRequires: perl(strict) perl(warnings) perl(B) perl(Config) perl(constant) BuildRequires: perl(Cwd) perl(Data::Dumper) perl(DynaLoader) perl(Encode) perl(Exporter) @@ -29,7 +32,7 @@ This module scans potential modules used by perl programs and returns a hash ref are the module names as they appear in %%INC (e.g. Test/More.pm). The values are hash references. %prep -%autosetup -n Module-ScanDeps-%{version} +%autosetup -p1 -n Module-ScanDeps-%{version} for F in `find t -name *.t -o -name *.pl`; do perl -i -MConfig -ple 'print $Config{startperl} if $. == 1 && !s{\A#!.*perl\b}{$Config{startperl}}' "$F" @@ -57,6 +60,9 @@ make test %{_mandir}/man3/Module::ScanDeps.3pm* %changelog +* Mon Nov 25 2024 Yi Lin - 1.35-4 +- fix CVE-2024-10224 + * Thu Sep 26 2024 OpenCloudOS Release Engineering - 1.35-3 - Rebuilt for clarifying the packages requirement in BaseOS and AppStream -- Gitee