CVE-2013-7490 (published 2020-09-11T19:15Z)

An issue was discovered in the DBI module before 1.632 for Perl. Using many arguments to methods for Callbacks may lead to memory corruption.

Severity: MEDIUM
CVSS v2 base score: 5.0 (AV:N/AC:L/Au:N/C:N/I:N/A:P)
CVSS v3 base score: 5.3, MEDIUM (CVSS:3.1/AV:N/AC:L/PR:N/UI:N/S:U/C:N/I:N/A:L)

Weakness information:
cwe_id: CWE-119
cwe_name: Improper Restriction of Operations within the Bounds of a Memory Buffer
description: The product performs operations on a memory buffer, but it reads from or writes to a memory location outside the buffer's intended boundary. This may result in read or write operations on unexpected memory locations that could be linked to other variables, data structures, or internal program data.
extended_description: 
            Certain languages allow direct addressing of memory locations and do not automatically ensure that these locations are valid for the memory buffer that is being referenced. This can cause read or write operations to be performed on memory locations that may be associated with other variables, data structures, or internal program data.
         
         

Fix information:
repo_url: https://github.com/perl5-dbi/dbi
commit_details: repo_url: https://github.com/perl5-dbi/dbi
author: Tim Bunce
author_date: 2014-09-21 15:01:17+01:00
msg: Fixed risk of memory corruption with many arguments to methods RT#86744
repository: repo_url: https://github.com/perl5-dbi/dbi
repo_name: perl5-dbi/dbi
description: DBI - The Perl 5 Database Interface
repo_language: Perl
owner: perl5-dbi
file_changes: filename: Changes
change_type: ModificationType.MODIFY
diff: @@ -8,6 +8,9 @@ DBI::Changes - List of significant changes to the DBI
 
 =head2 Changes in DBI 1.632
 
+    Fixed risk of memory corruption with many arguments to methods
+        originally reported by OSCHWALD for Callbacks but may apply
+        to other functionality in DBI method dispatch RT#86744.
     Fixed DBD::PurePerl to not set $sth->{Active} true by default
         drivers are expected to set it true as needed.
     Fixed DBI::DBD::SqlEngine to complain loudly when prerequite

programming_language: Markdown
filename: DBI.xs
change_type: ModificationType.MODIFY
diff: @@ -3147,6 +3147,7 @@ XS(XS_DBI_dispatch);            /* prototype to pass -Wmissing-prototypes */
 XS(XS_DBI_dispatch)
 {
     dXSARGS;
+    dORIGMARK;
     dMY_CXT;
 
     SV *h   = ST(0);            /* the DBI handle we are working with   */
@@ -3447,6 +3448,7 @@ XS(XS_DBI_dispatch)
                     XPUSHs(*hp);
                     PUTBACK;
                     call_method("DESTROY", G_DISCARD|G_EVAL|G_KEEPERR);
+                    MSPAGAIN;
                 }
                 else {
                     imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ *hp, 0);
@@ -3539,8 +3541,8 @@ XS(XS_DBI_dispatch)
         SV *code = SvRV(*hook_svp);
         I32 skip_dispatch = 0;
         if (trace_level)
-            PerlIO_printf(DBILOGFP, "%c   {{ %s callback %s being invoked\n",
-                (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0));
+            PerlIO_printf(DBILOGFP, "%c   {{ %s callback %s being invoked with %ld args\n",
+                (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), (long)items);
 
         /* we don't use ENTER,SAVETMPS & FREETMPS,LEAVE because we may need mortal
          * results to live long enough to be returned to our caller
@@ -3562,7 +3564,7 @@ XS(XS_DBI_dispatch)
         }
         PUTBACK;
         outitems = call_sv(code, G_ARRAY); /* call the callback code */
-        SPAGAIN;
+        MSPAGAIN;
 
         /* The callback code can undef $_ to indicate to skip dispatch */
         skip_dispatch = !SvOK(DEFSV);
@@ -3890,7 +3892,7 @@ XS(XS_DBI_dispatch)
                 XPUSHs(&PL_sv_yes);
                 PUTBACK;
                 call_method("STORE", G_DISCARD);
-                SPAGAIN;
+                MSPAGAIN;
             }
         }
     }
@@ -4047,7 +4049,7 @@ XS(XS_DBI_dispatch)
             XPUSHs( result );
             PUTBACK;
             items = call_sv(*hook_svp, G_SCALAR);
-            SPAGAIN;
+            MSPAGAIN;
             status = (items) ? POPs : &PL_sv_undef;
             PUTBACK;
             if (trace_level)

programming_language: C
filename: 70callbacks.t
change_type: ModificationType.MODIFY
diff: @@ -221,6 +221,16 @@ is $called{execute}, 1, 'Execute callback should have been called';
 ok $sth->fetch, 'Fetch';
 is $called{fetch}, 1, 'Fetch callback should have been called';
 
+# stress test for stack reallocation and mark handling -- RT#86744
+my $stress_count = 3000;
+my $place_holders = join(',', ('?') x $stress_count);
+my @params = ('t') x $stress_count;
+my $stress_dbh = DBI->connect( 'DBI:NullP:test');
+my $stress_sth = $stress_dbh->prepare("select 1");
+$stress_sth->{Callbacks}{execute} = sub { return; };
+$stress_sth->execute(@params);
+
+
 done_testing();
 
 __END__

programming_language: Perl