Projects
openEuler:22.03:LTS:LoongArch
perl
_service:tar_scm_kernel_repo:perl-5.34.0-Destro...
Sign Up
Log In
Username
Password
Overview
Repositories
Revisions
Requests
Users
Attributes
Meta
File _service:tar_scm_kernel_repo:perl-5.34.0-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch of Package perl
From 8067179e65a28d91f00df7d36778229a07514471 Mon Sep 17 00:00:00 2001 From: Jitka Plesnikova <jplesnik@redhat.com> Date: Thu, 29 Apr 2021 12:21:18 +0200 Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original 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. Updated original ppisar's patch for perl 5.18.2 --- ext/GDBM_File/GDBM_File.xs | 20 ++++++++++++-------- 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, 71 insertions(+), 22 deletions(-) diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index cd0bb6f..0c395ac 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 ; @@ -276,6 +277,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode) } if (dbp) { RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)); + RETVAL->owner = aTHX; RETVAL->dbp = dbp; } else { RETVAL = NULL; @@ -289,15 +291,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)); + 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); } - 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 eed671a..651fe0f 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 38e6dbf..4b15a42 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -49,6 +49,7 @@ datum nextkey(datum key); #define store_value 3 typedef struct { + tTHX owner; void * dbp ; SV * filter[4]; int filtering ; @@ -137,6 +138,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: @@ -149,13 +151,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 0df2855..0e2bd58 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 ; @@ -51,6 +52,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode, pagname=NULL) } if (dbp) { RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); + RETVAL->owner = aTHX; RETVAL->dbp = dbp ; } @@ -62,7 +64,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 60c66ae..a7f81fe 100644 --- a/t/lib/dbmt_common.pl +++ b/t/lib/dbmt_common.pl @@ -510,5 +510,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; -- 2.26.3
Locations
Projects
Search
Status Monitor
Help
Open Build Service
OBS Manuals
API Documentation
OBS Portal
Reporting a Bug
Contact
Mailing List
Forums
Chat (IRC)
Twitter
Open Build Service (OBS)
is an
openSUSE project
.