Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

SDBM_File attempts to double-free DB pointer when threads are cleaned up #9611

Open
p5pRT opened this issue Jan 2, 2009 · 10 comments
Open

SDBM_File attempts to double-free DB pointer when threads are cleaned up #9611

p5pRT opened this issue Jan 2, 2009 · 10 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Jan 2, 2009

Migrated from rt.perl.org#61912 (status was 'open')

Searchable as RT61912$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jan 2, 2009

From chrisb@debian.org

Created by chrisb@debian.org

This is a bug report for perl from chrisb@​debian.org,
generated with the help of perlbug 1.36 running under perl 5.10.0.

-----------------------------------------------------------------
This bug report is based on a report submitted to the Debian Bug Tracking
System by Eduard Bloch - http​://bugs.debian.org/cgi-bin/bugreport.cgi?bug=358518

The SDBM_File module doesn't seem to be thread-safe. If a file is tied before a
thread is created, the pointer to the DBM object is shared between threads.
Each thread then attempts to free it, causing a crash.

The following script reproduces the problem for me​:

==================================
#!/usr/bin/perl

use strict;
use Fcntl;
use SDBM_File;
use threads;
use threads​::shared;

my %dbtest;
tie(%dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);

for (1 .. 2)
{
  my $thr = threads->new(\&testThread, $_);
  $thr->detach();
}
sleep 4;

sub testThread
{
  my $n = shift;
  print "thread #" . $n . " started\n";
}

Running it using debugperl/gdb​:

==================================
Starting program​: /usr/bin/debugperl sdbm_test.pl
[Thread debugging using libthread_db enabled]
[New Thread 0xb7d868c0 (LWP 17290)]
[New Thread 0xb7c2eb90 (LWP 17295)]
[New Thread 0xb742db90 (LWP 17308)]
[Thread 0xb742db90 (LWP 17308) exited]
[New Thread 0xb742db90 (LWP 17313)]
*** glibc detected *** /usr/bin/debugperl​: double free or corruption (!prev)​: 0x08a5b4e8 ***
======= Backtrace​: =========
/lib/i686/cmov/libc.so.6[0xb7e276b4]
/lib/i686/cmov/libc.so.6(cfree+0x96)[0xb7e298b6]
/usr/lib/perl/5.10/auto/SDBM_File/SDBM_File.so(sdbm_close+0x3b)[0xb7c3f79b]
/usr/lib/perl/5.10/auto/SDBM_File/SDBM_File.so(XS_SDBM_File_DESTROY+0xcf)[0xb7c3e5df]
/usr/bin/debugperl(Perl_pp_entersub+0xae1)[0x80e0bd1]
/usr/bin/debugperl(Perl_call_sv+0x720)[0x80d5c50]
/usr/bin/debugperl(Perl_sv_clear+0x1d4)[0x81065d4]
/usr/bin/debugperl(Perl_sv_free2+0x69)[0x8107289]
/usr/bin/debugperl[0x80eefc1]
/usr/bin/debugperl(Perl_sv_clean_objs+0x29)[0x80ef039]
/usr/bin/debugperl(perl_destruct+0x3f0)[0x80dadf0]
/usr/lib/perl/5.10/auto/threads/threads.so[0xb7f651ab]
/usr/lib/perl/5.10/auto/threads/threads.so[0xb7f653ab]
/usr/lib/perl/5.10/auto/threads/threads.so[0xb7f68c0b]
/lib/i686/cmov/libpthread.so.0[0xb7f1a4c0]
/lib/i686/cmov/libc.so.6(clone+0x5e)[0xb7e9961e]
======= Memory map​: ========
08048000-0828a000 r-xp 00000000 fe​:01 527887 /usr/bin/debugperl
0828a000-0828c000 rw-p 00242000 fe​:01 527887 /usr/bin/debugperl
086d8000-08f33000 rw-p 086d8000 00​:00 0 [heap]
b6b00000-b6b21000 rw-p b6b00000 00​:00 0
b6b21000-b6c00000 ---p b6b21000 00​:00 0
b6c0d000-b6c19000 r-xp 00000000 fe​:01 762863 /lib/libgcc_s.so.1
b6c19000-b6c1a000 rw-p 0000b000 fe​:01 762863 /lib/libgcc_s.so.1
b6c2d000-b6c2e000 ---p b6c2d000 00​:00 0
b6c2e000-b742e000 rw-p b6c2e000 00​:00 0
b742e000-b742f000 ---p b742e000 00​:00 0
b742f000-b7c2f000 rw-p b742f000 00​:00 0
b7c2f000-b7c33000 r-xp 00000000 fe​:01 557739 /usr/lib/perl/5.10.0/auto/Socket/Socket.so
b7c33000-b7c34000 rw-p 00004000 fe​:01 557739 /usr/lib/perl/5.10.0/auto/Socket/Socket.so
b7c34000-b7c38000 r-xp 00000000 fe​:01 557729 /usr/lib/perl/5.10.0/auto/IO/IO.so
b7c38000-b7c39000 rw-p 00003000 fe​:01 557729 /usr/lib/perl/5.10.0/auto/IO/IO.so
b7c39000-b7c41000 r-xp 00000000 fe​:01 17403 /usr/lib/perl/5.10.0/auto/SDBM_File/SDBM_File.so
b7c41000-b7c42000 rw-p 00007000 fe​:01 17403 /usr/lib/perl/5.10.0/auto/SDBM_File/SDBM_File.so
b7c42000-b7c4b000 r-xp 00000000 fe​:01 607618 /usr/lib/perl/5.10.0/auto/threads/shared/shared.so
b7c4b000-b7c4c000 rw-p 00009000 fe​:01 607618 /usr/lib/perl/5.10.0/auto/threads/shared/shared.so
b7c4c000-b7d86000 r--p 00000000 fe​:01 551711 /usr/lib/locale/locale-archive
b7d86000-b7d87000 rw-p b7d86000 00​:00 0
b7d87000-b7d90000 r-xp 00000000 fe​:01 762957 /lib/i686/cmov/libcrypt-2.7.so
b7d90000-b7d92000 rw-p 00008000 fe​:01 762957 /lib/i686/cmov/libcrypt-2.7.so
b7d92000-b7db9000 rw-p b7d92000 00​:00 0
b7db9000-b7f0e000 r-xp 00000000 fe​:01 762955 /lib/i686/cmov/libc-2.7.so
b7f0e000-b7f0f000 r--p 00155000 fe​:01 762955 /lib/i686/cmov/libc-2.7.so
b7f0f000-b7f11000 rw-p 00156000 fe​:01 762955 /lib/i686/cmov/libc-2.7.so
b7f11000-b7f14000 rw-p b7f11000 00​:00 0
b7f14000-b7f29000 r-xp 00000000 fe​:01 763043 /lib/i686/cmov/libpthread-2.7.so
b7f29000-b7f2b000 rw-p 00014000 fe​:01 763043 /lib/i686/cmov/libpthread-2.7.so
b7f2b000-b7f2e000 rw-p b7f2b000 00​:00 0
b7f2e000-b7f52000 r-xp 00000000 fe​:01 763006 /lib/i686/cmov/libm-2.7.so
b7f52000-b7f54000 rw-p 00023000 fe​:01 763006 /lib/i686/cmov/libm-2.7.so
b7f54000-b7f56000 r-xp 00000000 fe​:01 762998 /lib/i686/cmov/libdl-2.7.so
b7f56000-b7f58000 rw-p 00001000 fe​:01 762998 /lib/i686/cmov/libdl-2.7.so
b7f58000-b7f5b000 r-xp 00000000 fe​:01 557730 /usr/lib/perl/5.10.0/auto/Cwd/Cwd.so
b7f5b000-b7f5c000 rw-p 00002000 fe​:01 557730 /usr/lib/perl/5.10.0/auto/Cwd/Cwd.so
b7f5c000-b7f5f000 r-xp 00000000 fe​:01 557734 /usr/lib/perl/5.10.0/auto/Fcntl/Fcntl.so
b7f5f000-b7f60000 rw-p 00002000 fe​:01 557734 /usr/lib/perl/5.10.0/auto/Fcntl/Fcntl.so
b7f60000-b7f6a000 r-xp 00000000 fe​:01 607619 /usr/lib/perl/5.10.0/auto/threads/threads.so
b7f6a000-b7f6b000 rw-p 00009000 fe​:01 607619 /usr/lib/perl/5.10.0/auto/threads/threads.so
b7f6b000-b7f6d000 rw-p b7f6b000 00​:00 0
b7f6d000-b7f6e000 r-xp b7f6d000 00​:00 0 [vdso]
b7f6e000-b7f88000 r-xp 00000000 fe​:01 763488 /lib/ld-2.7.so
b7f88000-b7f8a000 rw-p 0001a000 fe​:01 763488 /lib/ld-2.7.so
bf974000-bf989000 rw-p bffeb000 00​:00 0 [stack]

Program received signal SIGABRT, Aborted.
[Switching to Thread 0xb742db90 (LWP 17313)]
0xb7f6d424 in __kernel_vsyscall ()
(gdb) bt
#0 0xb7f6d424 in __kernel_vsyscall ()
#1 0xb7de4640 in raise () from /lib/i686/cmov/libc.so.6
#2 0xb7de6018 in abort () from /lib/i686/cmov/libc.so.6
#3 0xb7e213dd in ?? () from /lib/i686/cmov/libc.so.6
#4 0x00000006 in ?? ()
#5 0xb742c914 in ?? ()
#6 0x00000400 in ?? ()
#7 0xb7ef75c8 in ?? () from /lib/i686/cmov/libc.so.6
#8 0x00000017 in ?? ()
#9 0xbf9887bd in ?? ()
#10 0x00000012 in ?? ()
#11 0xb7ef75e1 in ?? () from /lib/i686/cmov/libc.so.6
#12 0x00000002 in ?? ()
#13 0xb7ef76c0 in ?? () from /lib/i686/cmov/libc.so.6
#14 0x00000021 in ?? ()
#15 0xb7ef75e5 in ?? () from /lib/i686/cmov/libc.so.6
#16 0x00000004 in ?? ()
#17 0xb742ce43 in ?? ()
#18 0x00000008 in ?? ()
#19 0xb7ef75eb in ?? () from /lib/i686/cmov/libc.so.6
#20 0x00000005 in ?? ()
#21 0x08cc6dd8 in ?? ()
#22 0x00000000 in ?? ()

If I set a breakpoint in sdbm_close, I can see that it is called twice from
different threads with the same DB pointer.

Perl Info

Flags:
    category=library
    severity=medium

Site configuration information for perl 5.10.0:

Configured by Debian Project at Thu Nov 20 23:16:48 UTC 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.6.26-1-686, archname=i486-linux-gnu-thread-multi
    uname='linux rebekka 2.6.26-1-686 #1 smp thu oct 9 15:18:09 utc 2008 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.10 -Darchlib=/usr/lib/perl/5.10 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.10.0 -Dsitearch=/usr/local/lib/perl/5.10.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.10.0 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.3.2', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib /usr/lib64
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.7.so, so=so, useshrplib=true, libperl=libperl.so.5.10.0
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib'

Locally applied patches:
    


@INC for perl 5.10.0:
    /etc/perl
    /usr/local/lib/perl/5.10.0
    /usr/local/share/perl/5.10.0
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.10
    /usr/share/perl/5.10
    /usr/local/lib/site_perl
    .


Environment for perl 5.10.0:
    HOME=/home/chrisb
    LANG=en_GB.UTF-8
    LANGUAGE (unset)
    LC_ALL=en_GB.UTF-8
    LC_CTYPE=en_GB.UTF-8
    LC_MESSAGES=en_GB.UTF-8
    LC_TIME=en_GB.UTF-8
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/chrisb/bin:/usr/local/bin:/usr/bin:/bin:/usr/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 31, 2011

From @jmdh

On Fri Jan 02 08​:42​:23 2009, crispygoth wrote​:

The SDBM_File module doesn't seem to be thread-safe. If a file is tied
before a
thread is created, the pointer to the DBM object is shared between
threads.
Each thread then attempts to free it, causing a crash.

The following script reproduces the problem for me​:

==================================
#!/usr/bin/perl

use strict;
use Fcntl;
use SDBM_File;
use threads;
use threads​::shared;

my %dbtest;
tie(%dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);

for (1 .. 2)
{
my $thr = threads->new(\&testThread, $_);
$thr->detach();
}
sleep 4;

sub testThread
{
my $n = shift;
print "thread #" . $n . " started\n";
}

This test script fails for me on Debian 5.12 and passes on Debian 5.14,
so I think that this has been fixed, but I don't know in which commit.

@p5pRT
Copy link
Author

@p5pRT p5pRT commented May 31, 2011

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 5, 2014

From @ppisar

Dne Út 31.Květen.2011 13​:52​:08, dom napsal(a)​:

On Fri Jan 02 08​:42​:23 2009, crispygoth wrote​:

The SDBM_File module doesn't seem to be thread-safe. If a file is tied
before a
thread is created, the pointer to the DBM object is shared between
threads.
Each thread then attempts to free it, causing a crash.

It happens even when spawning a single thread.

This test script fails for me on Debian 5.12 and passes on Debian 5.14,
so I think that this has been fixed, but I don't know in which commit.

I don't think so. It also crashes with perl 5.18.2. And with blead too.

-- Petr

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 6, 2014

From @ppisar

Dne Pá 02.led.2009 08​:42​:23, crispygoth napsal(a)​:

The SDBM_File module doesn't seem to be thread-safe. If a file is tied
before a
thread is created, the pointer to the DBM object is shared between
threads.
Each thread then attempts to free it, causing a crash.

The GDBM_File crashes the same way.

ODBM_File does not crash, but perl with enabled debugging warns on safefree(db) called at the end of DESTROY()​:

  (in cleanup) panic​: free from wrong pool, 2095010!=22068e0 at ../sdbm_threads-bug1104827/test.odbm line 11.

The same warning produce SDBM_File and GDBM_File.

Only the DB_File does not crash neither warns. But that's because modern BerkeleyDB is somewhat thread-safe and the DB_File.xs.

I think about using my_cxt_t to register each opened database, associating a counter there and increasing the counter on each CLONE(). Then each DESTROY() would check the counter and close the database only in last thread.

However I feel like reinventing a wheel. There must already exist a tooling for that in the perl.

-- Petr

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 10, 2014

From @ppisar

Dne Pá 02.led.2009 08​:42​:23, crispygoth napsal(a)​:

The SDBM_File module doesn't seem to be thread-safe. If a file is tied
before a
thread is created, the pointer to the DBM object is shared between
threads.
Each thread then attempts to free it, causing a crash.

At the end, I decided for different fix. I track the interpreter which allocated the object and deallocate it only from the original thread. This prevents from double-free as well as wrong-memory-pool panics, whereas it does not need any reference counting.

The fix developed against v5.21.0-269-g98db13b is attached.

-- Petr

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 10, 2014

From @ppisar

perl-5.21.0-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch
From fa7f2d3b340eb1056e24d083b45c94b380af65ed Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
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ř <ppisar@redhat.com>
---
 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 e3adf3f..aa3ae6c 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 070f074..261031d 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, pagname=NULL)
 	    }
 	    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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 10, 2014

From @ppisar

Dne Pá 06.čen.2014 00​:19​:17, ppisar napsal(a)​:

Only the DB_File does not crash neither warns. But that's because
modern BerkeleyDB is somewhat thread-safe and the DB_File.xs.

I had faulty test. DB_File crashes too. Reported to CPAN <https://rt.cpan.org/Public/Bug/Display.html?id=96357>.

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 17, 2014

From @iabyn

On Tue, Jun 10, 2014 at 12​:16​:52AM -0700, Petr Pisar via RT wrote​:

Dne Pá 02.led.2009 08​:42​:23, crispygoth napsal(a)​:

The SDBM_File module doesn't seem to be thread-safe. If a file is tied
before a
thread is created, the pointer to the DBM object is shared between
threads.
Each thread then attempts to free it, causing a crash.

At the end, I decided for different fix. I track the interpreter which allocated the object and deallocate it only from the original thread. This prevents from double-free as well as wrong-memory-pool panics, whereas it does not need any reference counting.

The fix developed against v5.21.0-269-g98db13b is attached.

I don't think that approach is completely safe. It's possible with threads
for a parent thread to terminate before the child is spawned. So a parent
thread could create a DB, then spawn a child, then terminate, freeing the
DB. The child could then try to access the freed database.

But even if we fix that, I should imagine that since the underlying *dbm
libraries themselves are not threadsafe, its still going to crash and burn
if multiple threads try to access the DB simultaneously.

So I think the approach would need to be something along the lines of​:

Each perl-level object points to a shared struct (allocated using
PerlMemShared_malloc()), that is MUTEX controlled, and contains​: a ref
count, the THX of the thread which allocated it, and a pointer the real db
handle.

DESTROY frees the db handle (and sets the pointer to NULL) only if the THX
matches. In addition for any thread, it decrements the ref count and frees
the structure if the count goes to zero.

When DB methods are called, it croaks unless the THXes match - so only the
thread that created the database is allowed to access it. Allowing other
threads to access it (even serially, via the MUTEX) would risk the DB
library mallocing from several different thread pools.

--
Standards (n). Battle insignia or tribal totems.

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jun 18, 2014

From @ppisar

On 2014-06-17, Dave Mitchell <davem@​iabyn.com> wrote​:

On Tue, Jun 10, 2014 at 12​:16​:52AM -0700, Petr Pisar via RT wrote​:

At the end, I decided for different fix. I track the interpreter
which allocated the object and deallocate it only from the original
thread. This prevents from double-free as well as wrong-memory-pool
panics, whereas it does not need any reference counting.

The fix developed against v5.21.0-269-g98db13b is attached.

I don't think that approach is completely safe. It's possible with
threads for a parent thread to terminate before the child is spawned.
So a parent thread could create a DB, then spawn a child, then
terminate, freeing the DB. The child could then try to access the
freed database.

(I believe you talk about thread-childs. Not about fork-childs.)

Well, my patch deals only with the destructor to fix the surprise on
exiting a thread (e.g. when using an unknown module which uses threads
under the hood).

I believe it behaves correctly even if the parent keeps orphaned
threads. (Actully I just give a test and surprisingly, the threads module
kills the orphans regardless they have or haven't been detached.) In
addition, the threads warns about unjoined threads very loudly. The only issue
would be if an orphaned thread tried to access the tied hash. Then the
access function would hit unallocated memory. However, as you noted​:

But even if we fix that, I should imagine that since the underlying
*dbm libraries themselves are not threadsafe, its still going to crash
and burn if multiple threads try to access the DB simultaneously.

*dbm libraries are not thread-safe as whole, so there is no new issue.

So I think the approach would need to be something along the lines of​:

Each perl-level object points to a shared struct (allocated using
PerlMemShared_malloc()), that is MUTEX controlled, and contains​: a ref
count, the THX of the thread which allocated it, and a pointer the
real db handle.

I cannot find documentation for the PerlMemShared_malloc(). Is it
something secret which should not be used?

DESTROY frees the db handle (and sets the pointer to NULL) only if the
THX matches. In addition for any thread, it decrements the ref count
and frees the structure if the count goes to zero.

When DB methods are called, it croaks unless the THXes match - so only
the thread that created the database is allowed to access it. Allowing
other threads to access it (even serially, via the MUTEX) would risk
the DB library mallocing from several different thread pools.

I other words, you ask me to ban any inter-thread access to the tied
hashes. I'm not very confident in this area as I've never do anything
with threads in XS and some of the *dbm libraries use my_cxt_t which is
already somehow thread-wide. I can try to do something but I'm not sure
about the output.

-- Petr

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

2 participants