perl-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects.patch

   1 From f793042f2bac2ace9a5c0030b47b41c4db561a5b Mon Sep 17 00:00:00 2001
   2 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
   3 Date: Fri, 6 Jun 2014 14:31:59 +0200
   4 Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original
   5  thread context
   6 MIME-Version: 1.0
   7 Content-Type: text/plain; charset=UTF-8
   8 Content-Transfer-Encoding: 8bit
   9
  10 This patch fixes a crash when destroing a hash tied to a *_File
  11 database after spawning a thread:
  12
  13 use Fcntl;
  14 use SDBM_File;
  15 use threads;
  16 tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666);
  17 threads->new(sub {})->join;
  18
  19 This crashed or paniced depending on how perl was configured.
  20
  21 Closes RT#61912.
  22
  23 Signed-off-by: Petr Písař <ppisar@redhat.com>
  24 ---
  25  ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------
  26  ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------
  27  ext/ODBM_File/ODBM_File.xs | 18 +++++++++++-------
  28  ext/SDBM_File/SDBM_File.xs |  4 +++-
  29  t/lib/dbmt_common.pl       | 35 +++++++++++++++++++++++++++++++++++
  30  5 files changed, 69 insertions(+), 20 deletions(-)
  31
  32 diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs
  33 index 33e08e2..7160f54 100644
  34 --- a/ext/GDBM_File/GDBM_File.xs
  35 +++ b/ext/GDBM_File/GDBM_File.xs
  36 @@ -13,6 +13,7 @@
  37  #define store_value 3
  38
  39  typedef struct {
  40 +       tTHX    owner;
  41         GDBM_FILE       dbp ;
  42         SV *    filter[4];
  43         int     filtering ;
  44 @@ -99,6 +99,7 @@ gdbm_TIEHASH(dbtype, name, read_write, m
  45         }
  46         if (dbp) {
  47             RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
  48 +           RETVAL->owner = aTHX;
  49             RETVAL->dbp = dbp;
  50         } else {
  51             RETVAL = NULL;
  52 @@ -109,12 +111,14 @@ gdbm_DESTROY(db)
  53         PREINIT:
  54         int i = store_value;
  55         CODE:
  56 -       gdbm_close(db);
  57 -       do {
  58 -           if (db->filter[i])
  59 -               SvREFCNT_dec(db->filter[i]);
  60 -       } while (i-- > 0);
  61 -       safefree(db);
  62 +       if (db && db->owner == aTHX) {
  63 +           gdbm_close(db);
  64 +           do {
  65 +               if (db->filter[i])
  66 +                   SvREFCNT_dec(db->filter[i]);
  67 +           } while (i-- > 0);
  68 +           safefree(db);
  69 +       }
  70
  71  #define gdbm_FETCH(db,key)                     gdbm_fetch(db->dbp,key)
  72  datum_value
  73 diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
  74 index 52e60fc..af223e5 100644
  75 --- a/ext/NDBM_File/NDBM_File.xs
  76 +++ b/ext/NDBM_File/NDBM_File.xs
  77 @@ -33,6 +33,7 @@ END_EXTERN_C
  78  #define store_value 3
  79
  80  typedef struct {
  81 +       tTHX    owner;
  82         DBM *   dbp ;
  83         SV *    filter[4];
  84         int     filtering ;
  85 @@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
  86             RETVAL = NULL ;
  87             if ((dbp =  dbm_open(filename, flags, mode))) {
  88                 RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
  89 +               RETVAL->owner = aTHX;
  90                 RETVAL->dbp = dbp ;
  91             }
  92
  93 @@ -84,12 +86,14 @@ ndbm_DESTROY(db)
  94         PREINIT:
  95         int i = store_value;
  96         CODE:
  97 -       dbm_close(db->dbp);
  98 -       do {
  99 -           if (db->filter[i])
 100 -               SvREFCNT_dec(db->filter[i]);
 101 -       } while (i-- > 0);
 102 -       safefree(db);
 103 +       if (db && db->owner == aTHX) {
 104 +           dbm_close(db->dbp);
 105 +           do {
 106 +               if (db->filter[i])
 107 +                   SvREFCNT_dec(db->filter[i]);
 108 +           } while (i-- > 0);
 109 +           safefree(db);
 110 +       }
 111
 112  #define ndbm_FETCH(db,key)                     dbm_fetch(db->dbp,key)
 113  datum_value
 114 diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
 115 index d1ece7f..f7e00a0 100644
 116 --- a/ext/ODBM_File/ODBM_File.xs
 117 +++ b/ext/ODBM_File/ODBM_File.xs
 118 @@ -45,6 +45,7 @@ datum nextkey(datum key);
 119  #define store_value 3
 120
 121  typedef struct {
 122 +       tTHX    owner;
 123         void *  dbp ;
 124         SV *    filter[4];
 125         int     filtering ;
 126 @@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 127             }
 128             dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
 129             RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
 130 +           RETVAL->owner = aTHX;
 131             RETVAL->dbp = dbp ;
 132         }
 133         OUTPUT:
 134 @@ -124,13 +126,15 @@ DESTROY(db)
 135         dMY_CXT;
 136         int i = store_value;
 137         CODE:
 138 -       dbmrefcnt--;
 139 -       dbmclose();
 140 -       do {
 141 -           if (db->filter[i])
 142 -               SvREFCNT_dec(db->filter[i]);
 143 -       } while (i-- > 0);
 144 -       safefree(db);
 145 +       if (db && db->owner == aTHX) {
 146 +           dbmrefcnt--;
 147 +           dbmclose();
 148 +           do {
 149 +               if (db->filter[i])
 150 +                   SvREFCNT_dec(db->filter[i]);
 151 +           } while (i-- > 0);
 152 +           safefree(db);
 153 +       }
 154
 155  datum_value
 156  odbm_FETCH(db, key)
 157 diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
 158 index 291e41b..0bdae9a 100644
 159 --- a/ext/SDBM_File/SDBM_File.xs
 160 +++ b/ext/SDBM_File/SDBM_File.xs
 161 @@ -10,6 +10,7 @@
 162  #define store_value 3
 163
 164  typedef struct {
 165 +       tTHX    owner;
 166         DBM *   dbp ;
 167         SV *    filter[4];
 168         int     filtering ;
 169 @@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 170             }
 171             if (dbp) {
 172                 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
 173 +               RETVAL->owner = aTHX;
 174                 RETVAL->dbp = dbp ;
 175             }
 176
 177 @@ -60,7 +62,7 @@ void
 178  sdbm_DESTROY(db)
 179         SDBM_File       db
 180         CODE:
 181 -       if (db) {
 182 +       if (db && db->owner == aTHX) {
 183             int i = store_value;
 184             sdbm_close(db->dbp);
 185             do {
 186 diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
 187 index 5d4098c..a0a4d52 100644
 188 --- a/t/lib/dbmt_common.pl
 189 +++ b/t/lib/dbmt_common.pl
 190 @@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
 191     unlink <Op1_dbmx*>;
 192  }
 193
 194 +{
 195 +   # Check DBM back-ends do not destroy objects from then-spawned threads.
 196 +   # RT#61912.
 197 +   SKIP: {
 198 +      my $threads_count = 2;
 199 +      skip 'Threads are disabled', 3 + 2 * $threads_count
 200 +        unless $Config{usethreads};
 201 +      use_ok('threads');
 202 +
 203 +      my %h;
 204 +      unlink <Op1_dbmx*>;
 205 +
 206 +      my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
 207 +      isa_ok($db, $DBM_Class);
 208 +
 209 +      for (1 .. 2) {
 210 +         ok(threads->create(
 211 +            sub {
 212 +               $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
 213 +                        # report it by spurious TAP line
 214 +               1;
 215 +            }), "Thread $_ created");
 216 +      }
 217 +      for (threads->list) {
 218 +         is($_->join, 1, "A thread exited successfully");
 219 +      }
 220 +
 221 +      pass("Tied object survived exiting threads");
 222 +
 223 +      undef $db;
 224 +      untie %h;
 225 +      unlink <Op1_dbmx*>;
 226 +   }
 227 +}
 228 +
 229  done_testing();
 230  1;
 231 --
 232 1.9.3
 233