[perl-DB_File] Destroy DB_File objects only from original thread context

Petr Pisar ppisar at fedoraproject.org
Thu Aug 7 14:23:26 UTC 2014


commit 7587e2d1b9c784b0b4648a7b4f29b1ec30133f81
Author: Petr Písař <ppisar at redhat.com>
Date:   Fri Jun 13 09:53:49 2014 +0200

    Destroy DB_File objects only from original thread context

 ...File-objects-only-from-original-thread-co.patch |  179 ++++++++++++++++++++
 perl-DB_File.spec                                  |   10 +-
 2 files changed, 188 insertions(+), 1 deletions(-)
---
diff --git a/DB_File-1.831-Destroy-DB_File-objects-only-from-original-thread-co.patch b/DB_File-1.831-Destroy-DB_File-objects-only-from-original-thread-co.patch
new file mode 100644
index 0000000..84d4add
--- /dev/null
+++ b/DB_File-1.831-Destroy-DB_File-objects-only-from-original-thread-co.patch
@@ -0,0 +1,179 @@
+From d96d40d46bca3c523b1d4d2b580691dc7d8e9802 Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar at 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 at redhat.com>
+---
+ DB_File.xs     | 49 ++++++++++++++++++++++++++++++-------------------
+ MANIFEST       |  1 +
+ t/db-threads.t | 46 ++++++++++++++++++++++++++++++++++++++++++++++
+ 3 files changed, 77 insertions(+), 19 deletions(-)
+ create mode 100644 t/db-threads.t
+
+diff --git a/DB_File.xs b/DB_File.xs
+index 679c416..685888e 100755
+--- a/DB_File.xs
++++ b/DB_File.xs
+@@ -397,6 +397,7 @@ typedef union INFO {
+ 
+ typedef struct {
+ 	DBTYPE	type ;
++	tTHX    owner ;
+ 	DB * 	dbp ;
+ 	SV *	compare ;
+ 	bool	in_compare ;
+@@ -983,6 +984,7 @@ SV *   sv ;
+ 		    name, flags, mode, sv == NULL) ;  
+ #endif
+     Zero(RETVAL, 1, DB_File_type) ;
++    RETVAL->owner = aTHX;
+ 
+     /* Default to HASH */
+     RETVAL->filtering = 0 ;
+@@ -1255,6 +1257,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 ;
+@@ -1571,27 +1574,35 @@ 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:
++	  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..8987e64
+--- /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*>;
+-- 
+1.9.3
+
diff --git a/perl-DB_File.spec b/perl-DB_File.spec
index bb26dcd..d456046 100644
--- a/perl-DB_File.spec
+++ b/perl-DB_File.spec
@@ -1,11 +1,14 @@
 Name:           perl-DB_File
 Version:        1.831
-Release:        2%{?dist}
+Release:        3%{?dist}
 Summary:        Perl5 access to Berkeley DB version 1.x
 License:        GPL+ or Artistic
 Group:          Development/Libraries
 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.831-Destroy-DB_File-objects-only-from-original-thread-co.patch
 BuildRequires:  libdb-devel
 BuildRequires:  perl
 BuildRequires:  perl(Config)
@@ -24,6 +27,7 @@ BuildRequires:  perl(warnings)
 BuildRequires:  perl(XSLoader)
 # Tests:
 BuildRequires:  perl(Symbol)
+BuildRequires:  perl(threads)
 %if !%{defined perl_bootstrap}
 # Optional tests:
 # Data::Dumper not useful
@@ -44,6 +48,7 @@ interface defined here mirrors the Berkeley DB interface closely.
 
 %prep
 %setup -q -n DB_File-%{version}
+%patch0 -p1
 find -type f -exec chmod -x {} +
 %fix_shbang_line dbinfo
 
@@ -67,6 +72,9 @@ make test
 %{_mandir}/man3/*
 
 %changelog
+* Thu Aug 07 2014 Petr Pisar <ppisar at redhat.com> - 1.831-3
+- Destroy DB_File objects only from original thread context (bug #1107732)
+
 * Sat Jun 07 2014 Fedora Release Engineering <rel-eng at lists.fedoraproject.org> - 1.831-2
 - Rebuilt for https://fedoraproject.org/wiki/Fedora_21_Mass_Rebuild
 



More information about the perl-devel mailing list