commit 29a1f5290595d6a5f50c4eb67aaf50e7d9f599a8
Author: Jan Rękorajski <[email protected]>
Date: Tue Sep 16 21:32:54 2014 +0200
- fix crash when destroing *_File database object
- rel 2
...Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch | 233 +++++++++++++++++++++
perl.spec | 6 +-
2 files changed, 236 insertions(+), 3 deletions(-)
---
diff --git a/perl.spec b/perl.spec
index 288f857..027555c 100644
--- a/perl.spec
+++ b/perl.spec
@@ -45,7 +45,7 @@
%define perl_mod2version() %([ -f %{SOURCE4} ] && awk
-vp=%1 '$1 == p { m=$2; printf("perl-%s = %s\\n", p, $4)}END{if (!m) printf("#
Error looking up [%s]\\n", p) }' %{SOURCE4} || echo ERROR)
%define ver 5.20.0
-%define rel 1
+%define rel 2
Summary: Practical Extraction and Report Language (Perl)
Summary(cs.UTF-8): Programovací jazyk Perl
Summary(da.UTF-8): Programmeringssproget Perl
@@ -86,7 +86,7 @@ Patch4: %{name}-test-noproc.patch
Patch5: %{name}_585-microperl_uconfig.patch
Patch6: %{name}-write-permissions.patch
Patch7: %{name}-t-syslog.patch
-
+Patch8: %{name}-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch
Patch9: %{name}-switch.patch
Patch10: %{name}-invalid-void-use.patch
URL: http://dev.perl.org/perl5/
@@ -711,7 +711,7 @@ z biblioteki GNU gdbm.
%patch5 -p1
%patch6 -p1
%patch7 -p1
-
+%patch8 -p1
%patch9 -p1
%patch10 -p1
diff --git a/perl-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch
b/perl-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch
new file mode 100644
index 0000000..9b503c6
--- /dev/null
+++ b/perl-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch
@@ -0,0 +1,233 @@
+From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
+From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <[email protected]>
+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ř <[email protected]>
+---
+ 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 ;
+@@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
+ }
+ if (dbp) {
+ RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
++ RETVAL->owner = aTHX;
+ RETVAL->dbp = dbp ;
+ }
+
+@@ -60,7 +62,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 <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;
+--
+1.9.3
+
================================================================
---- gitweb:
http://git.pld-linux.org/gitweb.cgi/packages/perl.git/commitdiff/29a1f5290595d6a5f50c4eb67aaf50e7d9f599a8
_______________________________________________
pld-cvs-commit mailing list
[email protected]
http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit
