Compare commits
10 Commits
e709a52858
...
b1e5fae3a3
| Author | SHA1 | Date | |
|---|---|---|---|
|
b1e5fae3a3 | ||
|
|
6c8f1bb7e0 | ||
|
|
f335857a42 | ||
|
|
753c45056b | ||
|
|
353da53a8b | ||
|
|
9296029840 | ||
|
|
2dc9fafc1e | ||
|
|
3787b65489 | ||
|
|
4d772c521f | ||
|
|
6c608c94b2 |
20
CVE-2024-10224-0001-use-three-argument-open.patch
Normal file
20
CVE-2024-10224-0001-use-three-argument-open.patch
Normal file
@ -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
|
||||
139
CVE-2024-10224-0002-replace-eval-constructs.patch
Normal file
139
CVE-2024-10224-0002-replace-eval-constructs.patch
Normal file
@ -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 {
|
||||
31
CVE-2024-10224-0003-fix-parsing-of-use-if.patch
Normal file
31
CVE-2024-10224-0003-fix-parsing-of-use-if.patch
Normal file
@ -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;
|
||||
BIN
Module-ScanDeps-1.31.tar.gz
Normal file
BIN
Module-ScanDeps-1.31.tar.gz
Normal file
Binary file not shown.
36
README.en.md
36
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/)
|
||||
37
README.md
37
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/)
|
||||
68
perl-Module-ScanDeps.spec
Normal file
68
perl-Module-ScanDeps.spec
Normal file
@ -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
|
||||
4
perl-Module-ScanDeps.yaml
Normal file
4
perl-Module-ScanDeps.yaml
Normal file
@ -0,0 +1,4 @@
|
||||
version_control: metacpan
|
||||
src_repo: Module-ScanDeps
|
||||
tag_prefix: ^v
|
||||
seperator: .
|
||||
Loading…
x
Reference in New Issue
Block a user