From d2b8ff9332d936a0191352a18715424fe94686f3 Mon Sep 17 00:00:00 2001
From: dongyuzhen <dongyuzhen@h-partners.com>
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 <dionys@gmail.com>
+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 <dongyuzhen@h-partners.com> - 1.04-2
+- backport patch from upstream
+
 * Sat Oct 22 2022 dongyuzhen <dongyuzhen@h-partners.com> - 1.04-1
 - upgrade version to 1.04
 
-- 
Gitee