Skip to content

Commit

Permalink
[AUTO-CHERRYPICK] [AUTO-PR] azure-core/azurelinux:fasttrack/pawelwi/C…
Browse files Browse the repository at this point in the history 
…VE-2024-10224_fix_2.0 - branch main (#11188)

Co-authored-by: Pawel Winogrodzki <[email protected]>
  • Loading branch information
@CBL-Mariner-Bot @PawelWMS
CBL-Mariner-Bot and PawelWMS authored Nov 23, 2024
1 parent 8c06840 commit 7571f1b
Show file tree
Hide file tree
Showing 4 changed files with 270 additions and 18 deletions.
245 changes: 245 additions & 0 deletions SPECS/perl-Module-ScanDeps/CVE-2024-10224.patch
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,245 @@
From 9a46eab1c78656386ba9d18bc4b341f4b2561635 Mon Sep 17 00:00:00 2001
From: rschupp <[email protected]>
Date: Mon, 21 Oct 2024 14:03:19 +0200
Subject: [PATCH] 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 cabab58..7bc9662 100644
--- a/lib/Module/ScanDeps.pm
+++ b/lib/Module/ScanDeps.pm
@@ -868,7 +868,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


From bc57e5072fc7ace1d206246999dd852652939335 Mon Sep 17 00:00:00 2001
From: rschupp <[email protected]>
Date: Mon, 21 Oct 2024 14:08:01 +0200
Subject: [PATCH] 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 7bc9662..dd79c65 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
@@ -714,19 +714,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);
}

@@ -936,40 +931,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"
@@ -995,8 +976,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 ":"
@@ -1004,6 +985,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 \<delimiter>)
+# - 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;

@@ -1025,14 +1059,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::$_"
@@ -1044,12 +1078,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);
}

@@ -1068,7 +1102,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
@@ -1629,7 +1663,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;
6 changes: 3 additions & 3 deletions SPECS/perl-Module-ScanDeps/perl-Module-ScanDeps.signatures.json
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
{
"Signatures": {
"Module-ScanDeps-1.31.tar.gz": "fc4d98d2b0015745f3b55b51ddf4445a73b069ad0cb7ec36d8ea781d61074d9d"
}
"Signatures": {
"Module-ScanDeps-1.35.tar.gz": "e5beb3adf55be3dab71f9a1416d4bad57b14e5e05c96370741b9d8f96a51b612"
}
}
13 changes: 10 additions & 3 deletions SPECS/perl-Module-ScanDeps/perl-Module-ScanDeps.spec
View file
Original file line number Diff line number Diff line change
@@ -1,19 +1,20 @@
# Got the intial spec from Fedora and modified it
Summary: Recursively scan Perl code for dependencies
Name: perl-Module-ScanDeps
Version: 1.31
Version: 1.35
Release: 2%{?dist}
License: GPL+ or Artistic
Group: Development/Libraries
Source0: https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-%{version}.tar.gz
Patch0: CVE-2024-10224.patch
URL: http://search.cpan.org/dist/Module-ScanDeps/
Vendor: Microsoft Corporation
Distribution: Mariner
BuildArch: noarch
BuildRequires: perl >= 5.28.0
BuildRequires: perl(ExtUtils::MakeMaker)
BuildRequires: perl-generators
%if %{with_check}
%if 0%{?with_check}
BuildRequires: perl(CPAN)
BuildRequires: perl(CPAN::Meta)
BuildRequires: perl(FindBin)
Expand All @@ -39,7 +40,7 @@ hash reference. Its keys are the module names as they appear in %%INC (e.g.
Test/More.pm). The values are hash references.

%prep
%setup -q -n Module-ScanDeps-%{version}
%autosetup -n Module-ScanDeps-%{version} -p1

%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1
Expand All @@ -64,6 +65,12 @@ make %{?_smp_mflags} test
%{_mandir}/man3/*

%changelog
* Fri Nov 15 2024 Pawel Winogrodzki <[email protected]> - 1.35-2
- Patched CVE-2024-10224.

* Mon Dec 18 2023 CBL-Mariner Servicing Account <[email protected]> - 1.35-1
- Auto-upgrade to 1.35 - Azure Linux 3.0 - package upgrades

* Tue Aug 23 2020 Muhammad Falak <[email protected]> - 1.31-2
- Add BR on `perl-{(CPAN::*),(FindBin),(Test::More)}` to enable ptest

Expand Down
24 changes: 12 additions & 12 deletions cgmanifest.json
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13568,16 +13568,6 @@
}
}
},
{
"component": {
"type": "other",
"other": {
"name": "mosh",
"version": "1.4.0",
"downloadUrl": "https://github.com/mobile-shell/mosh/releases/download/mosh-1.4.0/mosh-1.4.0.tar.gz"
}
}
},
{
"component": {
"type": "other",
Expand Down Expand Up @@ -13608,6 +13598,16 @@
}
}
},
{
"component": {
"type": "other",
"other": {
"name": "mosh",
"version": "1.4.0",
"downloadUrl": "https://github.com/mobile-shell/mosh/releases/download/mosh-1.4.0/mosh-1.4.0.tar.gz"
}
}
},
{
"component": {
"type": "other",
Expand Down Expand Up @@ -18794,8 +18794,8 @@
"type": "other",
"other": {
"name": "perl-Module-ScanDeps",
"version": "1.31",
"downloadUrl": "https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-1.31.tar.gz"
"version": "1.35",
"downloadUrl": "https://cpan.metacpan.org/authors/id/R/RS/RSCHUPP/Module-ScanDeps-1.35.tar.gz"
}
}
},
Expand Down

0 comments on commit 7571f1b

Please sign in to comment.