Fix disconnect_all() method to work also during global destruction phase

During global destruction phase ChildHandles DBI attribute may be already
released or children can be undefs due to weakrefs.

So instead of relaying on ChildHandles, maintain own double linked list of
all imp_dbh structures with active MYSQL connection. This does not use any
Perl data structures so they are available at any time, including global
destruction phase.

Fixes: jhthorsen/mojo-mysql#47 (comment)
Fixes: 17d5aa0

Author: pali

MANIFEST

@@ -19,6 +19,7 @@ t/10connect.t
 t/11data_sources.t
 t/12embedded.t
 t/13disconnect.t
+t/14destruct.t
 t/15reconnect.t
 t/16dbi-get_info.t
 t/20createdrop.t

dbdimp.c

@@ -2291,6 +2291,8 @@ static bool mariadb_dr_connect(
 
           imp_dbh->async_query_in_flight = NULL;
 
+    mariadb_list_add(imp_drh->active_imp_dbhs, imp_dbh->list_entry, imp_dbh);
+
     return TRUE;
 }
 
@@ -2370,10 +2372,16 @@ static bool mariadb_db_my_login(pTHX_ SV* dbh, imp_dbh_t *imp_dbh)
       }
       if (!found_taken_pmysql)
       {
+        /* This imp_dbh data belongs to different connection, so destructor should not touch it */
+        imp_dbh->list_entry = NULL;
         imp_dbh->pmysql = NULL;
         mariadb_dr_do_error(dbh, CR_CONNECTION_ERROR, "Connection error: dbi_imp_data is not valid", "HY000");
         return FALSE;
       }
+
+      /* Add imp_dbh entry into active_imp_dbhs list */
+      mariadb_list_add(imp_drh->active_imp_dbhs, imp_dbh->list_entry, imp_dbh);
+
       return TRUE;
     }
     if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
@@ -2452,6 +2460,9 @@ SV *mariadb_db_take_imp_data(SV *dbh, imp_xxh_t *imp_xxh, void *foo)
     imp_drh->taken_pmysqls = newAV();
   av_push(imp_drh->taken_pmysqls, newSViv(PTR2IV(imp_dbh->pmysql)));
 
+  /* MYSQL* was taken from imp_dbh so remove it also from active_imp_dbhs list */
+  mariadb_list_remove(imp_drh->active_imp_dbhs, imp_dbh->list_entry);
+
   return &PL_sv_no;
 }
 
@@ -2979,39 +2990,23 @@ static void mariadb_dr_close_mysql(pTHX_ imp_drh_t *imp_drh, MYSQL *pmysql)
   }
 }
 
-/*
- ***************************************************************************
- *
- *  Name:    mariadb_db_disconnect
- *
- *  Purpose: Disconnect a database handle from its database
- *
- *  Input:   dbh - database handle being disconnected
- *           imp_dbh - drivers private database handle data
- *
- *  Returns: 1 for success (always)
- *
- **************************************************************************/
-
-int mariadb_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh)
+static void mariadb_db_close_mysql(pTHX_ imp_drh_t *imp_drh, imp_dbh_t *imp_dbh)
 {
-  dTHX;
   AV *av;
   I32 i;
   MAGIC *mg;
   SV **svp;
   SV *sv;
   SV *sth;
   imp_sth_t *imp_sth;
-  D_imp_xxh(dbh);
-  D_imp_drh_from_dbh;
 
-  /* We assume that disconnect will always work       */
-  /* since most errors imply already disconnected.    */
+  if (DBIc_TRACE_LEVEL(imp_dbh) >= 2)
+    PerlIO_printf(DBIc_LOGPIO(imp_dbh), "\tmariadb_db_close_mysql: imp_dbh=%p pmysql=%p\n", imp_dbh, imp_dbh->pmysql);
+
   DBIc_ACTIVE_off(imp_dbh);
-  if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
-    PerlIO_printf(DBIc_LOGPIO(imp_xxh), "imp_dbh->pmysql: %p\n",
-		              imp_dbh->pmysql);
+
+  if (imp_dbh->list_entry)
+    mariadb_list_remove(imp_drh->active_imp_dbhs, imp_dbh->list_entry);
 
   if (imp_dbh->pmysql)
   {
@@ -3045,14 +3040,39 @@ int mariadb_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh)
            * CVE 2017-3302 do not do it. So do it manually to prevent crash. */
           if (imp_sth->stmt && imp_sth->stmt->mysql)
           {
-            if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
-              PerlIO_printf(DBIc_LOGPIO(imp_xxh), "Applying CVE 2017-3302 workaround for sth=0x%p\n", imp_sth);
+            if (DBIc_TRACE_LEVEL(imp_dbh) >= 2)
+              PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Applying CVE 2017-3302 workaround for sth=%p\n", imp_sth);
             imp_sth->stmt->mysql = NULL;
           }
         }
       }
     }
   }
+}
+
+/*
+ ***************************************************************************
+ *
+ *  Name:    mariadb_db_disconnect
+ *
+ *  Purpose: Disconnect a database handle from its database
+ *
+ *  Input:   dbh - database handle being disconnected
+ *           imp_dbh - drivers private database handle data
+ *
+ *  Returns: 1 for success (always)
+ *
+ **************************************************************************/
+
+int mariadb_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh)
+{
+  dTHX;
+  D_imp_drh_from_dbh;
+  PERL_UNUSED_ARG(dbh);
+
+  /* We assume that disconnect will always work       */
+  /* since most errors imply already disconnected.    */
+  mariadb_db_close_mysql(aTHX_ imp_drh, imp_dbh);
 
   /* We don't free imp_dbh since a reference still exists    */
   /* The DESTROY method is the only one to 'free' memory.    */
@@ -3075,10 +3095,8 @@ int mariadb_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh)
 
 int mariadb_dr_discon_all (SV *drh, imp_drh_t *imp_drh) {
   dTHX;
-  dSP;
   int ret;
   SV **svp;
-  AV *av;
   I32 i;
   PERL_UNUSED_ARG(drh);
 
@@ -3098,34 +3116,8 @@ int mariadb_dr_discon_all (SV *drh, imp_drh_t *imp_drh) {
     imp_drh->taken_pmysqls = NULL;
   }
 
-  svp = hv_fetchs((HV*)DBIc_MY_H(imp_drh), "ChildHandles", FALSE);
-  if (svp && *svp)
-  {
-    SvGETMAGIC(*svp);
-    if (SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV)
-    {
-      av = (AV *)SvRV(*svp);
-      for (i = AvFILL(av); i >= 0; --i)
-      {
-        svp = av_fetch(av, i, FALSE);
-        if (!svp || !*svp || !sv_isobject(*svp))
-          continue;
-
-        ENTER;
-        SAVETMPS;
-
-        PUSHMARK(SP);
-        EXTEND(SP, 1);
-        PUSHs(sv_2mortal(newSVsv(*svp)));
-        PUTBACK;
-
-        call_method("disconnect", G_VOID|G_DISCARD|G_EVAL|G_KEEPERR);
-
-        FREETMPS;
-        LEAVE;
-      }
-    }
-  }
+  while (imp_drh->active_imp_dbhs)
+    mariadb_db_close_mysql(aTHX_ imp_drh, (imp_dbh_t *)imp_drh->active_imp_dbhs->data);
 
   ret = 1;
 

dbdimp.h

@@ -417,6 +417,35 @@ enum av_attribs {
 };                         /*  purposes only                                */
 
 
+/* Double linked list */
+struct mariadb_list_entry {
+    void *data;
+    struct mariadb_list_entry *prev;
+    struct mariadb_list_entry *next;
+};
+#define mariadb_list_add(list, entry, ptr)           \
+  STMT_START {                                       \
+    Newz(0, (entry), 1, struct mariadb_list_entry);  \
+    (entry)->data = (ptr);                           \
+    (entry)->prev = NULL;                            \
+    (entry)->next = (list);                          \
+    if ((list))                                      \
+      (list)->prev = (entry);                        \
+    (list) = (entry);                                \
+  } STMT_END
+#define mariadb_list_remove(list, entry)             \
+  STMT_START {                                       \
+    if ((entry)->prev)                               \
+      (entry)->prev->next = (entry)->next;           \
+    if ((entry)->next)                               \
+      (entry)->next->prev = (entry)->prev;           \
+    if ((list) == (entry))                           \
+      (list) = (entry)->next;                        \
+    Safefree((entry));                               \
+    (entry) = NULL;                                  \
+  } STMT_END
+
+
 /*
  *  This is our part of the driver handle. We receive the handle as
  *  an "SV*", say "drh", and receive a pointer to the structure below
@@ -429,6 +458,8 @@ enum av_attribs {
  */
 struct imp_drh_st {
     dbih_drc_t com;         /* MUST be first element in structure   */
+
+    struct mariadb_list_entry *active_imp_dbhs; /* List of imp_dbh structures with active MYSQL* */
     unsigned long int instances;
     bool non_embedded_started;
 #if !defined(HAVE_EMBEDDED) && defined(HAVE_BROKEN_INIT)
@@ -454,6 +485,7 @@ struct imp_drh_st {
 struct imp_dbh_st {
     dbih_dbc_t com;         /*  MUST be first element in structure   */
 
+    struct mariadb_list_entry *list_entry; /* Entry of imp_drh->active_imp_dbhs list */
     MYSQL *pmysql;
     bool connected;          /* Set to true after DBI->connect finished */
     bool auto_reconnect;

t/14destruct.t

@@ -0,0 +1,25 @@
+use strict;
+use warnings;
+
+use Test::More;
+use DBI;
+
+use vars qw($test_dsn $test_user $test_password);
+use lib 't', '.';
+require 'lib.pl';
+
+my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { RaiseError => 1, PrintError => 0 });
+
+plan tests => 3;
+
+ok my $sth1 = $dbh->prepare("SELECT 1");
+ok my $sth2 = $dbh->prepare("SELECT 1", { mariadb_server_prepare => 1 });
+
+# install a handler so that a warning about unfreed resources gets caught
+$SIG{__WARN__} = sub { die @_ };
+
+END {
+    my $sth1_copy = $sth1;
+    my $sth2_copy = $sth2;
+    pass;
+}