From 41276999cc0ec4f0d76a111056b7f8ace83d9b69 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Tue, 10 Jun 2014 09:32:38 +0200 Subject: [PATCH] Make *DBM_File desctructors thread-safe --- ...M-ODBM-SDBM-_File-objects-only-from-.patch | 233 ++++++++++++++++++ perl.spec | 6 + 2 files changed, 239 insertions(+) create mode 100644 perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch diff --git a/perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch b/perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch new file mode 100644 index 0000000..74d751a --- /dev/null +++ b/perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch @@ -0,0 +1,233 @@ +From f793042f2bac2ace9a5c0030b47b41c4db561a5b 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 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 ; +@@ -89,6 +90,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode) + if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, + (FATALFUNC) croak_string))) { + RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ; ++ RETVAL->owner = aTHX; + RETVAL->dbp = dbp ; + } + +@@ -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 ; +@@ -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 + diff --git a/perl.spec b/perl.spec index 53d24a3..8be2258 100644 --- a/perl.spec +++ b/perl.spec @@ -130,6 +130,9 @@ Patch24: perl-5.18.2-Pass-fwrapv-to-stricter-GCC-4.9.patch # RT#121591 Patch25: perl-5.18.2-t-op-crypt.t-Perform-SHA-256-algorithm-if-default-on.patch +# Make *DBM_File desctructors thread-safe, bug #1107543, RT#61912 +Patch26: perl-5.18.2-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch + # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048 Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch @@ -1989,6 +1992,7 @@ tarball from perl.org. %patch23 -p1 %patch24 -p1 %patch25 -p1 +%patch26 -p1 %patch200 -p1 %patch201 -p1 @@ -2018,6 +2022,7 @@ perl -x patchlevel.h \ 'Fedora Patch23: Fix t/comp/parser.t not to load system modules (RT#121579)' \ 'Fedora Patch24: Pass -fwrapv to stricter GCC 4.9 (RT#121505)' \ 'Fedora Patch25: Use stronger algorithm needed for FIPS in t/op/crypt.t (RT#121591)' \ + 'Fedora Patch26: Make *DBM_File desctructors thread-safe (RT#61912)' \ 'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \ 'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \ %{nil} @@ -3743,6 +3748,7 @@ sed \ * Fri Aug 08 2014 Petr Pisar - 4:5.18.2-303 - Declare dependencies for cpan tool (bug #1122498) - Use stronger algorithm needed for FIPS in t/op/crypt.t (bug #1128032) +- Make *DBM_File desctructors thread-safe (bug #1107543) * Tue Jul 29 2014 Jitka Plesnikova - 4:5.18.2-302 - Sub-package perl-Term-ANSIColor and remove it (bug #1121924)