Segfault on warnings when using the value of a hash with undefined value specified as the key

[choroba]

Module:

Description

Perl crashes with a segfault when a variable with undefined value is used as a hash key and the hash doesn't have a value associated to the empty string, and the resulting undefined value is used in an expression under warnings. An example probably explains it better:

Steps to Reproduce

The following line is enough:

perl -we '-$a{$b}'

It outputs:

Useless use of negation (-) in void context at -e line 1.
Name "main::a" used only once: possible typo at -e line 1.
Use of uninitialized value $b in hash element at -e line 1.
Segmentation fault (core dumped)

Interestingly, without warnings the segfault doesn't happen.

Expected behavior

The segfault shouldn't happen.

Perl configuration

# perl -V output goes here
Summary of my perl5 (revision 5 version 33 subversion 9) configuration:
  Commit id: 6c6de3559b93537c4caaa96be7e461b4cfdfbd94
  Platform:
    osname=linux
    osvers=5.3.18-lp152.72-default
    archname=x86_64-linux-thread-multi
    uname='linux triangle 5.3.18-lp152.72-default #1 smp wed apr 14 10:13:15 utc 2021 (013936d) x86_64 x86_64 x86_64 gnulinux '
    config_args='-Dusethreads -Dprefix=/home/choroba/localperl -Dusedevel -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 -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='-D_REENTRANT -D_GNU_SOURCE -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/usr/local/include'
    ccversion=''
    gccversion='7.5.0'
    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='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='cc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/x86_64-suse-linux/lib /usr/lib /lib64 /usr/lib64 /lib /usr/local/lib64
    libs=-lpthread -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.26.so
    so=so
    useshrplib=false
    libperl=libperl.a
    gnulibc_version='2.26'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -O2 -L/usr/local/lib -fstack-protector-strong'


Characteristics of this binary (from libperl): 
  Compile-time options:
    HAS_TIMES
    MULTIPLICITY
    PERLIO_LAYERS
    PERL_COPY_ON_WRITE
    PERL_DONT_CREATE_GVSV
    PERL_IMPLICIT_CONTEXT
    PERL_MALLOC_WRAP
    PERL_OP_PARENT
    PERL_PRESERVE_IVUV
    PERL_USE_DEVEL
    USE_64_BIT_ALL
    USE_64_BIT_INT
    USE_ITHREADS
    USE_LARGE_FILES
    USE_LOCALE
    USE_LOCALE_COLLATE
    USE_LOCALE_CTYPE
    USE_LOCALE_NUMERIC
    USE_LOCALE_TIME
    USE_PERLIO
    USE_PERL_ATOF
    USE_REENTRANT_API
    USE_THREAD_SAFE_LOCALE
  Built under linux
  Compiled at Apr 28 2021 18:53:52
  @INC:
    /home/choroba/localperl/lib/site_perl/5.33.9/x86_64-linux-thread-multi
    /home/choroba/localperl/lib/site_perl/5.33.9
    /home/choroba/localperl/lib/5.33.9/x86_64-linux-thread-multi
    /home/choroba/localperl/lib/5.33.9

[wolfsage]

Looks like it was introduced with:

commit 64ca16b7283dbcc61008c2e621f51f18eb4b5bbb (refs/bisect/bad)
Author: Tony Cook <tony@develop-help.com>
Date:   Mon Jun 1 16:11:50 2020 +1000

    report the index for not found hash/array index lookups in report_uninit()
    
    where the index is a non-magical, non-reference variable.
    
    This only works where the op is converted to OP_MULTIDEREF, but that
    should be happening for the simple cases this handles.
    
    An alternative would be to report the index variable name rather than
    the index, but that seems less useful to me.

[ilmari]

It looks like infinite recursion when it's trying to report Use of uninitialized value $a{$b} in negation (-) at -e line 1.

@tonycoz do you have any insight?

$ gdb -q --args  perl -we '-$x{$y}'
Reading symbols from perl...done.
(gdb) run
Starting program: /home/ilmari/perl5/perlbrew/perls/33.9d/bin/perl -we -\$x\{\$y\}
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
Useless use of negation (-) in void context at -e line 1.
Name "main::x" used only once: possible typo at -e line 1.
Name "main::y" used only once: possible typo at -e line 1.
Use of uninitialized value $y in hash element at -e line 1.

Program received signal SIGSEGV, Segmentation fault.
0x00007ffff7c7ef5a in Perl_sv_2pv_flags (sv=sv@entry=0x555555583d60, lp=lp@entry=0x7fffff7ff0a8, flags=flags@entry=34) at sv.c:3242
3242		if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
(gdb) bt
#0  0x00007ffff7c7ef5a in Perl_sv_2pv_flags (sv=sv@entry=0x555555583d60, lp=lp@entry=0x7fffff7ff0a8, flags=flags@entry=34) at sv.c:3242
#1  0x00007ffff7c43c22 in Perl_hv_common (hv=hv@entry=0x555555583d30, keysv=keysv@entry=0x555555583d60, key=key@entry=0x0, klen=<optimized out>, klen@entry=0, flags=flags@entry=0, action=action@entry=0, val=0x0, hash=0) at hv.c:396
#2  0x00007ffff7c974b5 in S_find_uninit_var (obase=<optimized out>, uninit_sv=<optimized out>, match=<optimized out>, desc_p=0x7fffff7ff190) at sv.c:16785
#3  0x00007ffff7c6a934 in Perl_report_uninit (uninit_sv=uninit_sv@entry=0x555555583d60) at sv.c:17051
#4  0x00007ffff7c7f9b5 in Perl_sv_2pv_flags (sv=sv@entry=0x555555583d60, lp=lp@entry=0x7fffff7ff288, flags=flags@entry=34) at sv.c:3243
#5  0x00007ffff7c43c22 in Perl_hv_common (hv=hv@entry=0x555555583d30, keysv=keysv@entry=0x555555583d60, key=key@entry=0x0, klen=<optimized out>, klen@entry=0, flags=flags@entry=0, action=action@entry=0, val=0x0, hash=0) at hv.c:396
#6  0x00007ffff7c974b5 in S_find_uninit_var (obase=<optimized out>, uninit_sv=<optimized out>, match=<optimized out>, desc_p=0x7fffff7ff370) at sv.c:16785
#7  0x00007ffff7c6a934 in Perl_report_uninit (uninit_sv=uninit_sv@entry=0x555555583d60) at sv.c:17051
#8  0x00007ffff7c7f9b5 in Perl_sv_2pv_flags (sv=sv@entry=0x555555583d60, lp=lp@entry=0x7fffff7ff468, flags=flags@entry=34) at sv.c:3243
#9  0x00007ffff7c43c22 in Perl_hv_common (hv=hv@entry=0x555555583d30, keysv=keysv@entry=0x555555583d60, key=key@entry=0x0, klen=<optimized out>, klen@entry=0, flags=flags@entry=0, action=action@entry=0, val=0x0, hash=0) at hv.c:396
#10 0x00007ffff7c974b5 in S_find_uninit_var (obase=<optimized out>, uninit_sv=<optimized out>, match=<optimized out>, desc_p=0x7fffff7ff550) at sv.c:16785
#11 0x00007ffff7c6a934 in Perl_report_uninit (uninit_sv=uninit_sv@entry=0x555555583d60) at sv.c:17051

[nwc10]

(Thanks for the bug report. Given the nature of the testcase and the result, I'm surprised this didn't get spotted earlier)

This will stop the SEGV:

diff --git a/sv.c b/sv.c
index d20cbf2a85..389af16708 100644
--- a/sv.c
+++ b/sv.c
@@ -16842,7 +16842,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
                 else if (index_gv) {
                     index_sv = GvSV(index_gv);
                 }
-                if (index_sv && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
+                if (index_sv && SvOK(index_sv) && !SvMAGICAL(index_sv) && !SvROK(index_sv)) {
                     if (is_hv) {
                         HE *he = hv_fetch_ent(MUTABLE_HV(sv), index_sv, 0, 0);
                         if (!he) {

$ ./perl -we '-$a{$b}'                                        Useless use of negation (-) in void context at -e line 1.
Name "main::a" used only once: possible typo at -e line 1.
Use of uninitialized value $b in hash element at -e line 1.
Use of uninitialized value within %a in negation (-) at -e line 1.
$ ./perl -we '-$a[$b]'
Useless use of negation (-) in void context at -e line 1.
Name "main::a" used only once: possible typo at -e line 1.
Use of uninitialized value $b in array element at -e line 1.
Use of uninitialized value within @a in negation (-) at -e line 1.

but I don't know if this is the correct fix, or if I've missed some other similar cases that need addressing.

Could someone "not me" take this further, as I have rather too much on currently, that I'm trying to get under control.

[nwc10]

Is the "right" solution to localise warnings to "off" within the reporting code?

I can see how to code round each individual problem, but

1. to do better than my hacky patch in the previous commit we should treat undef as an empty string for the hash lookup, and as 0 for the array lookup, so that we find the correct entry
2. we're at risk from similar bugs elsewhere in the code

but if we simply turn warnings off for the duraction of the reporting, we'll find the correct indexes/keys automatically (because we'll repeat the self-same lookup that triggered the warning), and be robust against similar bugs in the future.

[tonycoz]

Is the "right" solution to localise warnings to "off" within the reporting code?

Maybe. The fix here is pretty simple though.

I could see the current reporting being expanded which might introduce similar errors, eg. right now we report $x{"literal key"} but we might try to report $x{$y} instead.

[mauke]

For better grepability, this is CVE-2022-48522, which was created after the fact.