Attachment 907089 Details for Bug 1107542 – Proposed fix rebased to 5.16.3

[patch] Proposed fix rebased to 5.16.3

perl-5.16.3-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch (text/plain), 5.92 KB, created by Petr Pisar on 2014-06-10 07:55:46 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Petr Pisar

Created: 2014-06-10 07:55:46 UTC

Size: 5.92 KB

patch

obsolete

>From d309a2f4f975429871da44c33b83e651be0dc83e 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 afb361c..e7a3808 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 ;
>@@ -78,6 +79,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak)
> 	    RETVAL = NULL ;
> 	    if ((dbp =  gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) {
> 	        RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ;
>+		RETVAL->owner = aTHX;
> 		RETVAL->dbp = dbp ;
> 	    }
> 	    
>@@ -98,12 +100,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
>@@ -45,6 +45,7 @@ datum	nextkey(datum key);
> #define store_value 3
> 
> typedef struct {
>+	tTHX    owner;
> 	void * 	dbp ;
> 	SV *    filter[4];
> 	int     filtering ;
>@@ -112,6 +113,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:
>@@ -124,13 +126,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 ;
>@@ -43,6 +44,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
> 	    RETVAL = NULL ;
> 	    if ((dbp = sdbm_open(filename,flags,mode))) {
> 	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
>+		RETVAL->owner = aTHX;
> 		RETVAL->dbp = dbp ;
> 	    }
> 	    
>@@ -54,7 +56,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
>@@ -511,5 +511,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
>

Actions: View | Diff

Attachments on bug 1107542: 907089