!14 [sync] PR-11: Fix CVE-2024-10224

From: @openeuler-sync-bot Reviewed-by: @lyn1001 Signed-off-by: @lyn1001
Fix CVE-2024-10224
2024-11-25 06:16:45 +00:00 · 2024-11-25 11:24:08 +08:00 · 2022-06-16 03:42:49 +00:00 · 2022-06-15 15:33:06 +08:00 · 2020-05-21 16:47:24 +08:00 · 2020-05-21 15:25:57 +08:00
8 changed files with 262 additions and 73 deletions
--- a/CVE-2024-10224-0001-use-three-argument-open.patch
+++ b/CVE-2024-10224-0001-use-three-argument-open.patch
@ -0,0 +1,20 @@
+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(-)
+
+--- a/lib/Module/ScanDeps.pm
+++ b/lib/Module/ScanDeps.pm
+@@ -810,7 +810,7 @@ sub scan_file{
+     my $file = shift;
+     my %found;
+     my $FH;
+-    open $FH, $file or die "Cannot open $file: $!";
+    open $FH, "<", $file or die "Cannot open $file: $!";
+ 
+     $SeenTk = 0;
+     # Line-by-line scanning
--- a/CVE-2024-10224-0002-replace-eval-constructs.patch
+++ b/CVE-2024-10224-0002-replace-eval-constructs.patch
@ -0,0 +1,139 @@
+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(-)
+
+--- a/lib/Module/ScanDeps.pm
+++ b/lib/Module/ScanDeps.pm
+@@ -880,41 +880,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;
+-            };
+-            $module =~ s{::}{/}g;
+-            $found{"$pragma.pm"}++;
+-            $found{"$module.pm"}++;
+            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)}++ 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"
+@@ -932,6 +917,72 @@ sub scan_line {
+     return sort keys %found;
+ }
+ 
+# convert module name to file name
+sub _mod2pm {
+    my $mod = shift;
+    $mod =~ s!::!/!g;
+    return "$mod.pm";
+}
+
+# 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 ":"
+    # and ignore "q", "qq" and "qw"
+    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;
+}
+
+ # short helper for scan_chunk
+ my %LoaderRegexp; # cache
+ sub _build_loader_regexp {
--- a/CVE-2024-10224-0003-fix-parsing-of-use-if.patch
+++ b/CVE-2024-10224-0003-fix-parsing-of-use-if.patch
@ -0,0 +1,31 @@
+From 90476aae7c2b5ef7d94ac1b22672ca8dc4adae20 Mon Sep 17 00:00:00 2001
+From: rschupp <roderich.schupp@gmail.com>
+Date: Thu, 14 Nov 2024 23:09:10 +0100
+Subject: [PATCH] fix parsing of "use if ..."
+
+---
+ lib/Module/ScanDeps.pm | 6 ++++--
+ 1 file changed, 4 insertions(+), 2 deletions(-)
+
+--- a/lib/Module/ScanDeps.pm
+++ b/lib/Module/ScanDeps.pm
+@@ -874,7 +874,7 @@ sub scan_line {
+           }
+         }
+ 
+-        if (my ($pragma, $args) = /^use \s+ (autouse|if) \s+ (.+)/x)
+        if (my ($pragma, $args) = /^(?:use|no) \s+ (autouse|if) \s+ (.+)/x)
+         {
+             # NOTE: There are different ways the MODULE may
+             # be specified for the "autouse" and "if" pragmas, e.g.
+@@ -887,7 +887,9 @@ sub scan_line {
+             else {
+                 # The syntax of the "if" pragma is
+                 #   use if COND, MODULE => ARGUMENTS
+-                (undef, $module) = _parse_module_list($args);
+                # NOTE: This works only for simple conditions.
+                $args =~ s/.*? (?:,|=>) \s*//x;
+                ($module) = _parse_module_list($args);
+             }
+             $found{_mod2pm($pragma)}++;
+             $found{_mod2pm($module)}++ if $module;
--- a/Module-ScanDeps-1.31.tar.gz
+++ b/Module-ScanDeps-1.31.tar.gz
--- a/README.en.md
+++ b/README.en.md
@ -1,36 +0,0 @@
-# perl-Module-ScanDeps
-
-#### Description
-Recursively scan Perl code for dependencies
-
-#### Software Architecture
-Software architecture description
-
-#### Installation
-
-1.  xxxx
-2.  xxxx
-3.  xxxx
-
-#### Instructions
-
-1.  xxxx
-2.  xxxx
-3.  xxxx
-
-#### Contribution
-
-1.  Fork the repository
-2.  Create Feat_xxx branch
-3.  Commit your code
-4.  Create Pull Request
-
-
-#### Gitee Feature
-
-1.  You can use Readme\_XXX.md to support different languages, such as Readme\_en.md, Readme\_zh.md
-2.  Gitee blog [blog.gitee.com](https://blog.gitee.com)
-3.  Explore open source project [https://gitee.com/explore](https://gitee.com/explore)
-4.  The most valuable open source project [GVP](https://gitee.com/gvp)
-5.  The manual of Gitee [https://gitee.com/help](https://gitee.com/help)
-6.  The most popular members  [https://gitee.com/gitee-stars/](https://gitee.com/gitee-stars/)
--- a/README.md
+++ b/README.md
@ -1,37 +0,0 @@
-# perl-Module-ScanDeps
-
-#### 介绍
-Recursively scan Perl code for dependencies
-
-#### 软件架构
-软件架构说明
-
-
-#### 安装教程
-
-1.  xxxx
-2.  xxxx
-3.  xxxx
-
-#### 使用说明
-
-1.  xxxx
-2.  xxxx
-3.  xxxx
-
-#### 参与贡献
-
-1.  Fork 本仓库
-2.  新建 Feat_xxx 分支
-3.  提交代码
-4.  新建 Pull Request
-
-
-#### 码云特技
-
-1.  使用 Readme\_XXX.md 来支持不同的语言，例如 Readme\_en.md, Readme\_zh.md
-2.  码云官方博客 [blog.gitee.com](https://blog.gitee.com)
-3.  你可以 [https://gitee.com/explore](https://gitee.com/explore) 这个地址来了解码云上的优秀开源项目
-4.  [GVP](https://gitee.com/gvp) 全称是码云最有价值开源项目，是码云综合评定出的优秀开源项目
-5.  码云官方提供的使用手册 [https://gitee.com/help](https://gitee.com/help)
-6.  码云封面人物是一档用来展示码云会员风采的栏目 [https://gitee.com/gitee-stars/](https://gitee.com/gitee-stars/)
--- a/perl-Module-ScanDeps.spec
+++ b/perl-Module-ScanDeps.spec
@ -0,0 +1,68 @@
+Name:           perl-Module-ScanDeps
+Version:        1.31
+Release:        2
+Summary:        Recursively scan Perl code for dependencies
+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 
+
+# https://sources.debian.org/src/libmodule-scandeps-perl/1.31-2%2Bdeb12u1/debian/patches/
+Patch0:         CVE-2024-10224-0001-use-three-argument-open.patch
+Patch1:         CVE-2024-10224-0002-replace-eval-constructs.patch
+Patch2:         CVE-2024-10224-0003-fix-parsing-of-use-if.patch
+
+BuildArch:      noarch 
+BuildRequires:  make perl-interpreter perl-generators perl(ExtUtils::MakeMaker) >= 6.76 perl(strict)
+BuildRequires:  perl(warnings) perl(B) perl(Config) perl(constant) perl(Cwd) perl(Data::Dumper) perl(DynaLoader)
+BuildRequires:  perl(Encode) perl(Exporter) perl(File::Basename) perl(File::Find) perl(File::Path)
+BuildRequires:  perl(File::Spec) perl(File::Temp) perl(FileHandle) perl(Module::Metadata) perl(vars) perl(version)
+BuildRequires:  perl(autouse) perl(if) perl(lib) perl(Test::More) perl(Test::Requires)
+BuildRequires:  perl(Test::Pod) >= 1.00
+Requires:       perl(:MODULE_COMPAT_%(eval "$(perl -V:version)"; echo $version))
+Requires:       perl(B) perl(DynaLoader) perl(Data::Dumper) perl(Encode) perl(File::Find) perl(Text::ParseWords) 
+Recommends:     perl(Digest::MD5) perl(Storable) 
+Suggests:       perl(CPANPLUS::Backend)
+
+%description
+This module scans potential modules used by perl programs, and returns a hash reference; its keys are the module 
+names as appears in %INC (e.g. Test/More.pm); the values are hash references.
+
+%package_help
+
+%prep
+%autosetup -n Module-ScanDeps-%{version} -p1
+
+%build
+perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1
+%make_build
+
+%install
+make pure_install DESTDIR=%{buildroot}
+%{_fixperms} %{buildroot}
+
+%check
+make test
+
+%files
+%defattr(-,root,root)
+%doc AUTHORS README
+%license LICENSE
+%{_bindir}/scandeps.pl
+%{perl_vendorlib}/Module/
+
+%files help
+%defattr(-,root,root)
+%doc Changes
+%{_mandir}/man1/scandeps.pl.1*
+%{_mandir}/man3/Module::ScanDeps.3pm*
+
+%changelog
+* Mon Nov 25 2024 yaoxin <yao_xin001@hoperun.com> - 1.31-2
+- Fix CVE-2024-10224
+
+* Tue Jun 14 2022 SimpleUpdate Robot <tc@openeuler.org> - 1.31-1
+- Upgrade to version 1.31
+
+* Fri Jan 10 2020 openEuler Buildteam <buildteam@openeuler.org> - 1.27-6
+- Package init
--- a/perl-Module-ScanDeps.yaml
+++ b/perl-Module-ScanDeps.yaml
@ -0,0 +1,4 @@
+version_control: metacpan
+src_repo: Module-ScanDeps
+tag_prefix: ^v
+seperator: .
Author	SHA1	Message	Date
openeuler-ci-bot	b1e5fae3a3	!14 [sync] PR-11: Fix CVE-2024-10224 From: @openeuler-sync-bot Reviewed-by: @lyn1001 Signed-off-by: @lyn1001	2024-11-25 06:16:45 +00:00
starlet-dx	6c8f1bb7e0	Fix CVE-2024-10224 (cherry picked from commit 0ecb3c7e547cd72f420ee077802f28a1c6af52d4)	2024-11-25 11:24:08 +08:00
openeuler-ci-bot	f335857a42	!6 Package upgrade From: @starlet-dx Reviewed-by: @licihua Signed-off-by: @licihua	2022-06-16 03:42:49 +00:00
starlet-dx	753c45056b	Package upgrade	2022-06-15 15:33:06 +08:00
openeuler-ci-bot	353da53a8b	!4 modify spec and add yaml file Merge pull request !4 from Captain.Wei/master	2020-05-21 16:47:24 +08:00
Captain	9296029840	add build dependancy to fix test failed problem again	2020-05-21 15:25:57 +08:00
Captain	2dc9fafc1e	add build dependancy to fix test failed problem	2020-05-21 14:28:15 +08:00
Captain Wei	3787b65489	add yaml file	2020-05-11 15:56:57 +08:00
openeuler-ci-bot	4d772c521f	!1 Package init Merge pull request !1 from orange-snn/lwdev	2020-01-13 13:28:06 +08:00
liuwei	6c608c94b2	modify	2020-01-11 17:39:12 +08:00