From ea99b6aafb437db53c28fd40d5eafbe119cd66e1 Mon Sep 17 00:00:00 2001
From: Pali <pali@cpan.org>
Date: Wed, 31 Jul 2019 14:01:35 +0200
Subject: [PATCH] Fix memory corruption in XS functions when Perl stack is
 reallocated

Macro ST(*) returns pointer to Perl stack. Other Perl functions which use
Perl stack (e.g. eval) may reallocate Perl stack and therefore pointer
returned by ST(*) macro is invalid.

Construction like this:

ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;

where dbd_db_login6_sv() driver function calls eval may lead to
reallocating Perl stack and therefore invalidating ST(0) pointer.
So that construction would cause memory corruption as left part of
assignment is resolved prior executing dbd_db_login6_sv() function.

Correct way how to handle this problem: First call dbd_db_login6_sv()
function and then call ST(0) to retrieve stack pointer.

In this patch are fixes all occurrences of such constructions.

When running perl under valgrind I got memory corruption in DBD::ODBC
driver in that dbd_db_login6_sv() function due to above problem.

Exactly same problem was present in Encode module which was fixed in pull
request: https://github.com/dankogai/p5-encode/pull/72
---
 DBI.xs     | 17 ++++++++---
 Driver.xst | 84 +++++++++++++++++++++++++++++++++---------------------
 2 files changed, 65 insertions(+), 36 deletions(-)

Index: a/DBI.xs
===================================================================
--- a/DBI.xs
+++ b/DBI.xs
@@ -5252,9 +5252,12 @@ bind_col(sth, col, ref, attribs=Nullsv)
     SV *        col
     SV *        ref
     SV *        attribs
+    PREINIT:
+    SV *ret;
     CODE:
     DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
-    ST(0) = boolSV(dbih_sth_bind_col(sth, col, ref, attribs));
+    ret = boolSV(dbih_sth_bind_col(sth, col, ref, attribs));
+    ST(0) = ret;
     (void)cv;
 
 
@@ -5492,21 +5495,27 @@ void
 FETCH(h, keysv)
     SV *        h
     SV *        keysv
+    PREINIT:
+    SV *ret;
     CODE:
-    ST(0) = dbih_get_attr_k(h, keysv, 0);
+    ret = dbih_get_attr_k(h, keysv, 0);
+    ST(0) = ret;
     (void)cv;
 
 void
 DELETE(h, keysv)
     SV *        h
     SV *        keysv
+    PREINIT:
+    SV *ret;
     CODE:
     /* only private_* keys can be deleted, for others DELETE acts like FETCH */
     /* because the DBI internals rely on certain handle attributes existing  */
     if (strnEQ(SvPV_nolen(keysv),"private_",8))
-        ST(0) = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
+        ret = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
     else
-        ST(0) = dbih_get_attr_k(h, keysv, 0);
+        ret = dbih_get_attr_k(h, keysv, 0);
+    ST(0) = ret;
     (void)cv;
 
 
Index: a/Driver.xst
===================================================================
--- a/Driver.xst
+++ b/Driver.xst
@@ -60,7 +60,7 @@ dbixs_revision(...)
 #ifdef dbd_discon_all
 
 # disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
-void
+bool
 discon_all_(drh)
     SV *        drh
     ALIAS:
@@ -68,7 +68,9 @@ discon_all_(drh)
     CODE:
     D_imp_drh(drh);
     PERL_UNUSED_VAR(ix);
-    ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_discon_all(drh, imp_drh);
+    OUTPUT:
+    RETVAL
 
 #endif /* dbd_discon_all */
 
@@ -102,7 +104,7 @@ data_sources(drh, attr = Nullsv)
 MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::db
 
 
-void
+bool
 _login(dbh, dbname, username, password, attribs=Nullsv)
     SV *        dbh
     SV *        dbname
@@ -118,13 +120,15 @@ _login(dbh, dbname, username, password,
     char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
 #endif
 #ifdef dbd_db_login6_sv
-    ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs);
 #elif defined(dbd_db_login6)
-    ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs);
 #else
-    ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p);
 #endif
     }
+    OUTPUT:
+    RETVAL
 
 
 void
@@ -287,33 +291,38 @@ last_insert_id(dbh, catalog, schema, tab
     CODE:
     {
     D_imp_dbh(dbh);
-    ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
+    SV *ret = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
+    ST(0) = ret;
     }
 
 #endif
 
 
-void
+bool
 commit(dbh)
     SV *        dbh
     CODE:
     D_imp_dbh(dbh);
     if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
         warn("commit ineffective with AutoCommit enabled");
-    ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_commit(dbh, imp_dbh);
+    OUTPUT:
+    RETVAL
 
 
-void
+bool
 rollback(dbh)
     SV *        dbh
     CODE:
     D_imp_dbh(dbh);
     if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
         warn("rollback ineffective with AutoCommit enabled");
-    ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_rollback(dbh, imp_dbh);
+    OUTPUT:
+    RETVAL
 
 
-void
+bool
 disconnect(dbh)
     SV *        dbh
     CODE:
@@ -330,8 +339,10 @@ disconnect(dbh)
             SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
             "(either destroy statement handles or call finish on them before disconnecting)");
     }
-    ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_db_disconnect(dbh, imp_dbh);
     DBIc_ACTIVE_off(imp_dbh);   /* ensure it's off, regardless */
+    OUTPUT:
+    RETVAL
 
 
 void
@@ -465,7 +476,7 @@ data_sources(dbh, attr = Nullsv)
 MODULE = DBD::~DRIVER~    PACKAGE = DBD::~DRIVER~::st
 
 
-void
+bool
 _prepare(sth, statement, attribs=Nullsv)
     SV *        sth
     SV *        statement
@@ -475,11 +486,13 @@ _prepare(sth, statement, attribs=Nullsv)
     D_imp_sth(sth);
     DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
 #ifdef dbd_st_prepare_sv
-    ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_st_prepare_sv(sth, imp_sth, statement, attribs);
 #else
-    ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs);
 #endif
     }
+    OUTPUT:
+    RETVAL
 
 
 #ifdef dbd_st_rows
@@ -496,7 +509,7 @@ rows(sth)
 
 #ifdef dbd_st_bind_col
 
-void
+bool
 bind_col(sth, col, ref, attribs=Nullsv)
     SV *        sth
     SV *        col
@@ -521,20 +534,21 @@ bind_col(sth, col, ref, attribs=Nullsv)
         }
     }
     switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
-    case 2:     ST(0) = &PL_sv_yes;        /* job done completely */
+    case 2:     RETVAL = TRUE;              /* job done completely */
                 break;
     case 1:     /* fallback to DBI default */
-                ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
-                    ? &PL_sv_yes : &PL_sv_no;
+                RETVAL = DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs);
                 break;
-    default:    ST(0) = &PL_sv_no;         /* dbd_st_bind_col has called set_err */
+    default:    RETVAL = FALSE;             /* dbd_st_bind_col has called set_err */
                 break;
     }
     }
+    OUTPUT:
+    RETVAL
 
 #endif /* dbd_st_bind_col */
 
-void
+bool
 bind_param(sth, param, value, attribs=Nullsv)
     SV *        sth
     SV *        param
@@ -558,12 +572,13 @@ bind_param(sth, param, value, attribs=Nu
             DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
         }
     }
-    ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
-                ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0);
     }
+    OUTPUT:
+    RETVAL
 
 
-void
+bool
 bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
     SV *        sth
     SV *        param
@@ -593,9 +608,10 @@ bind_param_inout(sth, param, value_ref,
             DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
         }
     }
-    ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
-                ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen);
     }
+    OUTPUT:
+    RETVAL
 
 
 void
@@ -631,7 +647,8 @@ execute_for_fetch(sth, fetch_tuple_sub,
     CODE:
     {
     D_imp_sth(sth);
-    ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
+    SV *ret = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
+    ST(0) = ret;
     }
 
 #endif
@@ -689,7 +706,7 @@ fetchall_arrayref(sth, slice=&PL_sv_unde
     }
 
 
-void
+bool
 finish(sth)
     SV *        sth
     CODE:
@@ -706,10 +723,12 @@ finish(sth)
         XSRETURN_YES;
     }
 #ifdef dbd_st_finish3
-    ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_st_finish3(sth, imp_sth, 0);
 #else
-    ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
+    RETVAL = dbd_st_finish(sth, imp_sth);
 #endif
+    OUTPUT:
+    RETVAL
 
 
 void
