34484a
From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
34484a
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
34484a
Date: Fri, 6 Jun 2014 14:31:59 +0200
34484a
Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original
34484a
 thread context
34484a
MIME-Version: 1.0
34484a
Content-Type: text/plain; charset=UTF-8
34484a
Content-Transfer-Encoding: 8bit
34484a
34484a
This patch fixes a crash when destroing a hash tied to a *_File
34484a
database after spawning a thread:
34484a
34484a
use Fcntl;
34484a
use SDBM_File;
34484a
use threads;
34484a
tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);
34484a
threads->new(sub {})->join;
34484a
34484a
This crashed or paniced depending on how perl was configured.
34484a
34484a
Closes RT#61912.
34484a
34484a
Signed-off-by: Petr Písař <ppisar@redhat.com>
34484a
---
34484a
 ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------
34484a
 ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------
34484a
 ext/ODBM_File/ODBM_File.xs | 18 +++++++++++-------
34484a
 ext/SDBM_File/SDBM_File.xs |  4 +++-
34484a
 t/lib/dbmt_common.pl       | 35 +++++++++++++++++++++++++++++++++++
34484a
 5 files changed, 69 insertions(+), 20 deletions(-)
34484a
34484a
diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
34484a
index 33e08e2..7160f54 100644
34484a
--- a/ext/GDBM_File/GDBM_File.xs
34484a
+++ b/ext/GDBM_File/GDBM_File.xs
34484a
@@ -13,6 +13,7 @@
34484a
 #define store_value 3
34484a
 
34484a
 typedef struct {
34484a
+	tTHX    owner;
34484a
 	GDBM_FILE 	dbp ;
34484a
 	SV *    filter[4];
34484a
 	int     filtering ;
34484a
@@ -89,6 +90,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode)
34484a
 	    if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode,
34484a
 	       	     	          (FATALFUNC) croak_string))) {
34484a
 	        RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ;
34484a
+		RETVAL->owner = aTHX;
34484a
 		RETVAL->dbp = dbp ;
34484a
 	    }
34484a
 	    
34484a
@@ -109,12 +111,14 @@ gdbm_DESTROY(db)
34484a
 	PREINIT:
34484a
 	int i = store_value;
34484a
 	CODE:
34484a
-	gdbm_close(db);
34484a
-	do {
34484a
-	    if (db->filter[i])
34484a
-		SvREFCNT_dec(db->filter[i]);
34484a
-	} while (i-- > 0);
34484a
-	safefree(db);
34484a
+	if (db && db->owner == aTHX) {
34484a
+	    gdbm_close(db);
34484a
+	    do {
34484a
+		if (db->filter[i])
34484a
+		    SvREFCNT_dec(db->filter[i]);
34484a
+	    } while (i-- > 0);
34484a
+	    safefree(db);
34484a
+	}
34484a
 
34484a
 #define gdbm_FETCH(db,key)			gdbm_fetch(db->dbp,key)
34484a
 datum_value
34484a
diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
34484a
index 52e60fc..af223e5 100644
34484a
--- a/ext/NDBM_File/NDBM_File.xs
34484a
+++ b/ext/NDBM_File/NDBM_File.xs
34484a
@@ -33,6 +33,7 @@ END_EXTERN_C
34484a
 #define store_value 3
34484a
 
34484a
 typedef struct {
34484a
+	tTHX    owner;
34484a
 	DBM * 	dbp ;
34484a
 	SV *    filter[4];
34484a
 	int     filtering ;
34484a
@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
34484a
 	    RETVAL = NULL ;
34484a
 	    if ((dbp =  dbm_open(filename, flags, mode))) {
34484a
 	        RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
34484a
+		RETVAL->owner = aTHX;
34484a
 		RETVAL->dbp = dbp ;
34484a
 	    }
34484a
 	    
34484a
@@ -84,12 +86,14 @@ ndbm_DESTROY(db)
34484a
 	PREINIT:
34484a
 	int i = store_value;
34484a
 	CODE:
34484a
-	dbm_close(db->dbp);
34484a
-	do {
34484a
-	    if (db->filter[i])
34484a
-		SvREFCNT_dec(db->filter[i]);
34484a
-	} while (i-- > 0);
34484a
-	safefree(db);
34484a
+	if (db && db->owner == aTHX) {
34484a
+	    dbm_close(db->dbp);
34484a
+	    do {
34484a
+		if (db->filter[i])
34484a
+		    SvREFCNT_dec(db->filter[i]);
34484a
+	    } while (i-- > 0);
34484a
+	    safefree(db);
34484a
+	}
34484a
 
34484a
 #define ndbm_FETCH(db,key)			dbm_fetch(db->dbp,key)
34484a
 datum_value
34484a
diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
34484a
index d1ece7f..f7e00a0 100644
34484a
--- a/ext/ODBM_File/ODBM_File.xs
34484a
+++ b/ext/ODBM_File/ODBM_File.xs
34484a
@@ -45,6 +45,7 @@ datum	nextkey(datum key);
34484a
 #define store_value 3
34484a
 
34484a
 typedef struct {
34484a
+	tTHX    owner;
34484a
 	void * 	dbp ;
34484a
 	SV *    filter[4];
34484a
 	int     filtering ;
34484a
@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
34484a
 	    }
34484a
 	    dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
34484a
 	    RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
34484a
+	    RETVAL->owner = aTHX;
34484a
 	    RETVAL->dbp = dbp ;
34484a
 	}
34484a
 	OUTPUT:
34484a
@@ -124,13 +126,15 @@ DESTROY(db)
34484a
 	dMY_CXT;
34484a
 	int i = store_value;
34484a
 	CODE:
34484a
-	dbmrefcnt--;
34484a
-	dbmclose();
34484a
-	do {
34484a
-	    if (db->filter[i])
34484a
-		SvREFCNT_dec(db->filter[i]);
34484a
-	} while (i-- > 0);
34484a
-	safefree(db);
34484a
+	if (db && db->owner == aTHX) {
34484a
+	    dbmrefcnt--;
34484a
+	    dbmclose();
34484a
+	    do {
34484a
+		if (db->filter[i])
34484a
+		    SvREFCNT_dec(db->filter[i]);
34484a
+	    } while (i-- > 0);
34484a
+	    safefree(db);
34484a
+	}
34484a
 
34484a
 datum_value
34484a
 odbm_FETCH(db, key)
34484a
diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
34484a
index 291e41b..0bdae9a 100644
34484a
--- a/ext/SDBM_File/SDBM_File.xs
34484a
+++ b/ext/SDBM_File/SDBM_File.xs
34484a
@@ -10,6 +10,7 @@
34484a
 #define store_value 3
34484a
 
34484a
 typedef struct {
34484a
+	tTHX    owner;
34484a
 	DBM * 	dbp ;
34484a
 	SV *    filter[4];
34484a
 	int     filtering ;
34484a
@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
34484a
 	    }
34484a
 	    if (dbp) {
34484a
 	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
34484a
+		RETVAL->owner = aTHX;
34484a
 		RETVAL->dbp = dbp ;
34484a
 	    }
34484a
 	    
34484a
@@ -60,7 +62,7 @@ void
34484a
 sdbm_DESTROY(db)
34484a
 	SDBM_File	db
34484a
 	CODE:
34484a
-	if (db) {
34484a
+	if (db && db->owner == aTHX) {
34484a
 	    int i = store_value;
34484a
 	    sdbm_close(db->dbp);
34484a
 	    do {
34484a
diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
34484a
index 5d4098c..a0a4d52 100644
34484a
--- a/t/lib/dbmt_common.pl
34484a
+++ b/t/lib/dbmt_common.pl
34484a
@@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
34484a
    unlink <Op1_dbmx*>;
34484a
 }
34484a
 
34484a
+{
34484a
+   # Check DBM back-ends do not destroy objects from then-spawned threads.
34484a
+   # RT#61912.
34484a
+   SKIP: {
34484a
+      my $threads_count = 2;
34484a
+      skip 'Threads are disabled', 3 + 2 * $threads_count
34484a
+        unless $Config{usethreads};
34484a
+      use_ok('threads');
34484a
+
34484a
+      my %h;
34484a
+      unlink <Op1_dbmx*>;
34484a
+
34484a
+      my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
34484a
+      isa_ok($db, $DBM_Class);
34484a
+
34484a
+      for (1 .. 2) {
34484a
+         ok(threads->create(
34484a
+            sub {
34484a
+               $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
34484a
+                        # report it by spurious TAP line
34484a
+               1;
34484a
+            }), "Thread $_ created");
34484a
+      }
34484a
+      for (threads->list) {
34484a
+         is($_->join, 1, "A thread exited successfully");
34484a
+      }
34484a
+
34484a
+      pass("Tied object survived exiting threads");
34484a
+
34484a
+      undef $db;
34484a
+      untie %h;
34484a
+      unlink <Op1_dbmx*>;
34484a
+   }
34484a
+}
34484a
+
34484a
 done_testing();
34484a
 1;
34484a
-- 
34484a
1.9.3
34484a