File perl-DBI-CVE-2020-14393.patch of Package perl-DBI.16441

From 36f2a2c5fea36d7d47d6871e420286643460e71b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Fri, 26 Jul 2019 13:23:09 +0200
Subject: [PATCH] Fix a buffer overlfow on an overlong DBD class name

dbih_setup_handle() in DBI.xs does:

static void
dbih_setup_handle(pTHX_ SV *orv, char *imp_class, SV *parent, SV *imp_datasv)
{
    [...]
    char imp_mem_name[300];
    [...]
    strcpy(imp_mem_name, imp_class);
    strcat(imp_mem_name, "_mem");
    [...]
}

If imp_class argument string value is longer than 300 - strlen("_mem")
 - 1 bytes, a data will be written past imp_mem_name[] array. The
imp_class comes from DBD driver class name (DBI::_new_drh ->
_new_handle() -> dbih_setup_handle()).

People usually do not use so long package names (e.g. DBD::ExampleP
calls DBI::_new_drh() in lib/DBD/ExampleP.pm), so the risk is low.

Reproducer:

$ perl -MDBI -e 'DBI::_new_drh(q{x} x 300, {}, 0)'
 *** buffer overflow detected ***: perl terminated
Aborted (core dumped)

https://rt.cpan.org/Ticket/Display.html?id=130191
---
 DBI.xs       |  9 ++++-----
 t/02dbidrv.t | 12 +++++++++++-
 2 files changed, 15 insertions(+), 6 deletions(-)

Index: DBI-1.639/DBI.xs
===================================================================
--- DBI-1.639.orig/DBI.xs
+++ DBI-1.639/DBI.xs
@@ -1422,7 +1422,7 @@ dbih_setup_handle(pTHX_ SV *orv, char *i
     SV *dbih_imp_rv;
     SV *dbi_imp_data = Nullsv;
     SV **svp;
-    char imp_mem_name[300];
+    SV *imp_mem_name;
     HV  *imp_mem_stash;
     imp_xxh_t *imp;
     imp_xxh_t *parent_imp;
@@ -1449,10 +1449,9 @@ dbih_setup_handle(pTHX_ SV *orv, char *i
     if (mg_find(SvRV(h), DBI_MAGIC) != NULL)
         croak(errmsg, neatsvpv(orv,0), imp_class, "already a DBI (or ~magic) handle");
 
-    strcpy(imp_mem_name, imp_class);
-    strcat(imp_mem_name, "_mem");
-    if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL)
-        croak(errmsg, neatsvpv(orv,0), imp_mem_name, "unknown _mem package");
+    imp_mem_name = sv_2mortal(newSVpvf("%s_mem", imp_class));
+    if ( (imp_mem_stash = gv_stashsv(imp_mem_name, FALSE)) == NULL)
+        croak(errmsg, neatsvpv(orv,0), SvPVbyte_nolen(imp_mem_name), "unknown _mem package");
 
     if ((svp = hv_fetch((HV*)SvRV(h), "dbi_imp_data", 12, 0))) {
         dbi_imp_data = *svp;
Index: DBI-1.639/t/02dbidrv.t
===================================================================
--- DBI-1.639.orig/t/02dbidrv.t
+++ DBI-1.639/t/02dbidrv.t
@@ -4,7 +4,7 @@ $|=1;
 
 use strict;
 
-use Test::More tests => 53;
+use Test::More tests => 54;
 
 ## ----------------------------------------------------------------------------
 ## 02dbidrv.t - ...
@@ -21,6 +21,16 @@ BEGIN {
     use_ok('DBI');
 }
 
+## DBI::_new_drh had an internal limit on a driver class name and crashed.
+SKIP: {
+    Test::More::skip "running DBI::PurePerl", 1 if $DBI::PurePerl;
+    eval {
+        DBI::_new_drh('DBD::Test::OverLong' . 'x' x 300,
+            { Name => 'Test', Version => 'Test', }, 42);
+    };
+    like($@, qr/unknown _mem package/, 'Overlong DBD class name is processed');
+}
+
 ## ----------------------------------------------------------------------------
 ## create a Test Driver (DBD::Test)