From d309a2f4f975429871da44c33b83e651be0dc83e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= 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ř --- 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 , $Dfile; unlink ; } +{ + # 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 ; + + 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 ; + } +} + done_testing(); 1; -- 1.9.3