From d2b8ff9332d936a0191352a18715424fe94686f3 Mon Sep 17 00:00:00 2001 From: dongyuzhen Date: Thu, 1 Aug 2024 16:41:48 +0800 Subject: [PATCH] backport patch from upstream --- backport-Fix-LWP-corruption.patch | 53 +++++++++++++++++++++++++++++++ perl-File-Fetch.spec | 10 ++++-- 2 files changed, 61 insertions(+), 2 deletions(-) create mode 100644 backport-Fix-LWP-corruption.patch diff --git a/backport-Fix-LWP-corruption.patch b/backport-Fix-LWP-corruption.patch new file mode 100644 index 0000000..f627414 --- /dev/null +++ b/backport-Fix-LWP-corruption.patch @@ -0,0 +1,53 @@ +From 979afa9c5638777355170f85ef8d7bf82117c075 Mon Sep 17 00:00:00 2001 +From: Denis Ibaev +Date: Fri, 20 Aug 2021 23:15:34 +0300 +Subject: [PATCH] Fix LWP corruption + +--- + lib/File/Fetch.pm | 19 ++++++++++++++----- + 1 file changed, 14 insertions(+), 5 deletions(-) + +diff --git a/lib/File/Fetch.pm b/lib/File/Fetch.pm +index e08992e..5f87dba 100644 +--- a/lib/File/Fetch.pm ++++ b/lib/File/Fetch.pm +@@ -491,7 +491,9 @@ sub fetch { + next if grep { lc $_ eq $method } @$BLACKLIST; + + ### method is known to fail ### +- next if $METHOD_FAIL->{$method}; ++ next if ref $METHOD_FAIL->{$method} ++ ? $METHOD_FAIL->{$method}{$self->scheme} ++ : $METHOD_FAIL->{$method}; + + ### there's serious issues with IPC::Run and quoting of command + ### line arguments. using quotes in the wrong place breaks things, +@@ -569,10 +571,6 @@ sub _lwp_fetch { + + }; + +- if ($self->scheme eq 'https') { +- $use_list->{'LWP::Protocol::https'} = '0'; +- } +- + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; + unless( can_load( modules => $use_list ) ) { +@@ -580,6 +578,17 @@ sub _lwp_fetch { + return; + } + ++ if ($self->scheme eq 'https') { ++ my $https_use_list = { ++ 'LWP::Protocol::https' => '0.0', ++ }; ++ ++ unless ( can_load(modules => $https_use_list) ) { ++ $METHOD_FAIL->{'lwp'} = { 'https' => 1 }; ++ return; ++ } ++ } ++ + ### setup the uri object + my $uri = URI->new( File::Spec::Unix->catfile( + $self->path, $self->file diff --git a/perl-File-Fetch.spec b/perl-File-Fetch.spec index 39c61ff..80c7399 100644 --- a/perl-File-Fetch.spec +++ b/perl-File-Fetch.spec @@ -1,10 +1,13 @@ Name: perl-File-Fetch Version: 1.04 -Release: 1 +Release: 2 Summary: A generic file fetching mechanism License: GPL+ or Artistic URL: https://perldoc.perl.org/File/Fetch.html Source0: http://www.cpan.org/authors/id/B/BI/BINGOS/File-Fetch-%{version}.tar.gz + +Patch6000: backport-Fix-LWP-corruption.patch + BuildArch: noarch BuildRequires: gcc git make perl-generators perl-interpreter perl(ExtUtils::MakeMaker) >= 6.76 perl(strict) BuildRequires: perl(Carp) perl(constant) perl(Cwd) perl(File::Basename) perl(File::Copy) perl(File::Path) @@ -25,7 +28,7 @@ See the HOW IT WORKS section further down for details. %package_help %prep -%autosetup -n File-Fetch-%{version} +%autosetup -n File-Fetch-%{version} -p1 %build perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 @@ -47,6 +50,9 @@ make test %{_mandir}/man3/* %changelog +* Thu Aug 1 2024 dongyuzhen - 1.04-2 +- backport patch from upstream + * Sat Oct 22 2022 dongyuzhen - 1.04-1 - upgrade version to 1.04 -- Gitee