|
|
|
|
@ -0,0 +1,180 @@
|
|
|
|
|
From bfb2cb3cddffa144b521bb5dff76af1e065288ad Mon Sep 17 00:00:00 2001
|
|
|
|
|
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
|
|
|
Date: Tue, 10 Jun 2014 14:28:09 +0200
|
|
|
|
|
Subject: [PATCH] Destroy DB_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 DB_File
|
|
|
|
|
database after spawning a thread:
|
|
|
|
|
|
|
|
|
|
use Fcntl;
|
|
|
|
|
use DB_File;
|
|
|
|
|
use threads;
|
|
|
|
|
tie(my %dbtest, 'DB_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>
|
|
|
|
|
---
|
|
|
|
|
DB_File.xs | 50 +++++++++++++++++++++++++++++++-------------------
|
|
|
|
|
MANIFEST | 1 +
|
|
|
|
|
t/db-threads.t | 46 ++++++++++++++++++++++++++++++++++++++++++++++
|
|
|
|
|
3 files changed, 78 insertions(+), 19 deletions(-)
|
|
|
|
|
create mode 100644 t/db-threads.t
|
|
|
|
|
|
|
|
|
|
diff --git a/DB_File.xs b/DB_File.xs
|
|
|
|
|
index f417b22..ed6a904 100755
|
|
|
|
|
--- a/DB_File.xs
|
|
|
|
|
+++ b/DB_File.xs
|
|
|
|
|
@@ -407,6 +407,7 @@ typedef union INFO {
|
|
|
|
|
|
|
|
|
|
typedef struct {
|
|
|
|
|
DBTYPE type ;
|
|
|
|
|
+ tTHX owner ;
|
|
|
|
|
DB * dbp ;
|
|
|
|
|
SV * compare ;
|
|
|
|
|
bool in_compare ;
|
|
|
|
|
@@ -1006,6 +1007,7 @@ SV * sv ;
|
|
|
|
|
name, flags, mode, sv == NULL) ;
|
|
|
|
|
#endif
|
|
|
|
|
Zero(RETVAL, 1, DB_File_type) ;
|
|
|
|
|
+ RETVAL->owner = aTHX;
|
|
|
|
|
|
|
|
|
|
/* Default to HASH */
|
|
|
|
|
RETVAL->filtering = 0 ;
|
|
|
|
|
@@ -1278,6 +1280,7 @@ SV * sv ;
|
|
|
|
|
|
|
|
|
|
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
|
|
|
|
|
Zero(RETVAL, 1, DB_File_type) ;
|
|
|
|
|
+ RETVAL->owner = aTHX;
|
|
|
|
|
|
|
|
|
|
/* Default to HASH */
|
|
|
|
|
RETVAL->filtering = 0 ;
|
|
|
|
|
@@ -1597,27 +1600,36 @@ db_DESTROY(db)
|
|
|
|
|
INIT:
|
|
|
|
|
CurrentDB = db ;
|
|
|
|
|
Trace(("DESTROY %p\n", db));
|
|
|
|
|
- CLEANUP:
|
|
|
|
|
- Trace(("DESTROY %p done\n", db));
|
|
|
|
|
- if (db->hash)
|
|
|
|
|
- SvREFCNT_dec(db->hash) ;
|
|
|
|
|
- if (db->compare)
|
|
|
|
|
- SvREFCNT_dec(db->compare) ;
|
|
|
|
|
- if (db->prefix)
|
|
|
|
|
- SvREFCNT_dec(db->prefix) ;
|
|
|
|
|
- if (db->filter_fetch_key)
|
|
|
|
|
- SvREFCNT_dec(db->filter_fetch_key) ;
|
|
|
|
|
- if (db->filter_store_key)
|
|
|
|
|
- SvREFCNT_dec(db->filter_store_key) ;
|
|
|
|
|
- if (db->filter_fetch_value)
|
|
|
|
|
- SvREFCNT_dec(db->filter_fetch_value) ;
|
|
|
|
|
- if (db->filter_store_value)
|
|
|
|
|
- SvREFCNT_dec(db->filter_store_value) ;
|
|
|
|
|
- safefree(db) ;
|
|
|
|
|
+ CODE:
|
|
|
|
|
+ RETVAL = 0;
|
|
|
|
|
+ if (db && db->owner == aTHX) {
|
|
|
|
|
+ RETVAL = db_DESTROY(db);
|
|
|
|
|
#ifdef DB_VERSION_MAJOR
|
|
|
|
|
- if (RETVAL > 0)
|
|
|
|
|
- RETVAL = -1 ;
|
|
|
|
|
+ if (RETVAL > 0)
|
|
|
|
|
+ RETVAL = -1 ;
|
|
|
|
|
#endif
|
|
|
|
|
+ }
|
|
|
|
|
+ OUTPUT:
|
|
|
|
|
+ RETVAL
|
|
|
|
|
+ CLEANUP:
|
|
|
|
|
+ Trace(("DESTROY %p done\n", db));
|
|
|
|
|
+ if (db && db->owner == aTHX) {
|
|
|
|
|
+ if (db->hash)
|
|
|
|
|
+ SvREFCNT_dec(db->hash) ;
|
|
|
|
|
+ if (db->compare)
|
|
|
|
|
+ SvREFCNT_dec(db->compare) ;
|
|
|
|
|
+ if (db->prefix)
|
|
|
|
|
+ SvREFCNT_dec(db->prefix) ;
|
|
|
|
|
+ if (db->filter_fetch_key)
|
|
|
|
|
+ SvREFCNT_dec(db->filter_fetch_key) ;
|
|
|
|
|
+ if (db->filter_store_key)
|
|
|
|
|
+ SvREFCNT_dec(db->filter_store_key) ;
|
|
|
|
|
+ if (db->filter_fetch_value)
|
|
|
|
|
+ SvREFCNT_dec(db->filter_fetch_value) ;
|
|
|
|
|
+ if (db->filter_store_value)
|
|
|
|
|
+ SvREFCNT_dec(db->filter_store_value) ;
|
|
|
|
|
+ safefree(db) ;
|
|
|
|
|
+ }
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
int
|
|
|
|
|
diff --git a/MANIFEST b/MANIFEST
|
|
|
|
|
index e460e81..47f43f7 100644
|
|
|
|
|
--- a/MANIFEST
|
|
|
|
|
+++ b/MANIFEST
|
|
|
|
|
@@ -27,6 +27,7 @@ t/db-btree.t
|
|
|
|
|
t/db-hash.t
|
|
|
|
|
t/db-recno.t
|
|
|
|
|
t/pod.t
|
|
|
|
|
+t/db-threads.t
|
|
|
|
|
typemap
|
|
|
|
|
version.c
|
|
|
|
|
META.yml Module meta-data (added by MakeMaker)
|
|
|
|
|
diff --git a/t/db-threads.t b/t/db-threads.t
|
|
|
|
|
new file mode 100644
|
|
|
|
|
index 0000000..b9f69b6
|
|
|
|
|
--- /dev/null
|
|
|
|
|
+++ b/t/db-threads.t
|
|
|
|
|
@@ -0,0 +1,46 @@
|
|
|
|
|
+#!./perl
|
|
|
|
|
+
|
|
|
|
|
+use warnings;
|
|
|
|
|
+use strict;
|
|
|
|
|
+use Config;
|
|
|
|
|
+use Fcntl;
|
|
|
|
|
+use Test::More;
|
|
|
|
|
+use DB_File;
|
|
|
|
|
+
|
|
|
|
|
+if (-d "lib" && -f "TEST") {
|
|
|
|
|
+ if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
|
|
|
|
|
+ plan skip_all => 'DB_File was not built';
|
|
|
|
|
+ }
|
|
|
|
|
+}
|
|
|
|
|
+plan skip_all => 'Threads are disabled'
|
|
|
|
|
+ unless $Config{usethreads};
|
|
|
|
|
+
|
|
|
|
|
+plan tests => 7;
|
|
|
|
|
+
|
|
|
|
|
+# Check DBM back-ends do not destroy objects from then-spawned threads.
|
|
|
|
|
+# RT#61912.
|
|
|
|
|
+use_ok('threads');
|
|
|
|
|
+
|
|
|
|
|
+my %h;
|
|
|
|
|
+unlink <threads*>;
|
|
|
|
|
+
|
|
|
|
|
+my $db = tie %h, 'DB_File', 'threads', O_RDWR|O_CREAT, 0640;
|
|
|
|
|
+isa_ok($db, 'DB_File');
|
|
|
|
|
+
|
|
|
|
|
+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 <threads*>;
|
|
|
|
|
--
|
|
|
|
|
2.5.5
|
|
|
|
|
|
