Attachment 907248 Details for Bug 1104827 – DB_File fix proposed to upstream

[patch] DB_File fix proposed to upstream

0001-Destroy-DB_File-objects-only-from-original-thread-co.patch (text/plain), 4.35 KB, created by Petr Pisar on 2014-06-10 13:17:12 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Petr Pisar

Created: 2014-06-10 13:17:12 UTC

Size: 4.35 KB

patch

obsolete

>From d96d40d46bca3c523b1d4d2b580691dc7d8e9802 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     | 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
>

Actions: View | Diff

Attachments on bug 1104827: 902406 | 902531 | 907058 | 907181 | 907248