[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,15 +111,17 @@ gdbm_DESTROY(db)
 	PREINIT:
 	int i = store_value;
     CODE:
-        if (gdbm_file_close(db)) {
-            croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
-                  strerror(errno));
-	}
-	do {
-	    if (db->filter[i])
-		SvREFCNT_dec(db->filter[i]);
-	} while (i-- > 0);
-	safefree(db);
+	if (db && db->owner == aTHX) {
+	    if (gdbm_file_close(db)) {
+	    	croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
+	    	strerror(errno));
+	    }
+	    do {
+		if (db->filter[i])
+		    SvREFCNT_dec(db->filter[i]);
+	    } while (i-- > 0);
+	    safefree(db);
+	}
 
 void
 gdbm_UNTIE(db, count)
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;
dcbd7aef	52	@@ -109,15 +111,17 @@ gdbm_DESTROY(db)
29a1f529 JR	53	PREINIT:
29a1f529 JR	54	int i = store_value;
dcbd7aef JR	55	CODE:
	56	- if (gdbm_file_close(db)) {
	57	- croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
	58	- strerror(errno));
	59	- }
29a1f529 JR	60	- do {
	61	- if (db->filter[i])
	62	- SvREFCNT_dec(db->filter[i]);
	63	- } while (i-- > 0);
	64	- safefree(db);
	65	+ if (db && db->owner == aTHX) {
dcbd7aef JR	66	+ if (gdbm_file_close(db)) {
	67	+ croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
	68	+ strerror(errno));
	69	+ }
29a1f529 JR	70	+ do {
	71	+ if (db->filter[i])
	72	+ SvREFCNT_dec(db->filter[i]);
	73	+ } while (i-- > 0);
	74	+ safefree(db);
	75	+ }
	76
dcbd7aef JR	77	void
dcbd7aef JR	78	gdbm_UNTIE(db, count)
29a1f529 JR	79	diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
	80	index 52e60fc..af223e5 100644
	81	--- a/ext/NDBM_File/NDBM_File.xs
	82	+++ b/ext/NDBM_File/NDBM_File.xs
	83	@@ -33,6 +33,7 @@ END_EXTERN_C
	84	#define store_value 3
	85
	86	typedef struct {
	87	+ tTHX owner;
	88	DBM * dbp ;
	89	SV * filter[4];
	90	int filtering ;
	91	@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
	92	RETVAL = NULL ;
	93	if ((dbp = dbm_open(filename, flags, mode))) {
	94	RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
	95	+ RETVAL->owner = aTHX;
	96	RETVAL->dbp = dbp ;
	97	}
	98
	99	@@ -84,12 +86,14 @@ ndbm_DESTROY(db)
	100	PREINIT:
	101	int i = store_value;
	102	CODE:
	103	- dbm_close(db->dbp);
	104	- do {
	105	- if (db->filter[i])
	106	- SvREFCNT_dec(db->filter[i]);
	107	- } while (i-- > 0);
	108	- safefree(db);
	109	+ if (db && db->owner == aTHX) {
	110	+ dbm_close(db->dbp);
	111	+ do {
	112	+ if (db->filter[i])
	113	+ SvREFCNT_dec(db->filter[i]);
	114	+ } while (i-- > 0);
	115	+ safefree(db);
	116	+ }
	117
	118	#define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
	119	datum_value
	120	diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
	121	index d1ece7f..f7e00a0 100644
	122	--- a/ext/ODBM_File/ODBM_File.xs
	123	+++ b/ext/ODBM_File/ODBM_File.xs
	124	@@ -45,6 +45,7 @@ datum nextkey(datum key);
	125	#define store_value 3
	126
	127	typedef struct {
	128	+ tTHX owner;
	129	void * dbp ;
	130	SV * filter[4];
	131	int filtering ;
	132	@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
	133	}
	134	dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
	135	RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
	136	+ RETVAL->owner = aTHX;
	137	RETVAL->dbp = dbp ;
	138	}
	139	OUTPUT:
	140	@@ -124,13 +126,15 @@ DESTROY(db)
	141	dMY_CXT;
	142	int i = store_value;
143	CODE:
144	- dbmrefcnt--;
145	- dbmclose();
146	- do {
147	- if (db->filter[i])
148	- SvREFCNT_dec(db->filter[i]);
149	- } while (i-- > 0);
150	- safefree(db);
151	+ if (db && db->owner == aTHX) {
152	+ dbmrefcnt--;
153	+ dbmclose();
154	+ do {
155	+ if (db->filter[i])
156	+ SvREFCNT_dec(db->filter[i]);
157	+ } while (i-- > 0);
158	+ safefree(db);
159	+ }
160
161	datum_value
162	odbm_FETCH(db, key)
163	diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
164	index 291e41b..0bdae9a 100644
165	--- a/ext/SDBM_File/SDBM_File.xs
166	+++ b/ext/SDBM_File/SDBM_File.xs
167	@@ -10,6 +10,7 @@
168	#define store_value 3
169
170	typedef struct {
171	+ tTHX owner;
172	DBM * dbp ;
173	SV * filter[4];
174	int filtering ;
175	@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
176	}
177	if (dbp) {
178	RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
179	+ RETVAL->owner = aTHX;
180	RETVAL->dbp = dbp ;
181	}
182
183	@@ -60,7 +62,7 @@ void
184	sdbm_DESTROY(db)
185	SDBM_File db
186	CODE:
187	- if (db) {
188	+ if (db && db->owner == aTHX) {
189	int i = store_value;
190	sdbm_close(db->dbp);
191	do {
192	diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
193	index 5d4098c..a0a4d52 100644
194	--- a/t/lib/dbmt_common.pl
195	+++ b/t/lib/dbmt_common.pl
196	@@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
197	unlink <Op1_dbmx*>;
198	}
199
200	+{
201	+ # Check DBM back-ends do not destroy objects from then-spawned threads.
202	+ # RT#61912.
203	+ SKIP: {
204	+ my $threads_count = 2;
205	+ skip 'Threads are disabled', 3 + 2 * $threads_count
206	+ unless $Config{usethreads};
207	+ use_ok('threads');
208	+
209	+ my %h;
210	+ unlink <Op1_dbmx*>;
211	+
212	+ my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
213	+ isa_ok($db, $DBM_Class);
214	+
215	+ for (1 .. 2) {
216	+ ok(threads->create(
217	+ sub {
218	+ $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
219	+ # report it by spurious TAP line
220	+ 1;
221	+ }), "Thread $_ created");
222	+ }
223	+ for (threads->list) {
224	+ is($_->join, 1, "A thread exited successfully");
225	+ }
226	+
227	+ pass("Tied object survived exiting threads");
228	+
229	+ undef $db;
230	+ untie %h;
231	+ unlink <Op1_dbmx*>;
232	+ }
233	+}
234	+
235	done_testing();
236	1;
237	--
238	1.9.3
239