[AUTO-PR] azure-core/azurelinux:fasttrack/pawelwi/CVE-2024-10224_fix

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

@@ -0,0 +1,245 @@
+From 9a46eab1c78656386ba9d18bc4b341f4b2561635 Mon Sep 17 00:00:00 2001
+From: rschupp <roderich.schupp@gmail.com>
+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 <roderich.schupp@gmail.com>
+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;

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

@@ -2,10 +2,11 @@
 Summary:        Recursively scan Perl code for dependencies
 Name:           perl-Module-ScanDeps
 Version:        1.35
-Release:        1%{?dist}
+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:   Azure Linux
@@ -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
@@ -64,6 +65,9 @@ make %{?_smp_mflags} test
 %{_mandir}/man3/*
 
 %changelog
+* Fri Nov 15 2024 Pawel Winogrodzki <pawelwi@microsoft.com> - 1.35-2
+- Patched CVE-2024-10224.
+
 * Mon Dec 18 2023 CBL-Mariner Servicing Account <cblmargh@microsoft.com> - 1.35-1
 - Auto-upgrade to 1.35 - Azure Linux 3.0 - package upgrades