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,15 +111,17 @@ gdbm_DESTROY(db)
  53         PREINIT:
  54         int i = store_value;
  55      CODE:
  56 -        if (gdbm_file_close(db)) {
  57 -            croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
  58 -                  strerror(errno));
  59 -       }
  60 -       do {
  61 -           if (db->filter[i])
  62 -               SvREFCNT_dec(db->filter[i]);
  63 -       } while (i-- > 0);
  64 -       safefree(db);
  65 +       if (db && db->owner == aTHX) {
  66 +           if (gdbm_file_close(db)) {
  67 +               croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
  68 +               strerror(errno));
  69 +           }
  70 +           do {
  71 +               if (db->filter[i])
  72 +                   SvREFCNT_dec(db->filter[i]);
  73 +           } while (i-- > 0);
  74 +           safefree(db);
  75 +       }
  76
  77  void
  78  gdbm_UNTIE(db, count)
  79 diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs
  80 index 52e60fc..af223e5 100644
  81 --- a/ext/NDBM_File/NDBM_File.xs
  82 +++ b/ext/NDBM_File/NDBM_File.xs
  83 @@ -33,6 +33,7 @@ END_EXTERN_C
  84  #define store_value 3
  85
  86  typedef struct {
  87 +       tTHX    owner;
  88         DBM *   dbp ;
  89         SV *    filter[4];
  90         int     filtering ;
  91 @@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode)
  92             RETVAL = NULL ;
  93             if ((dbp =  dbm_open(filename, flags, mode))) {
  94                 RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type));
  95 +               RETVAL->owner = aTHX;
  96                 RETVAL->dbp = dbp ;
  97             }
  98
  99 @@ -84,12 +86,14 @@ ndbm_DESTROY(db)
 100         PREINIT:
 101         int i = store_value;
 102         CODE:
 103 -       dbm_close(db->dbp);
 104 -       do {
 105 -           if (db->filter[i])
 106 -               SvREFCNT_dec(db->filter[i]);
 107 -       } while (i-- > 0);
 108 -       safefree(db);
 109 +       if (db && db->owner == aTHX) {
 110 +           dbm_close(db->dbp);
 111 +           do {
 112 +               if (db->filter[i])
 113 +                   SvREFCNT_dec(db->filter[i]);
 114 +           } while (i-- > 0);
 115 +           safefree(db);
 116 +       }
 117
 118  #define ndbm_FETCH(db,key)                     dbm_fetch(db->dbp,key)
 119  datum_value
 120 diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
 121 index d1ece7f..f7e00a0 100644
 122 --- a/ext/ODBM_File/ODBM_File.xs
 123 +++ b/ext/ODBM_File/ODBM_File.xs
 124 @@ -45,6 +45,7 @@ datum nextkey(datum key);
 125  #define store_value 3
 126
 127  typedef struct {
 128 +       tTHX    owner;
 129         void *  dbp ;
 130         SV *    filter[4];
 131         int     filtering ;
 132 @@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
 133             }
 134             dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
 135             RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type));
 136 +           RETVAL->owner = aTHX;
 137             RETVAL->dbp = dbp ;
 138         }
 139         OUTPUT:
 140 @@ -124,13 +126,15 @@ DESTROY(db)
 141         dMY_CXT;
 142         int i = store_value;
 143         CODE:
 144 -       dbmrefcnt--;
 145 -       dbmclose();
 146 -       do {
 147 -           if (db->filter[i])
 148 -               SvREFCNT_dec(db->filter[i]);
 149 -       } while (i-- > 0);
 150 -       safefree(db);
 151 +       if (db && db->owner == aTHX) {
 152 +           dbmrefcnt--;
 153 +           dbmclose();
 154 +           do {
 155 +               if (db->filter[i])
 156 +                   SvREFCNT_dec(db->filter[i]);
 157 +           } while (i-- > 0);
 158 +           safefree(db);
 159 +       }
 160
 161  datum_value
 162  odbm_FETCH(db, key)
 163 diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs
 164 index 291e41b..0bdae9a 100644
 165 --- a/ext/SDBM_File/SDBM_File.xs
 166 +++ b/ext/SDBM_File/SDBM_File.xs
 167 @@ -10,6 +10,7 @@
 168  #define store_value 3
 169
 170  typedef struct {
 171 +       tTHX    owner;
 172         DBM *   dbp ;
 173         SV *    filter[4];
 174         int     filtering ;
 175 @@ -49,6 +50,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode)
 176             }
 177             if (dbp) {
 178                 RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type));
 179 +               RETVAL->owner = aTHX;
 180                 RETVAL->dbp = dbp ;
 181             }
 182
 183 @@ -60,7 +62,7 @@ void
 184  sdbm_DESTROY(db)
 185         SDBM_File       db
 186         CODE:
 187 -       if (db) {
 188 +       if (db && db->owner == aTHX) {
 189             int i = store_value;
 190             sdbm_close(db->dbp);
 191             do {
 192 diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl
 193 index 5d4098c..a0a4d52 100644
 194 --- a/t/lib/dbmt_common.pl
 195 +++ b/t/lib/dbmt_common.pl
 196 @@ -511,5 +511,40 @@ unlink <Op_dbmx*>, $Dfile;
 197     unlink <Op1_dbmx*>;
 198  }
 199
 200 +{
 201 +   # Check DBM back-ends do not destroy objects from then-spawned threads.
 202 +   # RT#61912.
 203 +   SKIP: {
 204 +      my $threads_count = 2;
 205 +      skip 'Threads are disabled', 3 + 2 * $threads_count
 206 +        unless $Config{usethreads};
 207 +      use_ok('threads');
 208 +
 209 +      my %h;
 210 +      unlink <Op1_dbmx*>;
 211 +
 212 +      my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640;
 213 +      isa_ok($db, $DBM_Class);
 214 +
 215 +      for (1 .. 2) {
 216 +         ok(threads->create(
 217 +            sub {
 218 +               $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics
 219 +                        # report it by spurious TAP line
 220 +               1;
 221 +            }), "Thread $_ created");
 222 +      }
 223 +      for (threads->list) {
 224 +         is($_->join, 1, "A thread exited successfully");
 225 +      }
 226 +
 227 +      pass("Tied object survived exiting threads");
 228 +
 229 +      undef $db;
 230 +      untie %h;
 231 +      unlink <Op1_dbmx*>;
 232 +   }
 233 +}
 234 +
 235  done_testing();
 236  1;
 237 --
 238 1.9.3
 239