crash in XS_DBI_dispatch by cloning $dbh

[daxim]

DBI 1.647

❯ gdb --args perl -Mblib -mDBI -MClone=clone -E'clone(DBI->connect("dbi:Pg:host=localhost"))'
GNU gdb (GDB; openSUSE Tumbleweed) 15.2
Copyright (C) 2024 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
Type "show copying" and "show warranty" for details.
This GDB was configured as "x86_64-suse-linux".
Type "show configuration" for configuration details.
For bug reporting instructions, please see:
<http://bugs.opensuse.org/>.
Find the GDB manual and other documentation resources online at:
    <http://www.gnu.org/software/gdb/documentation/>.

For help, type "help".
Type "apropos word" to search for commands related to "word"...
Reading symbols from perl...
(gdb) r
Starting program: /home/larsd/.local/share/perlbrew/perls/perl-5.40.1/bin/perl -Mblib -mDBI -MClone=clone -Eclone\(DBI-\>connect\(\"dbi:Pg:host=localhost\"\)\)
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".

Program received signal SIGSEGV, Segmentation fault.
XS_DBI_dispatch (cv=0x5555558dce28) at /home/larsd/.cache/cpanm/work/1741862763.21292/DBI-1.647/DBI.xs:3362
3362        if ((i = DBIc_DEBUGIV(imp_xxh))) { /* merge handle into global */
Missing separate debuginfos, use: zypper install libcrypt1-debuginfo-4.4.38-1.1.x86_64
Missing separate debuginfos, use: zypper install libpq5-debuginfo-17.4-1.1.x86_64
Missing separate debuginfos, use: zypper install libopenssl3-x86-64-v3-debuginfo-3.2.4-1.1.x86_64
Missing separate debuginfos, use: zypper install krb5-debuginfo-1.21.3-2.1.x86_64
Missing separate debuginfos, use: zypper install libldap2-debuginfo-2.6.8-2.2.x86_64
Missing separate debuginfos, use: zypper install libz-ng-compat1-debuginfo-2.2.3-1.1.x86_64
Missing separate debuginfos, use: zypper install libjitterentropy3-debuginfo-3.4.1-4.3.x86_64
Missing separate debuginfos, use: zypper install libcom_err2-debuginfo-1.47.0-4.4.x86_64
Missing separate debuginfos, use: zypper install libsasl2-3-debuginfo-2.1.28-9.2.x86_64
Missing separate debuginfos, use: zypper install libkeyutils1-debuginfo-1.6.3-7.3.x86_64
Missing separate debuginfos, use: zypper install libselinux1-debuginfo-3.8-2.1.x86_64
Missing separate debuginfos, use: zypper install libpcre2-8-0-debuginfo-10.44-1.2.x86_64
(gdb) bt full
#0  XS_DBI_dispatch (cv=0x5555558dce28) at /home/larsd/.cache/cpanm/work/1741862763.21292/DBI-1.647/DBI.xs:3362
        sp = 0x555555617558
        ax = 1
        mark = 0x555555617550
        items = 1
        origmark = 0
        h = 0x5555559ac1f8
        st1 = 0x5555558dce28
        st2 = 0x5555559ac8e8
        orig_h = 0x5555559ac1f8
        err_sv = <optimized out>
        tmp_svp = <optimized out>
        hook_svp = 0x0
        mg = <optimized out>
        gimme = 1
        trace_flags = 0
        trace_level = 0
        is_DESTROY = 1
        meth_type = methtype_DESTROY
        is_unrelated_to_Statement = 0
        keep_error = 1
        ErrCount = 18446744073709551615
        i = <optimized out>
        outitems = <optimized out>
        call_depth = <optimized out>
        is_nested_call = <optimized out>
        profile_t1 = 0
        is_orig_method_name = 1
        meth_name = 0x555555581340 "DESTROY"
        ima = 0x5555558df7a0
        ima_flags = 65540
        imp_xxh = 0x555555a03110
        imp_msv = 0x0
--Type <RET> for more, q to quit, c to continue without paging--c
        qsv = 0x0
        buf = <optimized out>
        avi = <optimized out>
        p = <optimized out>
        s = <optimized out>
        agg = <optimized out>
        p_ = <optimized out>
#1  0x00007ffff7d10cfd in Perl_rpp_invoke_xs (cv=0x5555558dce28)
    at /home/larsd/.local/share/perlbrew/build/perl-5.40.1/perl-5.40.1/inline.h:1193
No locals.
#2  Perl_pp_entersub () at pp_hot.c:6495
        markix = 0
        is_scalar = false
        gv = 0x5555559bc0d8
        cv = 0x5555558dce28
        cx = <optimized out>
        old_savestack_ix = <optimized out>
        sv = 0x5555558dce28
        do_ref = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
#3  0x00007ffff7d945f3 in Perl_runops_standard () at run.c:41
        op = <optimized out>
#4  0x00007ffff7c72c6b in Perl_call_sv (sv=<optimized out>, arg_flags=arg_flags@entry=45) at perl.c:3216
        old_cxix = -1
        p_ = <optimized out>
        myop = {op_next = 0x0, op_sibparent = 0x0, op_ppaddr = 0x7ffff7d10aa0 <Perl_pp_entersub>, op_targ = 0, op_type = 187, 
          op_opt = 0, op_slabbed = 0, op_savefree = 0, op_static = 0, op_folded = 0, op_moresib = 0, op_spare = 0, 
          op_flags = 65 'A', op_private = 0 '\000', op_first = 0x0, op_other = 0x7fffffffc900}
        method_op = {op_next = 0x5555559bc648, op_sibparent = 0x5555559bc150, op_ppaddr = 0x0, op_targ = 140737350638266, 
          op_type = 304, op_opt = 1, op_slabbed = 0, op_savefree = 0, op_static = 0, op_folded = 0, op_moresib = 1, op_spare = 1, 
          op_flags = 155 '\233', op_private = 85 'U', op_u = {op_first = 0x5555556b9fd0, op_meth_sv = 0x5555556b9fd0}, 
          op_rclass_sv = 0x555500000020}
        oldmark = 0
        retval = 0
        oldcatch = true
        ret = <optimized out>
        oldop = 0x0
        flags = 45
        cur_env = {je_prev = 0x7ffff7fb3500 <PL_start_env>, je_buf = {{__jmpbuf = {140737353824392, -6856996284238243355, 1, 0, 
                93824996786680, 140737353522696, -6856996284179523099, -6856978628723713563}, __mask_was_saved = 0, __saved_mask = {
                __val = {13816973012072644575, 140737353522696, 93824995938000, 93824995948912, 0, 93824995948912, 93824994656816, 
                  140737350608258, 0, 1821615850, 0, 93824994576240, 42949672960, 18446744069414584320, 0, 93824994656888}}}}, 
          je_ret = 0, je_mustcatch = false, je_old_delaymagic = 0, je_old_stack_hwm = 7}
#5  0x00007ffff7d9a1f6 in S_curse (sv=sv@entry=0x5555559ac4b0, check_refcnt=check_refcnt@entry=true) at sv.c:7213
        tmpref = 0x5555559ac1f8
        p_ = <optimized out>
        p_ = <optimized out>
        destructor = <optimized out>
        meta = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        sp = <optimized out>
        stash = <optimized out>
#6  0x00007ffff7d9a96d in Perl_sv_clear (orig_sv=orig_sv@entry=0x5555559ac4b0) at sv.c:6753
        stash = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        type = 12
        iter_sv = 0x0
        next_sv = 0x0
        sv = 0x5555559ac4b0
        hash_index = 0
#7  0x00007ffff7d9afdf in Perl_sv_free2 (sv=0x5555559ac4b0, rc=<optimized out>) at sv.c:7314
No locals.
#8  0x00007ffff7d9b775 in Perl_SvREFCNT_dec_NN (sv=<optimized out>)
    at /home/larsd/.local/share/perlbrew/build/perl-5.40.1/perl-5.40.1/sv_inline.h:730
        rc = <optimized out>
        rc = <optimized out>
#9  do_clean_objs (ref=0x5555559ac4c8) at sv.c:451
        target = <optimized out>
        p_ = <optimized out>
#10 S_visit (f=<optimized out>, flags=2048, mask=2048) at sv.c:394
        svend = 0x5555559acfc0
        sv = 0x5555559ac4c8
        sva = 0x5555559abfd0
        visited = <optimized out>
        sva = <optimized out>
        visited = <optimized out>
        svend = <optimized out>
        sv = <optimized out>
        p_ = <optimized out>
#11 Perl_sv_clean_objs () at sv.c:545
        olddef = <optimized out>
        olderr = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
#12 0x00007ffff7c760e0 in perl_destruct (my_perl=<optimized out>) at perl.c:927
        destruct_level = 0 '\000'
        hv = <optimized out>
        i = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
        p_ = <optimized out>
#13 0x000055555555520c in main (argc=<optimized out>, argv=<optimized out>, env=<optimized out>) at perlmain.c:137
        exitstatus = <optimized out>
        i = <optimized out>

---

❯ perl -V
Summary of my perl5 (revision 5 version 40 subversion 1) configuration:
   
  Platform:
    osname=linux
    osvers=6.12.9-1-default
    archname=x86_64-linux-ld
    uname='linux denkheft 6.12.9-1-default #1 smp preempt_dynamic fri jan 10 08:30:10 utc 2025 (0ae2136) x86_64 x86_64 x86_64 gnulinux '
    config_args='-de -Dprefix=/home/larsd/.local/share/perlbrew/perls/perl-5.40.1 -Dusedevel -Duseshrplib -Dman1dir=none -Dman3dir=none -Dcf_email=root@localhost -Dperladmin=root@localhost -Dusemorebits -Dusesitecustomize -Accflags=-DNO_TAINT_SUPPORT -Accflags=-march=native -Accflags=-fPIC -Accflags=-DPERL_DISABLE_PMC -Accflags=-ggdb -Aeval:scriptdir=/home/larsd/.local/share/perlbrew/perls/perl-5.40.1/bin'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=undef
    usemultiplicity=undef
    use64bitint=define
    use64bitall=define
    uselongdouble=define
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='cc'
    ccflags ='-DNO_TAINT_SUPPORT -march=native -fPIC -DPERL_DISABLE_PMC -ggdb -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-O2'
    cppflags='-DNO_TAINT_SUPPORT -march=native -fPIC -DPERL_DISABLE_PMC -ggdb -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='14.2.1 20241007 [revision 4af44f2cf7d281f3e4f3957efce10e8b2ccb2ad3]'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='long double'
    nvsize=16
    Off_t='off_t'
    lseeksize=8
    alignbytes=16
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /usr/lib /lib64 /usr/lib64 /usr/local/lib64
    libs=-lpthread -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat
    perllibs=-lpthread -ldl -lm -lcrypt -lutil -lc
    libc=/lib/../lib64/libc.so.6
    so=so
    useshrplib=true
    libperl=libperl.so
    gnulibc_version='2.40'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E -Wl,-rpath,/home/larsd/.local/share/perlbrew/perls/perl-5.40.1/lib/5.40.1/x86_64-linux-ld/CORE'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'


Characteristics of this binary (from libperl): 
  Compile-time options:
    HAS_LONG_DOUBLE
    HAS_STRTOLD
    HAS_TIMES
    NO_TAINT_SUPPORT
    PERLIO_LAYERS
    PERL_COPY_ON_WRITE
    PERL_DISABLE_PMC
    PERL_DONT_CREATE_GVSV
    PERL_HASH_FUNC_SIPHASH13
    PERL_HASH_USE_SBOX32
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    PERL_USE_DEVEL
    PERL_USE_SAFE_PUTENV
    USE_64_BIT_ALL
    USE_64_BIT_INT
    USE_LARGE_FILES
    USE_LOCALE
    USE_LOCALE_COLLATE
    USE_LOCALE_CTYPE
    USE_LOCALE_NUMERIC
    USE_LOCALE_TIME
    USE_LONG_DOUBLE
    USE_PERLIO
    USE_PERL_ATOF
    USE_SITECUSTOMIZE
  Built under linux
  Compiled at Feb 20 2025 14:06:26
  %ENV:
    PERLBREW_HOME="/home/larsd/.local/share/perlbrew"
    PERLBREW_MANPATH="/home/larsd/.local/share/perlbrew/perls/perl-5.40.1/man"
    PERLBREW_PATH="/home/larsd/.local/share/perlbrew/bin:/home/larsd/.local/share/perlbrew/perls/perl-5.40.1/bin"
    PERLBREW_PERL="perl-5.40.1"
    PERLBREW_ROOT="/home/larsd/.local/share/perlbrew"
    PERLBREW_SHELLRC_VERSION="0.98"
    PERLBREW_VERSION="0.98"
    PERLCRITIC="/home/larsd/.config/perlcriticrc"
    PERLREPL_HISTFILE="/home/larsd/.local/state/perlreplhist"
    PERLTIDY="/home/larsd/.config/perltidyrc"
    PERL_CPANM_HOME="/home/larsd/.cache/cpanm"
    PERL_CPANM_OPT="-M https://cpan.metacpan.org/ --verify --with-recommends --with-suggests --with-develop --with-all-features"
    PERL_EXTUTILS_AUTOINSTALL="--default-deps"
    PERL_MM_NONINTERACTIVE="1"
    PERL_MM_USE_DEFAULT="1"
  @INC:
    /home/larsd/.local/share/perlbrew/perls/perl-5.40.1/lib/site_perl/5.40.1/x86_64-linux-ld
    /home/larsd/.local/share/perlbrew/perls/perl-5.40.1/lib/site_perl/5.40.1
    /home/larsd/.local/share/perlbrew/perls/perl-5.40.1/lib/5.40.1/x86_64-linux-ld
    /home/larsd/.local/share/perlbrew/perls/perl-5.40.1/lib/5.40.1

[Tux]

I just finished rebuilding my complete perl tree on openSUSE TumbleWeed, and I cannot reproduce your core dump. Might well be releated to Leap-15.2

Summary of my perl5 (revision 5 version 40 subversion 1) configuration:

  Platform:
    osname=linux
    osvers=6.13.6-1-default
    archname=x86_64-linux-thread-multi-quadmath
    uname='linux lx09 6.13.6-1-default #1 smp preempt_dynamic mon mar 10 08:49:24 utc 2025 (495d82a) x86_64 x86_64 x86_64 gnulinux '
    config_args='-Duse64bitall -Dusequadmath -Dusethreads -Duseithreads -Duseshrplib -Uversiononly -Dinc_version_list=none -Dextras='V\ Test::Warnings' -des'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
  Compiler:
    cc='cc'
    ccflags ='-D_REENTRANT -D_GNU_SOURCE -pie -fPIE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2'
    optimize='-O2'
    cppflags='-D_REENTRANT -D_GNU_SOURCE -pie -fPIE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include'
    ccversion=''
    gccversion='14.2.1 20250220 [revision 9ffecde121af883b60bbe60d00425036bc873048]'
:
:
  Linker and Libraries:
    ld='cc'
    ldflags ='-L/pro/local/lib -fstack-protector-strong'
    libpth=/usr/local/lib /usr/x86_64-suse-linux/lib /usr/lib /pro/local/lib /usr/lib64 /usr/local/lib64
    libs=-lpthread -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat -lquadmath
    perllibs=-lpthread -ldl -lm -lcrypt -lutil -lc -lquadmath
    libc=/lib/../lib64/libc.so.6
    so=so
    useshrplib=true
    libperl=libperl.so
    gnulibc_version='2.41'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E -Wl,-rpath,/pro/lib/perl5/5.40.1/x86_64-linux-thread-multi-quadmath/CORE'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector-strong'

DBI 🐧 perl -MConfig::Perl::V=summary -MData::Peek -wE'DDumper (summary)'
{   HAS_LONG_DOUBLE  => 1,
    HAS_STRTOLD      => 1,
    HAS_TIMES        => 1,
    MULTIPLICITY     => 1,
    PERLIO_LAYERS    => 1,
    PERL_COPY_ON_WRITE => 1,
    PERL_DONT_CREATE_GVSV => 1,
    PERL_HASH_FUNC_SIPHASH13 => 1,
    PERL_HASH_USE_SBOX32 => 1,
    PERL_MALLOC_WRAP => 1,
    PERL_OP_PARENT   => 1,
    PERL_PRESERVE_IVUV => 1,
    PERL_USE_SAFE_PUTENV => 1,
    USE_64_BIT_ALL   => 1,
    USE_64_BIT_INT   => 1,
    USE_ITHREADS     => 1,
    USE_LARGE_FILES  => 1,
    USE_LOCALE       => 1,
    USE_LOCALE_COLLATE => 1,
    USE_LOCALE_CTYPE => 1,
    USE_LOCALE_NUMERIC => 1,
    USE_LOCALE_TIME  => 1,
    USE_PERLIO       => 1,
    USE_PERL_ATOF    => 1,
    USE_QUADMATH     => 1,
    USE_REENTRANT_API => 1,
    USE_THREAD_SAFE_LOCALE => 1,
    archname         => 'x86_64-linux-thread-multi-quadmath',
    cc               => 'cc',
    ccversion        => '',
    config_args      => '-Duse64bitall -Dusequadmath -Dusethreads -Duseithreads -Duseshrplib -Uversiononly -Dinc_version_list=none -Dextras=\'V\\ Test::Warnings\' -des',
    d_longdbl        => 'define',
    d_longlong       => 'define',
    default_inc_excludes_dot => 'define',
    doublesize       => '8',
    gccversion       => '14.2.1 20250220 [revision 9ffecde121af883b60bbe60d00425036bc873048]',
    inc_version_list => ' ',
    intsize          => '4',
    ivsize           => '8',
    longdblsize      => '16',
    longlongsize     => '8',
    lseeksize        => '8',
    nvsize           => '16',
    osname           => 'linux',
    osvers           => '6.13.6-1-default',
    patchlevel       => '40',
    revision         => '5',
    subversion       => '1',
    use64bitall      => 'define',
    use64bitint      => 'define',
    useithreads      => 'define',
    uselongdouble    => 'undef',
    usemultiplicity  => 'define',
    usemymalloc      => 'n',
    useperlio        => 'define',
    useshrplib       => 'true',
    version          => '5.40.1'
    }

DBI 🐧 perl -Mblib -mDBI -MClone=clone -E'clone(DBI->connect("dbi:Pg:host=localhost"))'
DBI 🐧

DBI 🐧 perl -d:TraceUse=hidecore -Mblib -mDBI -MClone=clone -E'clone(DBI->connect("dbi:Pg:host=localhost"))'
Modules used from -e:
  11.  DBI 1.648, -e line 0 [main]
  24.    DBD::Pg 3.18.0, DBI.pm line 795 (eval 5) [DBI::_firesafe]
  26.      version::vxs 0.9933, version.pm line 18 (eval 6)
  20.  Clone 0.47, -e line 0 [main]
Possible proxies:
   5 -e line 0, sub main::BEGIN

[daxim]

I have prepared a repro environment for you. Obtain Containerfile from https://gist.github.com/daxim/c4671438127e6ee3cd570e5b01cee7bd

build image (result < 2 GB)

yourhost:> podman build -t dbi-170 -f Containerfile

run image as container and enter a shell

yourhost:> podman run -it dbi-170 bash
container:# /etc/init.d/postgresql restart
container:# gdb --args perl5.40.1 -mDBI -MClone=clone -E'clone(DBI->connect("dbi:Pg:host=localhost", "postgres"))'

[Tux]

🐧 podman build -t dbi-170 -f Containerfile
STEP 1/6: FROM debian:12
Resolved "debian" as an alias (/etc/containers/registries.conf.d/000-shortnames.conf)
Trying to pull docker.io/library/debian:12...
Getting image source signatures
Copying blob 7cd785773db4 done   |
Error: creating build container: copying system image from manifest list: writing blob: adding layer with blob "sha256:7cd785773db44407e20a679ce5439222e505475eed5b99f1910eb2cda51729ab": processing tar file(potentially insufficient UIDs or GIDs available in user namespace (requested 0:42 for /etc/gshadow): Check /etc/subuid and /etc/subgid if configured locally and run "podman system migrate": lchown /etc/gshadow: invalid argument): exit status 1

(Never used podman before, forgive my ignorance)
I'll be unavailable for the next week, sorry again

[daxim]

potentially insufficient UIDs or GIDs available in user namespace […] Check /etc/subuid and /etc/subgid if configured locally and run "podman system migrate"

https://github.com/containers/podman/blob/main/docs/tutorials/rootless_tutorial.md#etcsubuid-and-etcsubgid-configuration

I'll be unavailable

No worries, enjoy your time off.

[Tux]

I can reproduce a crash on openSUSE-Tumbleweed with perl-5.40.2-RC1 + DBI-1.648. Do you think this is the same cause?

🐧 ux
lx09  Linux 6.13.8-1-default [openSUSE Tumbleweed 20250329]  HP ZBook Power15.6inchG10AMobileWorkstationPC AMD Ryzen 9 7940HS w/ Radeon 780M Graphics (AuthenticAMD 1097MHz)(16 cores) x86_64  62057 Mb

🐧 perl5.40.2 -v | grep ^This
This is perl 5, version 40, subversion 2 (v5.40.2) built for x86_64-linux

🐧 perl5.40.2 -MV=DBI,DBD::Pg
DBI
        /media/Tux/perls/lib/site_perl/5.40.2/x86_64-linux/DBI.pm: 1.647
DBD::Pg
        /media/Tux/perls/lib/site_perl/5.40.2/x86_64-linux/DBD/Pg.pm: 3.18.0

🐧 gdb --args perl5.40.2 -mDBI -MClone=clone -E'clone (DBI->connect ("dbi:Pg:host=localhost", "postgres"))'
:
:
(gdb) run
Starting program: /media/Tux-EF/perls/bin/perl5.40.2 -mDBI -MClone=clone -Eclone\ \(DBI-\>connect\ \(\"dbi:Pg:host=localhost\",\ \"postgres\"\)\)

This GDB supports auto-downloading debuginfo from the following URLs:
  <https://debuginfod.opensuse.org/>
Enable debuginfod for this session? (y or [n])
Debuginfod has been disabled.
To make this setting permanent, add 'set debuginfod enabled off' to .gdbinit.
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".

Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7e2fce0 in XS_DBI_dispatch ()
   from /media/Tux/perls/lib/site_perl/5.40.2/x86_64-linux/auto/DBI/DBI.so
(gdb) where
#0  0x00007ffff7e2fce0 in XS_DBI_dispatch ()
   from /media/Tux/perls/lib/site_perl/5.40.2/x86_64-linux/auto/DBI/DBI.so
#1  0x000000000054f350 in Perl_pp_entersub ()
#2  0x00000000004b250a in Perl_runops_debug ()
#3  0x00000000004944e4 in Perl_call_sv ()
#4  0x00000000005f72f4 in S_curse ()
#5  0x00000000005f7b0a in Perl_sv_clear ()
#6  0x00000000005f8868 in Perl_sv_free2 ()
#7  0x00000000005f920b in Perl_sv_clean_objs ()
#8  0x000000000049858c in perl_destruct ()
#9  0x000000000046e6ec in main ()

[Tux]

I built a -DDEBUGGING -g DBI-1.648

(gdb) where
#0  0x00007ffff7b5b5a8 in Perl_SvIV (sv=0x21) at /media/Tux/perls/lib/5.41.10/x86_64-linux/CORE/sv_inline.h:821
#1  0x00007ffff7b73fe0 in XS_DBI_dispatch (cv=0xb4c9c8) at /pro/3gl/CPAN/DBI/DBI.xs:3362
#2  0x00000000005539a1 in Perl_pp_entersub ()
#3  0x00000000004b505a in Perl_runops_debug ()

Ok!. sv=0x21 doesn't seem ok. That is a call from

    if ((i = DBIc_DEBUGIV (imp_xxh))) { /* merge handle into global */

which expands to

    if ((i = Perl_SvIV ((((imp_xxh)->com.attr.TraceLevel))))) {

from `DBIXS.h

#define DBIc_DEBUGIV(imp)       SvIV(DBIc_DEBUG(imp))            /* deprecated */

There is just two calls with that, so very limited. I've got work to do …

[Leont]

Type imp_xxh_t uses the T_PTROBJ typemap. Essentially this means that the pointer converted to an integer, and then that's stored in a reference to a scalar.

So if you clone that reference to a scalar, you will end up with two objects pointing to the same C struct. This will lead to a double destruction and/or use after destruction, which can easily cause all sorts of issues.

A T_PTROBJ object is generally not safely clonable, and I don't think that can be reasonably fixed. Though one could use a typemap template that fails more gracefully than a segfault.

[Tux]

Thanks for the explanation, but that is way beyond my comfort zone. If you say it is hard to fix, who am I to say it can be done :(

[bulk88]

Random concerns in this crashing XSUB, I didnt run any code.

dbi/DBI.xs

Line 3212 in b60d376

const char *meth_name = GvNAME(CvGV(cv));

CvGV(cv) has a getter or vivifier fn call. don't multi eval it. split it out from GvNAME() to its own 1x evaled statement/expression.

dbi/DBI.xs

Line 3220 in b60d376

#ifdef BROKEN_DUP_ANY_PTR

huh? ithread/psuedofork clone time happened long long ago. #ifdef BROKEN_DUP_ANY_PTR even if this is "a fix" for a real bug looks like the worst workaround possible, of a group of multiple workarounds. is there even a real p5p bug in old perls? fn ptrs 6/7/8 in the vtable struct in a MAGIC * struct attached to the CV* should handle 100% of cases of a ithread clone event.

dbi/DBI.xs

Line 3225 in b60d376

*nima = *ima; /* structure copy */

dbi/DBI.xs

Line 3213 in b60d376

dbi_ima_t *ima = (dbi_ima_t*)CvXSUBANY(cv).any_ptr;

How do we know at this point, long after the clone, that the malloc or arena pointer from parent ithread wasn't freed, and still is alloced/has valid bytes/and is de-refable address space? parent ithread and its my_perl and 100% of its malloc blocks could be freed/dtored by now.

dbi/DBI.xs

Line 1291 in b60d376

imp_size = SvIV(get_sv(imp_size_name, 0x05));

no multi eval of fn calls plz

dbi/DBI.xs

Line 1685 in b60d376

if (DBIc_THR_USER(imp_xxh) != my_perl) { /* don't clear handle that belongs to another thread */

No, you will race condition or SEGV or have impossible to repro bugs when using a C debugger or using real metal hardware (your personal laptop/desktop). and bug only happens in production servers on cloud hoster VMs. This code is doing something dangerous because I don't see AnyOS AnyIsoC mutex locking or non atomic ref counts or atomic ops here.

DBIc_TRACE_LEVEL
https://github.com/perl5-dbi/dbi/blob/b60d376c4ca036b10e72b6d7f03fe0a52d94db2d/DBI.xs#L1678C36-L1678C51

10% chance these 2 lines are safe but sloppy after disassembly/.i/single stepping, 90% chance DBIc_TRACE_LEVEL/DBIc_PARENT_COM will execute or deref garbage or fetch garbage from OS TLS, before the anti-segv check
if (DBIc_THR_USER(imp_xxh) != my_perl) { is reached.

dbi/DBI.xs

Line 1684 in b60d376

#ifdef DBI_USE_THREADS

dbi/DBI.xs

Line 3343 in b60d376

if (h_perl != my_perl) {

If I am correct in what this code is protecting against, which is accidental launching by a 3P non perl aware C library of "your Perl aware C callback fn ptrs", inside the thread pool of that 3P non perl aware C library. Atleast on Windows/WinPerl doing it this way is as futile as calling 911/112 to resuscitate the roasted turkey or roasted chicken on your family dining room table.

        if (debug >= 3) {
            PerlIO_printf(DBIc_LOGPIO(imp_xxh),"    skipped dbih_clearcom: DBI handle (type=%d, %s) is owned by thread %p not current thread %p\n",
                  DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ;
            PerlIO_flush(DBIc_LOGPIO(imp_xxh));

This will never move 1 byte of diag/debug info to any other API. Left side my_perl or right side my_perl or both my_perl ptrs are uninit memory/unmapped memory, because there is no proper valid correct my_perl ptr stored in the OS's TLS system for this OS TID, so dTHX will be returning a random integer. And who knows at this point the history and status of the parent/older my_perl addr.

Must use pure libc, zero Perl C APIs, to output/log/report/fatal error-out an accidental thread pool C fn ptr callback mistake.

dbi/DBI.xs

Line 3276 in b60d376

#ifdef DBI_USE_THREADS

10% chance doing this safety check so far down and so later in this XSUB is safe after through .i/.S/disassembly research, 90% chance this safety check is pointless doing it so late and the crash/bad de-ref already happened earlier in the XSUB.

dbi/DBI.xs

Line 3258 in b60d376

&& SvRMAGICAL(SvRV(h))

dbi/DBI.xs

Line 3264 in b60d376

if (mg->mg_obj==NULL || !SvOK(mg->mg_obj) || SvRV(mg->mg_obj)==NULL) { /* maybe global destruction */

Clean code nitpick, not a bug, Dont write SvRV(h) and mg->mg_obj 20x in a row, each is a ptr deref each time you write it. 50% of the time, the CC can't de-dup and optimize out all those duplicate derefs with -O1/-O2 bc you have extern C fn calls sitting in between which can rewrite "the whole world" per normal C lang rules. Plz save/cache them to C auto vars. Easy fix.

If you are worried about random/unknown realloc()s happening, like SvUPGRADE() or SvGROW() or Renew(), sorry you aren't qualified to touch the code since you don't know what any of the identifiers/tokens do. Study it more and single step it with -Od -O0 until you are as confident as the original dev who wrote it.

dbi/DBI.xs

Line 3299 in b60d376

/* However, we must at least modify DBIc_MY_H() as that is */

Not fully thought out. This doesn't look the typical Perl C or PP fix for Perl 5's randomized order global destruction problem. Random Global Dtor problem is solved with rv_weaken() tricks, and each inner child object keeps an array of weakrefs to ALL outer container objects that point to the inner child object.

Either an outer container obj gets a DESTROY call, RC-- the child obj and then the interp naturally autmatically RC-- nukes the outer parent.

Or the inner child object gets a DESTROY call, and RC--'es or explictly calls ->DESTROY(), or ->_DESTROY() or ->DESTROY(1);` on ALL outer container objects pointing to it, turning all outer container objects into Javascript style Dtor-ed zombie object instances, that will never ever again do anything useful or ever "succeed" if you interact with a dtor-ed Javascript zombie object instance.

dbi/DBI.xs

Line 3314 in b60d376

const char *can_meth = SvPV_nolen(st1);

Plz use SV*s and Perl_foov_fetchsv() style API calls, not const char * and strlen() and Perl_foov_fetchpv() APIs. Its not 1970 anymore. ISO C was never migrated to the JVM or C++ VM to magically gain secret length tracking for const char * objects.

dbi/DBI.xs

Line 3354 in b60d376

croak("%s %s failed: handle %d is owned by thread %lx not current thread %lx (%s)",

(unsigned long)h_perl is wrong, %p and size_t or use Perl C dedicated macros to print a pointer sized number in hex to console. (unsigned long)h_perl generates a useless misleading truncated 32 bit integer on Win64. Don't use Perl C's UV type or IV type either to print a pointer. a UV/IV is often 2 * sizeof(void *) or 4 * sizeof(void *). Types UV/IV can always safely STORE a size_t/void *, for transport purposes, but they themselves ARE NOT typedefs of size_t/ssize_t, and remember you always need to write to code, or let C lang implicitly, chop off the high bytes created through zero extend or sign extend from void * to type 'UV/IVbefore using thatvoid *` again. Don't write C code that will only execute correctly on exactly 1 unique SHA1 of an Ubuntu .iso file.

dbi/DBI.xs

Line 3403 in b60d376

if (!SvPOK(meth_name_sv) || SvNIOK(meth_name_sv))

Decide around line 3404 if you are SV GMG aware or not GMG aware. Don't check raw SV flags, then execute the MG aware SvPV***() macro. And if I will be academic, who knows what the SV PIUNROK flags will be AFTER SvPV***() executes unless you used a SvPV_force****() variant but remember SvPV_force****() is anti-COW, and more chance of being runtime fatal than plain old SvPV***() or more proper SvPV_const***() .

dbi/DBI.xs

Line 3453 in b60d376

if (SvTAINTED(ST(i))) {

ST(i) is inefficient b/c it regenerates the abs addr redundantly and re-reads the world. PL_stack_base wont be moving in this loop.

dbi/DBI.xs

Line 3454 in b60d376

char buf[100];

100 bytes fixed len buffer? egh, its good enough in real life, but dont write it that way in greenfield code, use snprintf() or alloca() or sv_cat***() APIs for cleanlyness or put string precision byte limits into the fmt string.

dbi/DBI.xs

Line 3467 in b60d376

if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {

if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {

hv_fetchs() plz, I dont wanna trust you counted 12 letters in your IDE by hand, 1 out of 50 times you will make a mistake.

dbi/DBI.xs

Line 3485 in b60d376

XPUSHs(*hp);

factor X in XPUSH to outside of for loop

dbi/DBI.xs

Line 721 in b60d376

SV *tmp_sv = *hv_fetch((HV*)SvRV(h), "Statement", 9, 1);

hv_fetch_ent hv_store_ent SVPV holding a HEK* COW PVX buffer plz

dbi/DBI.xs

Line 3547 in b60d376

SvTRUE(err_sv) ? "ERROR" : strlen(SvPV_nolen(err_sv)) ? "warn" : "info",

SvCUR() == 0 is PP true? Why strlen instead of SvPV's arg 2? embedded null chars hazard / exploit here? Pick SvTRUE_NN or pick SvPV.

dbi/DBI.xs

Line 3560 in b60d376

&& ( (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), meth_name, strlen(meth_name), 0))

GvNAMELEN(gv) plz

dbi/DBI.xs

Line 3654 in b60d376

( (kl==6 && DBIc_TYPE(imp_xxh)==DBIt_DB && strEQ(key,"Driver"))

memEQs plz strEQ is an extern C func call into libc.so.dll that does 2 strlen()s each time, memEQs optimizes to 1-3 unaligned integer comparison CPU opcodes if the CC wants to (i386/amd64).

dbi/DBI.xs

Line 3691 in b60d376

if (is_orig_method_name

        if (is_orig_method_name
            && ima->stash == DBIc_IMP_STASH(imp_xxh)
            && ima->generation == PL_sub_generation +
                                        MY_cache_gen(DBIc_IMP_STASH(imp_xxh))

Isn't this undocument/non-public API? I have no problems doing stuff like this for my private day job XS code, since I compile and deploy my own perl.exe/libperl.dll'es, but this is very sketchy, if your talking about future proofing against future P5P stable releases and back compat with old/historic stable perls on CPAN.

dbi/DBI.xs

Line 3722 in b60d376

PUSHs(sv_2mortal(newSVpv(meth_name,0)));

The authority master source of this value is a GvNAME's HEK*, use newSVhek() plz, or keep in $self or in MY_CXT a SvREADONLY_on() SVPV POK_on copy/cache/snapshot created copy of the original GvNAME HEK* that provided the ascii str value. dont strlen unneeded.

dbi/DBI.xs

Line 3785 in b60d376

(void)(*CvXSUB(meth_cv))(aTHXo_ meth_cv); /* Call the C code directly */

💕

dbi/DBI.xs

Line 3927 in b60d376

XPUSHs(h);

EXTEND not 3 x XPUSH

dbi/DBI.xs

Line 3928 in b60d376

XPUSHs(sv_2mortal(newSVpv("AutoCommit",0)));

no strlen, does child sub really need a unique SV* each time? will the child really assign to its $_[1]? Atleast keep the master template in a SVPVHEK* COW or a RC++ed HEK* in MY_CXT and make each unique SV* POK "AutoCommit" from the COW-able master copy in MY_CXT.

dbi/DBI.xs

Line 3931 in b60d376

call_method("STORE", G_VOID);

SvPV HEK* COW holding string "STORE" and call_sv(,G_METHOD or G_METH_NAMED) plz

dbi/DBI.xs

Line 3990 in b60d376

if ( !keep_error /* is a new err/warn/info */

SvTRUE(err_sv) SvOK(err_sv) strlen(SvPV_nolen(err_sv)) is_warning = (!SvTRUE(err_sv) && strlen(SvPV_nolen(err_sv))==1);

pick 1 style, don't repeat same huge macros and getter fn calls over and over

https://github.com/perl5-dbi/dbi/blob/b60d376c4ca036b10e72b6d7f03fe0a52d94db2d/DBI.xs#L4051C63-L4051C72

Good, code was disabled/comment out. CopFILEGV(cop) != CopFILEGV(PL_curcop) is a very expensive in CPU time and permanent rest of process lifetime malloc bytes vivifier/synthsis getter function on threaded Perl. On unthreaded perl (obsolete) CopFILEGV() is 2-3 lighting fast pointer derefs.

dbi/DBI.xs

Line 4084 in b60d376

XPUSHs(msg);

dont 3 x X, do 1 EXTEND

dbi/DBI.xs

Line 4090 in b60d376

status = (items) ? POPs : &PL_sv_undef;

doesnt perl api guarentee 1 element if you pass G_SCALAR? call_sv and pp_entersub WILL CORRECT the stack for you to 1 element, possible undef, if the child SUB didn't voluntarily return 1 element.

dbi/DBI.xs

Line 4126 in b60d376

XSRETURN(outitems);

Phew 900 lines of src code I just looked at, sigh.

End of this message.

[mohawk2]

@bulk88 It seems to me like there are easy(ish) fixes you can make to the code right now to resolve some of the points above, and that would make the codebase a bit better.

Separately, do you have any insight into the immediate crashes?