Skip to content

Commit 5456ed5

Browse files
CBL-Mariner-BotCBL-Mariner-Bot
authored
[AUTO-CHERRYPICK] [AUTO-PR] azure-core/azurelinux:fasttrack/pawelwi/CVE-2024-10224_fix - branch 3.0-dev (microsoft#11220)
1 parent 8335428 commit 5456ed5

File tree

2 files changed

+251
-2
lines changed

2 files changed

+251
-2
lines changed

‎SPECS/perl-Module-ScanDeps/CVE-2024-10224.patch

+245
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,245 @@
1+
From 9a46eab1c78656386ba9d18bc4b341f4b2561635 Mon Sep 17 00:00:00 2001
2+
From: rschupp <[email protected]>
3+
Date: Mon, 21 Oct 2024 14:03:19 +0200
4+
Subject: [PATCH] use three-argument open()
5+
6+
---
7+
lib/Module/ScanDeps.pm | 2 +-
8+
1 file changed, 1 insertion(+), 1 deletion(-)
9+
10+
diff --git a/lib/Module/ScanDeps.pm b/lib/Module/ScanDeps.pm
11+
index cabab58..7bc9662 100644
12+
--- a/lib/Module/ScanDeps.pm
13+
+++ b/lib/Module/ScanDeps.pm
14+
@@ -868,7 +868,7 @@ sub scan_deps_runtime {
15+
sub scan_file{
16+
my $file = shift;
17+
my %found;
18+
- open my $fh, $file or die "Cannot open $file: $!";
19+
+ open my $fh, "<", $file or die "Cannot open $file: $!";
20+
21+
$SeenTk = 0;
22+
# Line-by-line scanning
23+
24+
25+
From bc57e5072fc7ace1d206246999dd852652939335 Mon Sep 17 00:00:00 2001
26+
From: rschupp <[email protected]>
27+
Date: Mon, 21 Oct 2024 14:08:01 +0200
28+
Subject: [PATCH] replace 'eval "..."' constructs
29+
30+
---
31+
lib/Module/ScanDeps.pm | 122 ++++++++++++++++++++++++++---------------
32+
1 file changed, 78 insertions(+), 44 deletions(-)
33+
34+
diff --git a/lib/Module/ScanDeps.pm b/lib/Module/ScanDeps.pm
35+
index 7bc9662..dd79c65 100644
36+
--- a/lib/Module/ScanDeps.pm
37+
+++ b/lib/Module/ScanDeps.pm
38+
@@ -226,8 +226,8 @@ my $SeenTk;
39+
my %SeenRuntimeLoader;
40+
41+
# match "use LOADER LIST" chunks; sets $1 to LOADER and $2 to LIST
42+
-my $LoaderRE =
43+
- qr/^ use \s+
44+
+my $LoaderRE =
45+
+ qr/^ use \s+
46+
( asa
47+
| base
48+
| parent
49+
@@ -714,19 +714,14 @@ sub scan_deps {
50+
require FindBin;
51+
52+
local $FindBin::Bin;
53+
- local $FindBin::RealBin;
54+
- local $FindBin::Script;
55+
- local $FindBin::RealScript;
56+
+ #local $FindBin::RealBin;
57+
+ #local $FindBin::Script;
58+
+ #local $FindBin::RealScript;
59+
60+
my $_0 = $args{files}[0];
61+
local *0 = \$_0;
62+
FindBin->again();
63+
64+
- our $Bin = $FindBin::Bin;
65+
- our $RealBin = $FindBin::RealBin;
66+
- our $Script = $FindBin::Script;
67+
- our $RealScript = $FindBin::RealScript;
68+
-
69+
scan_deps_static(\%args);
70+
}
71+
72+
@@ -936,40 +931,26 @@ sub scan_line {
73+
# be specified for the "autouse" and "if" pragmas, e.g.
74+
# use autouse Module => qw(func1 func2);
75+
# use autouse "Module", qw(func1);
76+
- # To avoid to parse them ourself, we simply try to eval the
77+
- # string after the pragma (in a list context). The MODULE
78+
- # should be the first ("autouse") or second ("if") element
79+
- # of the list.
80+
my $module;
81+
- {
82+
- no strict; no warnings;
83+
- if ($pragma eq "autouse") {
84+
- ($module) = eval $args;
85+
- }
86+
- else {
87+
- # The syntax of the "if" pragma is
88+
- # use if COND, MODULE => ARGUMENTS
89+
- # The COND may contain undefined functions (i.e. undefined
90+
- # in Module::ScanDeps' context) which would throw an
91+
- # exception. Sneak "1 || " in front of COND so that
92+
- # COND will not be evaluated. This will work in most
93+
- # cases, but there are operators with lower precedence
94+
- # than "||" which will cause this trick to fail.
95+
- (undef, $module) = eval "1 || $args";
96+
- }
97+
- # punt if there was a syntax error
98+
- return if $@ or !defined $module;
99+
- };
100+
+ if ($pragma eq "autouse") {
101+
+ ($module) = _parse_module_list($args);
102+
+ }
103+
+ else {
104+
+ # The syntax of the "if" pragma is
105+
+ # use if COND, MODULE => ARGUMENTS
106+
+ (undef, $module) = _parse_module_list($args);
107+
+ }
108+
$found{_mod2pm($pragma)}++;
109+
- $found{_mod2pm($module)}++;
110+
+ $found{_mod2pm($module)}++ if $module;
111+
next CHUNK;
112+
}
113+
114+
- if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s+ ,) (.+)/x)
115+
+ if (my ($how, $libs) = /^(use \s+ lib \s+ | (?:unshift|push) \s+ \@INC \s*,\s*) (.+)/x)
116+
{
117+
my $archname = defined($Config{archname}) ? $Config{archname} : '';
118+
my $ver = defined($Config{version}) ? $Config{version} : '';
119+
- foreach my $dir (do { no strict; no warnings; eval $libs }) {
120+
+ while ((my $dir, $libs) = _parse_libs($libs))
121+
+ {
122+
next unless defined $dir;
123+
my @dirs = $dir;
124+
push @dirs, "$dir/$ver", "$dir/$archname", "$dir/$ver/$archname"
125+
@@ -995,8 +976,8 @@ sub _mod2pm {
126+
return "$mod.pm";
127+
}
128+
129+
-# parse a comma-separated list of string literals and qw() lists
130+
-sub _parse_list {
131+
+# parse a comma-separated list of module names (as string literals or qw() lists)
132+
+sub _parse_module_list {
133+
my $list = shift;
134+
135+
# split $list on anything that's not a word character or ":"
136+
@@ -1004,6 +985,59 @@ sub _parse_list {
137+
return grep { length and !/^:|^q[qw]?$/ } split(/[^\w:]+/, $list);
138+
}
139+
140+
+# incrementally parse a comma separated list library paths:
141+
+# returning a pair: the contents of the first strings literal and the remainder of the string
142+
+# - for "string", 'string', q/string/, qq/string/ also unescape \\ and \<delimiter>)
143+
+# - for qw(foo bar quux) return ("foo", qw(bar quux))
144+
+# - otherwise skip over the first comma and return (undef, "remainder")
145+
+# - return () if the string is exhausted
146+
+# - as a special case, if the string starts with $FindBin::Bin, replace it with our $Bin
147+
+sub _parse_libs {
148+
+ local $_ = shift;
149+
+
150+
+ s/^[\s,]*//;
151+
+ return if $_ eq "";
152+
+
153+
+ if (s/^(['"]) ((?:\\.|.)*?) \1//x) {
154+
+ return (_unescape($1, $2), $_);
155+
+ }
156+
+ if (s/^qq? \s* (\W)//x) {
157+
+ my $opening_delim = $1;
158+
+ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:;
159+
+ s/^((?:\\.|.)*?) \Q$closing_delim\E//x;
160+
+ return (_unescape($opening_delim, $1), $_);
161+
+ }
162+
+
163+
+ if (s/^qw \s* (\W)//x) {
164+
+ my $opening_delim = $1;
165+
+ (my $closing_delim = $opening_delim) =~ tr:([{<:)]}>:;
166+
+ s/^((?:\\.|.)*?) \Q$closing_delim\E//x;
167+
+ my $contents = $1;
168+
+ my @list = split(" ", $contents);
169+
+ return (undef, $_) unless @list;
170+
+ my $first = shift @list;
171+
+ return (_unescape($opening_delim, $first),
172+
+ @list ? "qw${opening_delim}@list${closing_delim}$_" : $_);
173+
+ }
174+
+
175+
+ # nothing recognizable in the first list item, skip to the next
176+
+ if (s/^.*? ,//x) {
177+
+ return (undef, $_);
178+
+ }
179+
+ return; # list exhausted
180+
+}
181+
+
182+
+
183+
+sub _unescape {
184+
+ my ($delim, $str) = @_;
185+
+ $str =~ s/\\([\\\Q$delim\E])/$1/g;
186+
+ $str =~ s/^\$FindBin::Bin\b/$FindBin::Bin/;
187+
+
188+
+ return $str;
189+
+}
190+
+
191+
+
192+
+
193+
sub scan_chunk {
194+
my $chunk = shift;
195+
196+
@@ -1025,14 +1059,14 @@ sub scan_chunk {
197+
# "use LOADER LIST"
198+
# TODO: There's many more of these "loader" type modules on CPAN!
199+
if (my ($loader, $list) = $_ =~ $LoaderRE) {
200+
- my @mods = _parse_list($list);
201+
+ my @mods = _parse_module_list($list);
202+
203+
if ($loader eq "Catalyst") {
204+
# "use Catalyst 'Foo'" looks for "Catalyst::Plugin::Foo",
205+
# but "use Catalyst +Foo" looks for "Foo"
206+
@mods = map {
207+
($list =~ /([+-])\Q$_\E(?:$|[^\w:])/)
208+
- ? ($1 eq "-"
209+
+ ? ($1 eq "-"
210+
? () # "-Foo": it's a flag, eg. "-Debug", skip it
211+
: $_) # "+Foo": look for "Foo"
212+
: "Catalyst::Plugin::$_"
213+
@@ -1044,12 +1078,12 @@ sub scan_chunk {
214+
215+
if (/^use \s+ Class::Autouse \b \s* (.*)/sx
216+
or /^Class::Autouse \s* -> \s* autouse \s* (.*)/sx) {
217+
- return [ map { _mod2pm($_) } "Class::Autouse", _parse_list($1) ];
218+
+ return [ map { _mod2pm($_) } "Class::Autouse", _parse_module_list($1) ];
219+
}
220+
221+
# generic "use ..."
222+
if (s/^(?:use|no) \s+//x) {
223+
- my ($mod) = _parse_list($_); # just the first word
224+
+ my ($mod) = _parse_module_list($_); # just the first word
225+
return _mod2pm($mod);
226+
}
227+
228+
@@ -1068,7 +1102,7 @@ sub scan_chunk {
229+
230+
# Moose/Moo/Mouse style inheritance or composition
231+
if (s/^(with|extends)\s+//) {
232+
- return [ map { _mod2pm($_) } _parse_list($_) ];
233+
+ return [ map { _mod2pm($_) } _parse_module_list($_) ];
234+
}
235+
236+
# check for stuff like
237+
@@ -1629,7 +1663,7 @@ sub _info2rv {
238+
foreach my $key (keys %{ $info->{'%INC'} }) {
239+
(my $path = $info->{'%INC'}{$key}) =~ s|\\|/|g;
240+
241+
- # NOTE: %INC may contain (as keys) absolute pathnames,
242+
+ # NOTE: %INC may contain (as keys) absolute pathnames,
243+
# e.g. for autosplit .ix and .al files. In the latter case,
244+
# the key may also start with "./" if found via a relative path in @INC.
245+
$key =~ s|\\|/|g;

‎SPECS/perl-Module-ScanDeps/perl-Module-ScanDeps.spec

+6-2
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,11 @@
22
Summary: Recursively scan Perl code for dependencies
33
Name: perl-Module-ScanDeps
44
Version: 1.35
5-
Release: 1%{?dist}
5+
Release: 2%{?dist}
66
License: GPL+ or Artistic
77
Group: Development/Libraries
88
Source0: https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-%{version}.tar.gz
9+
Patch0: CVE-2024-10224.patch
910
URL: http://search.cpan.org/dist/Module-ScanDeps/
1011
Vendor: Microsoft Corporation
1112
Distribution: Azure Linux
@@ -39,7 +40,7 @@ hash reference. Its keys are the module names as they appear in %%INC (e.g.
3940
Test/More.pm). The values are hash references.
4041

4142
%prep
42-
%setup -q -n Module-ScanDeps-%{version}
43+
%autosetup -n Module-ScanDeps-%{version} -p1
4344

4445
%build
4546
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1
@@ -64,6 +65,9 @@ make %{?_smp_mflags} test
6465
%{_mandir}/man3/*
6566

6667
%changelog
68+
* Fri Nov 15 2024 Pawel Winogrodzki <[email protected]> - 1.35-2
69+
- Patched CVE-2024-10224.
70+
6771
* Mon Dec 18 2023 CBL-Mariner Servicing Account <[email protected]> - 1.35-1
6872
- Auto-upgrade to 1.35 - Azure Linux 3.0 - package upgrades
6973

0 commit comments

Comments
 (0)