From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001

From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>

Date: Fri, 6 Jun 2014 14:31:59 +0200

Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_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 *_File

database after spawning a thread:

use Fcntl;

use SDBM_File;

use threads;

tie(my %dbtest, 'SDBM_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>

---

 ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------

 ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------

 ext/ODBM_File/ODBM_File.xs | 18 +++++++++++-------

 ext/SDBM_File/SDBM_File.xs |  4 +++-

 t/lib/dbmt_common.pl       | 35 +++++++++++++++++++++++++++++++++++

 5 files changed, 69 insertions(+), 20 deletions(-)

diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs

index 33e08e2..7160f54 100644

--- a/ext/GDBM_File/GDBM_File.xs

+++ b/ext/GDBM_File/GDBM_File.xs

@@ -13,6 +13,7 @@

 #define store_value 3

 typedef struct {

+	tTHX    owner;

 	GDBM_FILE 	dbp ;

 	SV *    filter[4];

 	int     filtering ;

@@ -98,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m

 	}

 	if (dbp) {

 	    RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));

+	    RETVAL->owner = aTHX;

 	    RETVAL->dbp = dbp;

 	} else {

 	    RETVAL = NULL;

@@ -118,12 +120,14 @@ gdbm_DESTROY(db)

 	PREINIT:

 	int i = store_value;

 	CODE:

-	gdbm_close(db);

-	do {

-	    if (db->filter[i])

-		SvREFCNT_dec(db->filter[i]);

-	} while (i-- > 0);

-	safefree(db);

+	if (db && db->owner == aTHX) {

+	    gdbm_close(db);

+	    do {

+		if (db->filter[i])

+		    SvREFCNT_dec(db->filter[i]);

+	    } while (i-- > 0);

+	    safefree(db);

+	}

 #define gdbm_FETCH(db,key)			gdbm_fetch(db->dbp,key)

 datum_value

diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs

index 52e60fc..af223e5 100644

--- a/ext/NDBM_File/NDBM_File.xs

+++ b/ext/NDBM_File/NDBM_File.xs

@@ -33,6 +33,7 @@ END_EXTERN_C

 #define store_value 3

 typedef struct {

+	tTHX    owner;

 	DBM * 	dbp ;

 	SV *    filter[4];

 	int     filtering ;

@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)

 	    RETVAL = NULL ;

 	    if ((dbp =  dbm_open(filename, flags, mode))) {

 	        RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));

+		RETVAL->owner = aTHX;

 		RETVAL->dbp = dbp ;

 	    }

@@ -84,12 +86,14 @@ ndbm_DESTROY(db)

 	PREINIT:

 	int i = store_value;

 	CODE:

-	dbm_close(db->dbp);

-	do {

-	    if (db->filter[i])

-		SvREFCNT_dec(db->filter[i]);

-	} while (i-- > 0);

-	safefree(db);

+	if (db && db->owner == aTHX) {

+	    dbm_close(db->dbp);

+	    do {

+		if (db->filter[i])

+		    SvREFCNT_dec(db->filter[i]);

+	    } while (i-- > 0);

+	    safefree(db);

+	}

 #define ndbm_FETCH(db,key)			dbm_fetch(db->dbp,key)

 datum_value

diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs

index d1ece7f..f7e00a0 100644

--- a/ext/ODBM_File/ODBM_File.xs

+++ b/ext/ODBM_File/ODBM_File.xs

@@ -49,6 +49,7 @@ datum	nextkey(datum key);

 #define store_value 3

 typedef struct {

+	tTHX    owner;

 	void * 	dbp ;

 	SV *    filter[4];

 	int     filtering ;

@@ -137,6 +138,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)

 	    }

 	    dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);

 	    RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));

+	    RETVAL->owner = aTHX;

 	    RETVAL->dbp = dbp ;

 	}

 	OUTPUT:

@@ -149,13 +151,15 @@ DESTROY(db)

 	dMY_CXT;

 	int i = store_value;

 	CODE:

-	dbmrefcnt--;

-	dbmclose();

-	do {

-	    if (db->filter[i])

-		SvREFCNT_dec(db->filter[i]);

-	} while (i-- > 0);

-	safefree(db);

+	if (db && db->owner == aTHX) {

+	    dbmrefcnt--;

+	    dbmclose();

+	    do {

+		if (db->filter[i])

+		    SvREFCNT_dec(db->filter[i]);

+	    } while (i-- > 0);

+	    safefree(db);

+	}

 datum_value

 odbm_FETCH(db, key)

diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs

index 291e41b..0bdae9a 100644

--- a/ext/SDBM_File/SDBM_File.xs

+++ b/ext/SDBM_File/SDBM_File.xs

@@ -10,6 +10,7 @@

 #define store_value 3

 typedef struct {

+	tTHX    owner;

 	DBM * 	dbp ;

 	SV *    filter[4];

 	int     filtering ;

@@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)

 	    }

 	    if (dbp) {

 	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));

+		RETVAL->owner = aTHX;

 		RETVAL->dbp = dbp ;

 	    }

@@ -62,7 +64,7 @@ void

 sdbm_DESTROY(db)

 	SDBM_File	db

 	CODE:

-	if (db) {

+	if (db && db->owner == aTHX) {

 	    int i = store_value;

 	    sdbm_close(db->dbp);

 	    do {

diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl

index 5d4098c..a0a4d52 100644

--- a/t/lib/dbmt_common.pl

+++ b/t/lib/dbmt_common.pl

@@ -510,5 +510,40 @@ unlink <Op_dbmx*>, $Dfile;

    unlink <Op1_dbmx*>;

 }

+{

+   # Check DBM back-ends do not destroy objects from then-spawned threads.

+   # RT#61912.

+   SKIP: {

+      my $threads_count = 2;

+      skip 'Threads are disabled', 3 + 2 * $threads_count

+        unless $Config{usethreads};

+      use_ok('threads');

+

+      my %h;

+      unlink <Op1_dbmx*>;

+

+      my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;

+      isa_ok($db, $DBM_Class);

+

+      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 <Op1_dbmx*>;

+   }

+}

+

 done_testing();

 1;

-- 

1.9.3