[perl #123759] tr/// can write on immortals

# New Ticket Created by  Hugo van der Sanden 
# Please include the string:  [perl #123759]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org/Ticket/Display.html?id=123759 >



This is a bug report for perl from hv@crypt.org,
generated with the help of perlbug 1.40 running under perl 5.21.9.


-----------------------------------------------------------------
[Please describe your issue here]

Here's another finding from AFL:

% perl -e '0=~m{}=~y///d'
Segmentation fault (core dumped)
% gdb perl core
[...]
Program received signal SIGSEGV, Segmentation fault.
0x0000000000692682 in S_do_trans_complex (sv=0xa5bc90 <PL_sv_yes>)
    at doop.c:178
178                         *d++ = *s;
(gdb) p d
$1 = (U8 *) 0x82eb24 <PL_Yes+1> ""
(gdb) p s
$2 = (U8 *) 0x82eb23 <PL_Yes> "1"
(gdb) where
#0  0x0000000000692682 in S_do_trans_complex (sv=0xa5bc90 <PL_sv_yes>)
    at doop.c:178
#1  0x0000000000695351 in Perl_do_trans (sv=0xa5bc90 <PL_sv_yes>) at doop.c:661
#2  0x0000000000608372 in Perl_pp_trans () at pp.c:765
#3  0x000000000054514b in Perl_runops_debug () at dump.c:2231
#4  0x000000000046048b in S_run_body (oldscope=1) at perl.c:2423
#5  0x000000000045facf in perl_run (my_perl=0xa5d010) at perl.c:2346
#6  0x000000000041eeb5 in main (argc=2, argv=0x7fffffffe648, 
    env=0x7fffffffe660) at perlmain.c:116

Bisect blames this:

  commit 0d96b528ff0140192b273a677f66f80ee54f3fc4
  Author: Chip Salzenberg <chip@pobox.com>
  Date:   Mon Jul 23 22:40:46 2012 -0700

      Unify code that initializes constants yes, no, and undef

.. but the real problem is that the modified READONLY check in Perl_do_trans
assumes OPpTRANS_IDENTICAL will always take us to S_do_trans_count{,_utf8} -
in this case we also have OPpTRANS_DELETE, so the end up in do_trans_complex
via the default case.

I think the fix is to ensure we do end up at do_trans_count_*(), either
by canonicalizing the other flags when we set OPpTRANS_IDENTICAL or by
fixing the overly tricksy Perl_do_trans case statement to something like:

    if (flags & OPpTRANS_IDENTICAL) {
        return hasutf
            ? do_trans_count_utf8(sv)
            : do_trans_count(sv);
    } else if (flags & (OPpTRANS_SQUASH|OPpTRANS_DELETE|OPpTRANS_COMPLEMENT)) {
        return hasutf
            ? do_trans_complex_utf8(sv)
            : do_trans_complex(sv);
    } else {
        return hasutf
            ? do_trans_simple_utf8(sv)
            : do_trans_simple(sv);
    }

(or maybe both, for extra clarity).

Incidentally, AFL originally found this using nul bytes as the y///
delimiters, are we intentionally supporting that?


[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=high
---
Site configuration information for perl 5.21.9:

Configured by hv at Sat Feb  7 18:19:55 GMT 2015.

Summary of my perl5 (revision 5 version 21 subversion 9) configuration:
  Commit id: 3c47da3c2ebf51f08bb927dfa456939cc6c8c30f
  Platform:
    osname=linux, osvers=3.13.0-37-generic, archname=x86_64-linux
    uname='linux shad2 3.13.0-37-generic #64-ubuntu smp mon sep 22 21:28:38 utc 2014 x86_64 x86_64 x86_64 gnulinux '
    config_args='-des -Dcc=gcc -Dprefix=/opt/blead-d -Doptimize=-g -O6 -DDEBUGGING -Dusedevel -Uversiononly'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=undef, usemultiplicity=undef
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-g -O6',
    cppflags='-fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include'
    ccversion='', gccversion='4.8.2', 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='gcc', ldflags =' -fstack-protector -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/4.8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc
    libc=libc-2.19.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.19'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -g -O6 -L/usr/local/lib -fstack-protector'


---
@INC for perl 5.21.9:
    /opt/blead-d/lib/perl5/site_perl/5.21.9/x86_64-linux
    /opt/blead-d/lib/perl5/site_perl/5.21.9
    /opt/blead-d/lib/perl5/5.21.9/x86_64-linux
    /opt/blead-d/lib/perl5/5.21.9
    .

---
Environment for perl 5.21.9:
    HOME=/home/hv
    LANG=C
    LANGUAGE=en_GB:en
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/hv/bin:/home/hv/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games
    PERL_BADLANG (unset)
    SHELL=/bin/bash

• [perl #123759] tr/// can write on immortals by Hugo van der Sanden via RT
• [perl #123759] tr/// can write on immortals by Father Chrysostomos via RT
• [perl #123759] tr/// can write on immortals by Hugo van der Sanden