[packages/perl.git] / perl-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch

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 ;
@@ -99,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;
@@ -109,12 +111,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 ;
@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 	    }
 	    if (dbp) {
 	        RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
+		RETVAL->owner = aTHX;
 		RETVAL->dbp = dbp ;
 	    }
 	    
@@ -60,7 +62,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
Commit	Line	Data
29a1f529 JR	1	From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
	2	From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
	3	Date: Fri, 6 Jun 2014 14:31:59 +0200
	4	Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original
	5	thread context
	6	MIME-Version: 1.0
	7	Content-Type: text/plain; charset=UTF-8
	8	Content-Transfer-Encoding: 8bit
	9
	10	This patch fixes a crash when destroing a hash tied to a *_File
	11	database after spawning a thread:
	12
	13	use Fcntl;
	14	use SDBM_File;
	15	use threads;
	16	tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR\|O_CREAT, 0666);
	17	threads->new(sub {})->join;
	18
	19	This crashed or paniced depending on how perl was configured.
	20
	21	Closes RT#61912.
	22
	23	Signed-off-by: Petr Písař <ppisar@redhat.com>
	24	---
	25	ext/GDBM_File/GDBM_File.xs \| 16 ++++++++++------
	26	ext/NDBM_File/NDBM_File.xs \| 16 ++++++++++------
	27	ext/ODBM_File/ODBM_File.xs \| 18 +++++++++++-------
	28	ext/SDBM_File/SDBM_File.xs \| 4 +++-
	29	t/lib/dbmt_common.pl \| 35 +++++++++++++++++++++++++++++++++++
	30	5 files changed, 69 insertions(+), 20 deletions(-)
	31
	32	diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
	33	index 33e08e2..7160f54 100644
	34	--- a/ext/GDBM_File/GDBM_File.xs
	35	+++ b/ext/GDBM_File/GDBM_File.xs
	36	@@ -13,6 +13,7 @@
	37	#define store_value 3
	38
	39	typedef struct {
	40	+ tTHX owner;
	41	GDBM_FILE dbp ;
	42	SV * filter[4];
	43	int filtering ;
f5b778c6 AM	44	@@ -99,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
	45	}
	46	if (dbp) {
	47	RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
	48	+ RETVAL->owner = aTHX;
	49	RETVAL->dbp = dbp;
	50	} else {
	51	RETVAL = NULL;
29a1f529 JR	52	@@ -109,12 +111,14 @@ gdbm_DESTROY(db)
	53	PREINIT:
	54	int i = store_value;
	55	CODE:
	56	- gdbm_close(db);
	57	- do {
	58	- if (db->filter[i])
	59	- SvREFCNT_dec(db->filter[i]);
	60	- } while (i-- > 0);
	61	- safefree(db);
	62	+ if (db && db->owner == aTHX) {
	63	+ gdbm_close(db);
	64	+ do {
	65	+ if (db->filter[i])
	66	+ SvREFCNT_dec(db->filter[i]);
	67	+ } while (i-- > 0);
	68	+ safefree(db);
	69	+ }
	70
	71	#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
	72	datum_value
	73	diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
	74	index 52e60fc..af223e5 100644
	75	--- a/ext/NDBM_File/NDBM_File.xs
	76	+++ b/ext/NDBM_File/NDBM_File.xs
	77	@@ -33,6 +33,7 @@ END_EXTERN_C
	78	#define store_value 3
	79
	80	typedef struct {
	81	+ tTHX owner;
	82	DBM * dbp ;
	83	SV * filter[4];
	84	int filtering ;
	85	@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
	86	RETVAL = NULL ;
	87	if ((dbp = dbm_open(filename, flags, mode))) {
	88	RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
	89	+ RETVAL->owner = aTHX;
	90	RETVAL->dbp = dbp ;
	91	}
	92
	93	@@ -84,12 +86,14 @@ ndbm_DESTROY(db)
	94	PREINIT:
	95	int i = store_value;
	96	CODE:
	97	- dbm_close(db->dbp);
	98	- do {
	99	- if (db->filter[i])
	100	- SvREFCNT_dec(db->filter[i]);
	101	- } while (i-- > 0);
	102	- safefree(db);
	103	+ if (db && db->owner == aTHX) {
	104	+ dbm_close(db->dbp);
	105	+ do {
	106	+ if (db->filter[i])
	107	+ SvREFCNT_dec(db->filter[i]);
	108	+ } while (i-- > 0);
	109	+ safefree(db);
	110	+ }
	111
	112	#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
	113	datum_value
	114	diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
	115	index d1ece7f..f7e00a0 100644
116	--- a/ext/ODBM_File/ODBM_File.xs
117	+++ b/ext/ODBM_File/ODBM_File.xs
118	@@ -45,6 +45,7 @@ datum nextkey(datum key);
119	#define store_value 3
120
121	typedef struct {
122	+ tTHX owner;
123	void * dbp ;
124	SV * filter[4];
125	int filtering ;
126	@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
127	}
128	dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
129	RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
130	+ RETVAL->owner = aTHX;
131	RETVAL->dbp = dbp ;
132	}
133	OUTPUT:
134	@@ -124,13 +126,15 @@ DESTROY(db)
135	dMY_CXT;
136	int i = store_value;
137	CODE:
138	- dbmrefcnt--;
139	- dbmclose();
140	- do {
141	- if (db->filter[i])
142	- SvREFCNT_dec(db->filter[i]);
143	- } while (i-- > 0);
144	- safefree(db);
145	+ if (db && db->owner == aTHX) {
146	+ dbmrefcnt--;
147	+ dbmclose();
148	+ do {
149	+ if (db->filter[i])
150	+ SvREFCNT_dec(db->filter[i]);
151	+ } while (i-- > 0);
152	+ safefree(db);
153	+ }
154
155	datum_value
156	odbm_FETCH(db, key)
157	diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
158	index 291e41b..0bdae9a 100644
159	--- a/ext/SDBM_File/SDBM_File.xs
160	+++ b/ext/SDBM_File/SDBM_File.xs
161	@@ -10,6 +10,7 @@
162	#define store_value 3
163
164	typedef struct {
165	+ tTHX owner;
166	DBM * dbp ;
167	SV * filter[4];
168	int filtering ;
169	@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
170	}
171	if (dbp) {
172	RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
173	+ RETVAL->owner = aTHX;
174	RETVAL->dbp = dbp ;
175	}
176
177	@@ -60,7 +62,7 @@ void
178	sdbm_DESTROY(db)
179	SDBM_File db
180	CODE:
181	- if (db) {
182	+ if (db && db->owner == aTHX) {
183	int i = store_value;
184	sdbm_close(db->dbp);
185	do {
186	diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
187	index 5d4098c..a0a4d52 100644
188	--- a/t/lib/dbmt_common.pl
189	+++ b/t/lib/dbmt_common.pl
190	@@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
191	unlink <Op1_dbmx*>;
192	}
193
194	+{
195	+ # Check DBM back-ends do not destroy objects from then-spawned threads.
196	+ # RT#61912.
197	+ SKIP: {
198	+ my $threads_count = 2;
199	+ skip 'Threads are disabled', 3 + 2 * $threads_count
200	+ unless $Config{usethreads};
201	+ use_ok('threads');
202	+
203	+ my %h;
204	+ unlink <Op1_dbmx*>;
205	+
206	+ my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
207	+ isa_ok($db, $DBM_Class);
208	+
209	+ for (1 .. 2) {
210	+ ok(threads->create(
211	+ sub {
212	+ $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
213	+ # report it by spurious TAP line
214	+ 1;
215	+ }), "Thread $_ created");
216	+ }
217	+ for (threads->list) {
218	+ is($_->join, 1, "A thread exited successfully");
219	+ }
220	+
221	+ pass("Tied object survived exiting threads");
222	+
223	+ undef $db;
224	+ untie %h;
225	+ unlink <Op1_dbmx*>;
226	+ }
227	+}
228	+
229	done_testing();
230	1;
231	--
232	1.9.3
233