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
7 Content-Type: text/plain; charset=UTF-8
8 Content-Transfer-Encoding: 8bit
10 This patch fixes a crash when destroing a hash tied to a *_File
11 database after spawning a thread:
16 tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);
17 threads->new(sub {})->join;
19 This crashed or paniced depending on how perl was configured.
23 Signed-off-by: Petr Písař <ppisar@redhat.com>
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(-)
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
44 @@ -99,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
47 RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
48 + RETVAL->owner = aTHX;
52 @@ -109,15 +111,17 @@ gdbm_DESTROY(db)
56 - if (gdbm_file_close(db)) {
57 - croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
62 - SvREFCNT_dec(db->filter[i]);
65 + if (db && db->owner == aTHX) {
66 + if (gdbm_file_close(db)) {
67 + croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
72 + SvREFCNT_dec(db->filter[i]);
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
91 @@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
93 if ((dbp = dbm_open(filename, flags, mode))) {
94 RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
95 + RETVAL->owner = aTHX;
99 @@ -84,12 +86,14 @@ ndbm_DESTROY(db)
103 - dbm_close(db->dbp);
106 - SvREFCNT_dec(db->filter[i]);
109 + if (db && db->owner == aTHX) {
110 + dbm_close(db->dbp);
113 + SvREFCNT_dec(db->filter[i]);
118 #define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key)
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
132 @@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
134 dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
135 RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
136 + RETVAL->owner = aTHX;
140 @@ -124,13 +126,15 @@ DESTROY(db)
148 - SvREFCNT_dec(db->filter[i]);
151 + if (db && db->owner == aTHX) {
156 + SvREFCNT_dec(db->filter[i]);
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
168 #define store_value 3
175 @@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
178 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
179 + RETVAL->owner = aTHX;
183 @@ -60,7 +62,7 @@ void
188 + if (db && db->owner == aTHX) {
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;
201 + # Check DBM back-ends do not destroy objects from then-spawned threads.
204 + my $threads_count = 2;
205 + skip 'Threads are disabled', 3 + 2 * $threads_count
206 + unless $Config{usethreads};
210 + unlink <Op1_dbmx*>;
212 + my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
213 + isa_ok($db, $DBM_Class);
216 + ok(threads->create(
218 + $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
219 + # report it by spurious TAP line
221 + }), "Thread $_ created");
223 + for (threads->list) {
224 + is($_->join, 1, "A thread exited successfully");
227 + pass("Tied object survived exiting threads");
231 + unlink <Op1_dbmx*>;