4 changed files with 193 additions and 48 deletions
--- a/.gitignore
+++ b/.gitignore
@ -1 +1 @@
-SOURCES/DB_File-1.852.tar.gz
+SOURCES/DB_File-1.841.tar.gz
--- a/.perl-DB_File.metadata
+++ b/.perl-DB_File.metadata
@ -1 +1 @@
-d5ea546efe211ba8ac79d4c5e332770d21125e8d SOURCES/DB_File-1.852.tar.gz
+8cea40755c7b2dd77d4081fb3ec43311875be99d SOURCES/DB_File-1.841.tar.gz
--- a/SOURCES/DB_File-1.838-Destroy-DB_File-objects-only-from-original-thread-co.patch
+++ b/SOURCES/DB_File-1.838-Destroy-DB_File-objects-only-from-original-thread-co.patch
@ -0,0 +1,180 @@
+From bfb2cb3cddffa144b521bb5dff76af1e065288ad Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
+Date: Tue, 10 Jun 2014 14:28:09 +0200
+Subject: [PATCH] Destroy DB_File objects only from original thread context
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+This patch fixes a crash when destroing a hash tied to a DB_File
+database after spawning a thread:
+
+use Fcntl;
+use DB_File;
+use threads;
+tie(my %dbtest, 'DB_File', "test.db", O_RDWR|O_CREAT, 0666);
+threads->new(sub {})->join;
+
+This crashed or paniced depending on how perl was configured.
+
+Closes RT#61912.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ DB_File.xs     | 50 +++++++++++++++++++++++++++++++-------------------
+ MANIFEST       |  1 +
+ t/db-threads.t | 46 ++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 78 insertions(+), 19 deletions(-)
+ create mode 100644 t/db-threads.t
+
+diff --git a/DB_File.xs b/DB_File.xs
+index f417b22..ed6a904 100755
+--- a/DB_File.xs
+++ b/DB_File.xs
+@@ -407,6 +407,7 @@ typedef union INFO {
+ 
+ typedef struct {
+ 	DBTYPE	type ;
+	tTHX    owner ;
+ 	DB * 	dbp ;
+ 	SV *	compare ;
+ 	bool	in_compare ;
+@@ -1006,6 +1007,7 @@ SV *   sv ;
+ 		    name, flags, mode, sv == NULL) ;  
+ #endif
+     Zero(RETVAL, 1, DB_File_type) ;
+    RETVAL->owner = aTHX;
+ 
+     /* Default to HASH */
+     RETVAL->filtering = 0 ;
+@@ -1278,6 +1280,7 @@ SV *   sv ;
+ 
+ /* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
+     Zero(RETVAL, 1, DB_File_type) ;
+    RETVAL->owner = aTHX;
+ 
+     /* Default to HASH */
+     RETVAL->filtering = 0 ;
+@@ -1597,27 +1600,36 @@ db_DESTROY(db)
+ 	INIT:
+ 	  CurrentDB = db ;
+ 	  Trace(("DESTROY %p\n", db));
+-	CLEANUP:
+-	  Trace(("DESTROY %p done\n", db));
+-	  if (db->hash)
+-	    SvREFCNT_dec(db->hash) ;
+-	  if (db->compare)
+-	    SvREFCNT_dec(db->compare) ;
+-	  if (db->prefix)
+-	    SvREFCNT_dec(db->prefix) ;
+-	  if (db->filter_fetch_key)
+-	    SvREFCNT_dec(db->filter_fetch_key) ;
+-	  if (db->filter_store_key)
+-	    SvREFCNT_dec(db->filter_store_key) ;
+-	  if (db->filter_fetch_value)
+-	    SvREFCNT_dec(db->filter_fetch_value) ;
+-	  if (db->filter_store_value)
+-	    SvREFCNT_dec(db->filter_store_value) ;
+-	  safefree(db) ;
+	CODE:
+	  RETVAL = 0;
+	  if (db && db->owner == aTHX) {
+	    RETVAL = db_DESTROY(db);
+ #ifdef DB_VERSION_MAJOR
+-	  if (RETVAL > 0)
+-	    RETVAL = -1 ;
+	    if (RETVAL > 0)
+		RETVAL = -1 ;
+ #endif
+	  }
+	OUTPUT:
+	  RETVAL
+	CLEANUP:
+	  Trace(("DESTROY %p done\n", db));
+	  if (db && db->owner == aTHX) {
+	    if (db->hash)
+		SvREFCNT_dec(db->hash) ;
+	    if (db->compare)
+		SvREFCNT_dec(db->compare) ;
+	    if (db->prefix)
+		SvREFCNT_dec(db->prefix) ;
+	    if (db->filter_fetch_key)
+		SvREFCNT_dec(db->filter_fetch_key) ;
+	    if (db->filter_store_key)
+		SvREFCNT_dec(db->filter_store_key) ;
+	    if (db->filter_fetch_value)
+		SvREFCNT_dec(db->filter_fetch_value) ;
+	    if (db->filter_store_value)
+		SvREFCNT_dec(db->filter_store_value) ;
+	    safefree(db) ;
+	  }
+ 
+ 
+ int
+diff --git a/MANIFEST b/MANIFEST
+index e460e81..47f43f7 100644
+--- a/MANIFEST
+++ b/MANIFEST
+@@ -27,6 +27,7 @@ t/db-btree.t
+ t/db-hash.t
+ t/db-recno.t
+ t/pod.t
+t/db-threads.t
+ typemap
+ version.c
+ META.yml                                 Module meta-data (added by MakeMaker)
+diff --git a/t/db-threads.t b/t/db-threads.t
+new file mode 100644
+index 0000000..b9f69b6
+--- /dev/null
+++ b/t/db-threads.t
+@@ -0,0 +1,46 @@
+#!./perl
+
+use warnings;
+use strict;
+use Config;
+use Fcntl;
+use Test::More;
+use DB_File;
+
+if (-d "lib" && -f "TEST") {
+    if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
+        plan skip_all => 'DB_File was not built';
+    }
+}
+plan skip_all => 'Threads are disabled'
+    unless $Config{usethreads};
+
+plan tests => 7;
+
+# Check DBM back-ends do not destroy objects from then-spawned threads.
+# RT#61912.
+use_ok('threads');
+
+my %h;
+unlink <threads*>;
+
+my $db = tie %h, 'DB_File', 'threads', O_RDWR|O_CREAT, 0640;
+isa_ok($db, 'DB_File');
+
+for (1 .. 2) {
+    ok(threads->create(
+        sub {
+            $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
+                # report it by spurious TAP line
+            1;
+        }), "Thread $_ created");
+}
+for (threads->list) {
+    is($_->join, 1, "A thread exited successfully");
+}
+
+pass("Tied object survived exiting threads");
+
+undef $db;
+untie %h;
+unlink <threads*>;
+-- 
+2.5.5
+
--- a/SPECS/perl-DB_File.spec
+++ b/SPECS/perl-DB_File.spec
@ -6,17 +6,19 @@
 %endif

 Name:           perl-DB_File
-Version:        1.852
-Release:        4%{?dist}
+Version:        1.841
+Release:        1%{?dist}
 Summary:        Perl5 access to Berkeley DB version 1.x
 License:        GPL+ or Artistic
-URL:            https://metacpan.org/release/DB_File
-Source0:        https://cpan.metacpan.org/authors/id/P/PM/PMQS/DB_File-%{version}.tar.gz
+URL:            http://search.cpan.org/dist/DB_File/
+Source0:        http://www.cpan.org/authors/id/P/PM/PMQS/DB_File-%{version}.tar.gz
+# Destroy DB_File objects only from original thread context, bug #1107732,
+# CPAN RT#96357
+Patch0:         DB_File-1.838-Destroy-DB_File-objects-only-from-original-thread-co.patch
 BuildRequires:  coreutils
 BuildRequires:  findutils
 BuildRequires:  gcc
 BuildRequires:  libdb-devel
-BuildRequires:  make
 BuildRequires:  perl-devel
 BuildRequires:  perl-generators
 BuildRequires:  perl-interpreter
@ -42,8 +44,6 @@ BuildRequires:  perl(threads)
 # Optional tests:
 # Data::Dumper not useful
 BuildRequires:  perl(Test::Pod) >= 1.00
-BuildRequires:  perl(Test::CPAN::Meta)
-BuildRequires:  perl(Test::CPAN::Meta::JSON)
 %endif
 Requires:       perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
 Requires:       perl(Fcntl)
@ -59,15 +59,16 @@ interface defined here mirrors the Berkeley DB interface closely.

 %prep
 %setup -q -n DB_File-%{version}
+%patch0 -p1
 find -type f -exec chmod -x {} +
 perl -MConfig -pi -e 's|^#!.*perl|$Config{startperl}|' dbinfo

 %build
-perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 NO_PERLLOCAL=1 OPTIMIZE="$RPM_OPT_FLAGS"
-%{make_build}
+perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 OPTIMIZE="$RPM_OPT_FLAGS"
+make %{?_smp_mflags}

 %install
-%{make_install}
+make pure_install DESTDIR=$RPM_BUILD_ROOT
 find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
 %{_fixperms} $RPM_BUILD_ROOT/*

@ -81,42 +82,6 @@ make test
 %{_mandir}/man3/*

 %changelog
-* Fri Jul 26 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1.852-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_31_Mass_Rebuild
-
-* Sun Jun 02 2019 Jitka Plesnikova <jplesnik@redhat.com> - 1.852-3
- Perl 5.30 re-rebuild of bootstrapped packages
-
-* Thu May 30 2019 Jitka Plesnikova <jplesnik@redhat.com> - 1.852-2
- Perl 5.30 rebuild
-
-* Tue Apr 23 2019 Petr Pisar <ppisar@redhat.com> - 1.852-1
- 1.852 bump
-
-* Fri Apr 05 2019 Petr Pisar <ppisar@redhat.com> - 1.851-1
- 1.851 bump
-
-* Wed Apr 03 2019 Petr Pisar <ppisar@redhat.com> - 1.850-1
- 1.850 bump
-
-* Fri Feb 01 2019 Fedora Release Engineering <releng@fedoraproject.org> - 1.843-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_30_Mass_Rebuild
-
-* Mon Nov 05 2018 Petr Pisar <ppisar@redhat.com> - 1.843-1
- 1.843 bump
-
-* Mon Jul 16 2018 Petr Pisar <ppisar@redhat.com> - 1.842-1
- 1.842 bump
-
-* Fri Jul 13 2018 Fedora Release Engineering <releng@fedoraproject.org> - 1.841-4
- Rebuilt for https://fedoraproject.org/wiki/Fedora_29_Mass_Rebuild
-
-* Sat Jun 30 2018 Jitka Plesnikova <jplesnik@redhat.com> - 1.841-3
- Perl 5.28 re-rebuild of bootstrapped packages
-
-* Tue Jun 26 2018 Jitka Plesnikova <jplesnik@redhat.com> - 1.841-2
- Perl 5.28 rebuild
-
 * Tue Apr 03 2018 Petr Pisar <ppisar@redhat.com> - 1.841-1
 - 1.841 bump