Unknow address reference in Perl_hv_common

[p5pRT]

Migrated from rt.perl.org#131606 (status was 'open')

Searchable as RT131606$

[p5pRT]

From @Mipu94

Attached file below triggered crash because reference to unknow address in
funtion Perl_hv_common.
Effect on perl version 5.27.1 and 5.26.0

Some info about this bug on gdb-peda​:

[----------------------------------registers-----------------------------------]
RAX​: 0x7fd7a8 --> 0x0
RBX​: 0xc0b948 --> 0x7fd7a8 --> 0x0
RCX​: 0x810540 --> 0x0
RDX​: 0x6e ('n')
RSI​: 0x5
RDI​: 0x800c10 --> 0x737365666e ('nfess')
RBP​: 0x0
RSP​: 0x7fffffffe120 --> 0xc78b50 ("#", ' ' <repeats 19 times>, "'Can't
locate object method \"c\" via package \"Carp\" at (eval 7) line 3.\n# '\n#
  doesn't match
'(?^s​:(?​:(?^​:__ANON__​::)|SubHelper​::).*(?​:(?^​:__ANON__​::)|Sub​::))'\n")
RIP​: 0x4ae68e (<Perl_hv_common+494>​: mov r13,QWORD PTR [r8+rcx*8])
R8 : 0x7fd7a8 --> 0x0
R9 : 0x20 (' ')
R10​: 0x20 (' ')
R11​: 0x7ffff7240390 --> 0xfffda380fffda0af
R12​: 0x15f31d6c
R13​: 0x0
R14​: 0x0
R15​: 0x800c15 --> 0x211000000
EFLAGS​: 0x10202 (carry parity adjust zero sign trap INTERRUPT direction
overflow)
[-------------------------------------code-------------------------------------]
  0x4ae684 <Perl_hv_common+484>​: mov ecx,r12d
  0x4ae687 <Perl_hv_common+487>​: mov r8,QWORD PTR [rbx+0x10]
  0x4ae68b <Perl_hv_common+491>​: and ecx,DWORD PTR [rax+0x18]
=> 0x4ae68e <Perl_hv_common+494>​: mov r13,QWORD PTR [r8+rcx*8]
  0x4ae692 <Perl_hv_common+498>​: test r13,r13
  0x4ae695 <Perl_hv_common+501>​: jne 0x4aedf0
<Perl_hv_common+2384>
  0x4ae69b <Perl_hv_common+507>​: mov esi,DWORD PTR [rbx+0xc]
  0x4ae69e <Perl_hv_common+510>​: test esi,0x8010000
[------------------------------------stack-------------------------------------]
0000| 0x7fffffffe120 --> 0xc78b50 ("#", ' ' <repeats 19 times>, "'Can't
locate object method \"c\" via package \"Carp\" at (eval 7) line 3.\n# '\n#
  doesn't match
'(?^s​:(?​:(?^​:__ANON__​::)|SubHelper​::).*(?​:(?^​:__ANON__​::)|Sub​::))'\n")
0008| 0x7fffffffe128 --> 0x20 (' ')
0016| 0x7fffffffe130 --> 0x800c10 --> 0x737365666e ('nfess')
0024| 0x7fffffffe138 --> 0x0
0032| 0x7fffffffe140 --> 0x7fd7a8 --> 0x0
0040| 0x7fffffffe148 --> 0x4900aa7e00000020
0048| 0x7fffffffe150 --> 0x5
0056| 0x7fffffffe158 --> 0x4969aa7e56186400
[------------------------------------------------------------------------------]
blue
Legend​: code, data, rodata, value
Stopped reason​: SIGSEGV
0x00000000004ae68e in Perl_hv_common ()
gdb-peda$ where
#0 0x00000000004ae68e in Perl_hv_common ()
#1 0x00000000004afd74 in Perl_hv_common_key_len ()
#2 0x0000000000445e1a in Perl_gv_fetchpvn_flags ()
#3 0x00000000004be163 in Perl_pp_method_redir ()
#4 0x00000000004b3373 in Perl_runops_standard ()
#5 0x00000000004436f1 in perl_run ()
#6 0x000000000041fe95 in main ()
#7 0x00007ffff70cc830 in __libc_start_main () from
/lib/x86_64-linux-gnu/libc.so.6
#8 0x000000000041fed9 in _start ()
gdb-peda$ q

--
Ta Dinh Sung,

[p5pRT]

From @Mipu94

poc

[p5pRT]

From @tonycoz

On Tue, 20 Jun 2017 00​:41​:01 -0700, tadinhsung@​gmail.com wrote​:

Attached file below triggered crash because reference to unknow
address in
funtion Perl_hv_common.
Effect on perl version 5.27.1 and 5.26.0

Simplifies to​:

my $unknown_pat = qr/__ANON__​::/;
my $sub = sub {
  SubHelper​::x();
};
delete ${'​::'}{'SubHelper​::'};
$@​ =~ $unknown_pat;
eval { $sub->() };

package SubHelper;
sub x {
  Carp​::c nfess("blah");
}

On a debugging build​:

miniperl​: hv.c​:353​: Perl_hv_common​: Assertion `((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV' failed.
Aborted

The stash passed to hv_fetch is a regexp​:

miniperl​: hv.c​:360​: Perl_hv_common​: Assertion `((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV' failed.

Program received signal SIGABRT, Aborted.
0x00007ffff6cf2067 in __GI_raise (sig=sig@​entry=6)
  at ../nptl/sysdeps/unix/sysv/linux/raise.c​:56
56 ../nptl/sysdeps/unix/sysv/linux/raise.c​: No such file or directory.
(gdb) bt
#0 0x00007ffff6cf2067 in __GI_raise (sig=sig@​entry=6)
  at ../nptl/sysdeps/unix/sysv/linux/raise.c​:56
#1 0x00007ffff6cf3448 in __GI_abort () at abort.c​:89
#2 0x00007ffff6ceb266 in __assert_fail_base (
  fmt=0x7ffff6e23f18 "%s%s%s​:%u​: %s%sAssertion `%s' failed.\n%n",
  assertion=assertion@​entry=0x7d8540 "((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV", file=file@​entry=0x7d852b "hv.c", line=line@​entry=360,
  function=function@​entry=0x7da9b7 <__PRETTY_FUNCTION__.15100> "Perl_hv_common") at assert.c​:92
#3 0x00007ffff6ceb312 in __GI___assert_fail (
  assertion=0x7d8540 "((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV",
  file=0x7d852b "hv.c", line=360,
  function=0x7da9b7 <__PRETTY_FUNCTION__.15100> "Perl_hv_common")
  at assert.c​:101
#4 0x000000000057f5f1 in Perl_hv_common (hv=0xaa1dd0, keysv=0x0,
  key=0xab1180 "nfess", klen=5, flags=0, action=32, val=0x0, hash=0)
  at hv.c​:360
#5 0x000000000057f525 in Perl_hv_common_key_len (hv=0xaa1dd0,
  key=0xab1180 "nfess", klen_i32=5, action=32, val=0x0, hash=0) at hv.c​:337
#6 0x00000000004684ee in Perl_gv_fetchpvn_flags (nambeg=0xab1180 "nfess",
  full_len=5, flags=0, sv_type=SVt_PVIO) at gv.c​:2357
#7 0x00000000005adfd9 in S_opmethod_stash (meth=0xaafde8) at pp_hot.c​:4444
#8 0x00000000005af400 in Perl_pp_method_redir () at pp_hot.c​:4563
#9 0x0000000000547d82 in Perl_runops_debug () at dump.c​:2451
#10 0x0000000000448d4a in S_run_body (oldscope=1) at perl.c​:2548
#11 0x000000000044832d in perl_run (my_perl=0xa84010) at perl.c​:2471
#12 0x00000000007365f9 in main (argc=2, argv=0x7fffffffe868,
  env=0x7fffffffe880) at miniperlmain.c​:129
(gdb) up 6
#6 0x00000000004684ee in Perl_gv_fetchpvn_flags (nambeg=0xab1180 "nfess",
  full_len=5, flags=0, sv_type=SVt_PVIO) at gv.c​:2357
2357 gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);
(gdb) call Perl_sv_dump(stash)
SV = PV(0xa86d70) at 0xaa1dd0
  REFCNT = 1
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0xaa2d40 "Regexp"
  CUR = 6
  LEN = 0

Bisects to​:

commit bee7c57
Author​: Father Chrysostomos <sprout@​cpan.org>
Date​: Fri May 18 17​:02​:39 2012 -0700

  sv.c​: Don’t fiddle with AMAGIC in sv_bless
 
  Since overloading itself now checks whether caches are up to date, and
  since changes to the stash (@​ISA, methods) turn the flag on and over-
  loading itself turns the flag off when it can, sv_bless no longer
  needs to deal with it at all.

but I suspect this just a case of a freed SV being overwritten.

I don't think this is a security issue.

Tony

[p5pRT]

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

[p5pRT]

From @Mipu94

Sorry, i'm not really good on perl :( . But when i debug perl(
v5.27.0-324-g3aa3d69) on gdb-peda with my poc ...

RAX​: 0x6210002149c8 --> 0x0
RBX​: 0x5
RCX​: 0x20 (' ')
RDX​: 0x6e ('n')
RSI​: 0x5
RDI​: 0x42b40
RBP​: 0x62100010e838 --> 0x6210002149c8 --> 0x0
RSP​: 0x7fffffffe100 --> 0x62500017e900 ("#", ' ' <repeats 19 times>,
"'Can't locate object method \"c\" via package \"Carp\" at (eval 7)
line 3.\n# '\n# doesn't match
'(?^s​:(?​:(?^​:__ANON__​::)|SubHelper​::).*(?​:(?^​:__ANON__​::)|Sub​::))'\n")
RIP​: 0x4b03c7 (<Perl_hv_common+807>​: mov rbx,QWORD PTR [r9+rdi*8])
R8 : 0x0
R9 : 0x6210002149c8 --> 0x0
R10​: 0x6d376bd5
R11​: 0x7ffff6288790 --> 0xfffca500fffc9d40
R12​: 0x0
R13​: 0x0
R14​: 0x20 (' ')
R15​: 0x0
EFLAGS​: 0x10202 (carry parity adjust zero sign trap INTERRUPT
direction overflow)
[-------------------------------------code-------------------------------------]
  0x4b03bd <Perl_hv_common+797>​: mov edi,r10d
  0x4b03c0 <Perl_hv_common+800>​: mov r9,QWORD PTR [rbp+0x10]
  0x4b03c4 <Perl_hv_common+804>​: and edi,DWORD PTR [rax+0x18]
=> 0x4b03c7 <Perl_hv_common+807>​: mov rbx,QWORD PTR [r9+rdi*8]
  0x4b03cb <Perl_hv_common+811>​: test rbx,rbx
  0x4b03ce <Perl_hv_common+814>​: jne 0x4b0ba0 <Perl_hv_common+2816>
  0x4b03d4 <Perl_hv_common+820>​: mov esi,DWORD PTR [rbp+0xc]
  0x4b03d7 <Perl_hv_common+823>​: test esi,0x8010000

Obviously, at address 0x4b03c4 register edi was loaded from address
[rax+0x18](mmap section) but this memory was overwrite.

If attacker can init value for section
X(0x0000621000000000-0x0000621000220000) before,that mean we can
control rbx because at this time register rax and r9 point to
0x6210002149c8 in section X, and we jump in 0x4b0ba0.

gdb-peda$ pdisass 0x4b0ba0
Dump of assembler code from 0x4b0ba0 to 0x4b0bc0​:: Dump of
assembler code from 0x4b0ba0 to 0x4b0bc0​:
  0x00000000004b0ba0 <Perl_hv_common+2816>​: movzx eax,r13b
  0x00000000004b0ba4 <Perl_hv_common+2820>​: mov ecx,r10d
  0x00000000004b0ba7 <Perl_hv_common+2823>​: mov DWORD PTR [rsp+0x28],eax
  0x00000000004b0bab <Perl_hv_common+2827>​: mov rax,QWORD PTR [rsp+0x58]
  0x00000000004b0bb0 <Perl_hv_common+2832>​: mov QWORD PTR [rsp+0x38],rbp
  0x00000000004b0bb5 <Perl_hv_common+2837>​: mov rbp,rbx
  0x00000000004b0bb8 <Perl_hv_common+2840>​: mov DWORD PTR [rsp+0x40],r13d

at address 0x4b0ba7 variable [rsp+0x28](orig_entry) can control,
https://github.com/Perl/perl5/blob/blead/hv.c#L660.

2017-06-21 9​:02 GMT+07​:00 Tony Cook via RT <perl5-security-report@​perl.org>​:

On Tue, 20 Jun 2017 00​:41​:01 -0700, tadinhsung@​gmail.com wrote​:

Attached file below triggered crash because reference to unknow
address in
funtion Perl_hv_common.
Effect on perl version 5.27.1 and 5.26.0

Simplifies to​:

my $unknown_pat = qr/__ANON__​::/;
my $sub = sub {
SubHelper​::x();
};
delete ${'​::'}{'SubHelper​::'};
$@​ =~ $unknown_pat;
eval { $sub->() };

package SubHelper;
sub x {
Carp​::c nfess("blah");
}

On a debugging build​:

miniperl​: hv.c​:353​: Perl_hv_common​: Assertion `((svtype)((hv)->sv_flags &
0xff)) == SVt_PVHV' failed.
Aborted

The stash passed to hv_fetch is a regexp​:

miniperl​: hv.c​:360​: Perl_hv_common​: Assertion `((svtype)((hv)->sv_flags &
0xff)) == SVt_PVHV' failed.

Program received signal SIGABRT, Aborted.
0x00007ffff6cf2067 in __GI_raise (sig=sig@​entry=6)
at ../nptl/sysdeps/unix/sysv/linux/raise.c​:56
56 ../nptl/sysdeps/unix/sysv/linux/raise.c​: No such file or
directory.
(gdb) bt
#0 0x00007ffff6cf2067 in __GI_raise (sig=sig@​entry=6)
at ../nptl/sysdeps/unix/sysv/linux/raise.c​:56
#1 0x00007ffff6cf3448 in __GI_abort () at abort.c​:89
#2 0x00007ffff6ceb266 in __assert_fail_base (
fmt=0x7ffff6e23f18 "%s%s%s​:%u​: %s%sAssertion `%s' failed.\n%n",
assertion=assertion@​entry=0x7d8540 "((svtype)((hv)->sv_flags & 0xff))
== SVt_PVHV", file=file@​entry=0x7d852b "hv.c", line=line@​entry=360,
function=function@​entry=0x7da9b7 <__PRETTY_FUNCTION__.15100>
"Perl_hv_common") at assert.c​:92
#3 0x00007ffff6ceb312 in __GI___assert_fail (
assertion=0x7d8540 "((svtype)((hv)->sv_flags & 0xff)) == SVt_PVHV",
file=0x7d852b "hv.c", line=360,
function=0x7da9b7 <__PRETTY_FUNCTION__.15100> "Perl_hv_common")
at assert.c​:101
#4 0x000000000057f5f1 in Perl_hv_common (hv=0xaa1dd0, keysv=0x0,
key=0xab1180 "nfess", klen=5, flags=0, action=32, val=0x0, hash=0)
at hv.c​:360
#5 0x000000000057f525 in Perl_hv_common_key_len (hv=0xaa1dd0,
key=0xab1180 "nfess", klen_i32=5, action=32, val=0x0, hash=0) at
hv.c​:337
#6 0x00000000004684ee in Perl_gv_fetchpvn_flags (nambeg=0xab1180 "nfess",
full_len=5, flags=0, sv_type=SVt_PVIO) at gv.c​:2357
#7 0x00000000005adfd9 in S_opmethod_stash (meth=0xaafde8) at pp_hot.c​:4444
#8 0x00000000005af400 in Perl_pp_method_redir () at pp_hot.c​:4563
#9 0x0000000000547d82 in Perl_runops_debug () at dump.c​:2451
#10 0x0000000000448d4a in S_run_body (oldscope=1) at perl.c​:2548
#11 0x000000000044832d in perl_run (my_perl=0xa84010) at perl.c​:2471
#12 0x00000000007365f9 in main (argc=2, argv=0x7fffffffe868,
env=0x7fffffffe880) at miniperlmain.c​:129
(gdb) up 6
#6 0x00000000004684ee in Perl_gv_fetchpvn_flags (nambeg=0xab1180 "nfess",
full_len=5, flags=0, sv_type=SVt_PVIO) at gv.c​:2357
2357 gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len :
(I32)len,add);
(gdb) call Perl_sv_dump(stash)
SV = PV(0xa86d70) at 0xaa1dd0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xaa2d40 "Regexp"
CUR = 6
LEN = 0

Bisects to​:

commit bee7c57
Author​: Father Chrysostomos <sprout@​cpan.org>
Date​: Fri May 18 17​:02​:39 2012 -0700

sv\.c​: Don’t fiddle with AMAGIC in sv\_bless

Since overloading itself now checks whether caches are up to date\, and
since changes to the stash \(@​ISA\, methods\) turn the flag on and over\-
loading itself turns the flag off when it can\, sv\_bless no longer
needs to deal with it at all\.

but I suspect this just a case of a freed SV being overwritten.

I don't think this is a security issue.

Tony

--
Ta Dinh Sung,

[p5pRT]

From @iabyn

On Tue, Jun 20, 2017 at 12​:41​:02AM -0700, sung wrote​:

Attached file below triggered crash because reference to unknow address in
funtion Perl_hv_common.

The code can be reduced to

  package F {
  sub x { blah->c(); }
  }

  my $sub = sub { F​::x(); } ;

  delete ${'​::'}{'F​::'};

  my $pat = qr/X/;
  "" =~ /$pat/;

  eval { $sub->() };

the call to the class method 'blah->c' involves a lookup of the stash
'blah', which isn't found, so S_find_default_stash() falls back
using CopSTASH(PL_curcop). The current stash is F​::, but that's been
deleted, and it appears that CopSTASH() (via PL_stashpad[n] on threaded
builds, and maybe an issue on unthreaded too?) doesn't hold a reference
count on the stash. So the

  delete ${'​::'}{'F​::'};

frees the stash and leaves the cops pointing at a freed or reallocated SV
which may not be a HV any more, hence the assert failure.

This doesn't seem like a security issue, since malicious code that has the
ability to delete stashes can probably do lots of harm anyway.

If no-one objects, I'll move this to the public queue soon.

--
In economics, the exam questions are the same every year.
They just change the answers.

[p5pRT]

From @demerphq

On 21 June 2017 at 16​:57, Dave Mitchell <davem@​iabyn.com> wrote​:

On Tue, Jun 20, 2017 at 12​:41​:02AM -0700, sung wrote​:

Attached file below triggered crash because reference to unknow address in
funtion Perl_hv_common.

The code can be reduced to

package F \{
    sub x \{ blah\->c\(\); \}
\}

my $sub = sub \{ F​::x\(\); \} ;

delete $\{'​::'\}\{'F​::'\};

my $pat = qr/X/;
"" =~ /$pat/;

eval \{ $sub\->\(\) \};

the call to the class method 'blah->c' involves a lookup of the stash
'blah', which isn't found, so S_find_default_stash() falls back
using CopSTASH(PL_curcop). The current stash is F​::, but that's been
deleted, and it appears that CopSTASH() (via PL_stashpad[n] on threaded
builds, and maybe an issue on unthreaded too?) doesn't hold a reference
count on the stash. So the

delete $\{'​::'\}\{'F​::'\};

frees the stash and leaves the cops pointing at a freed or reallocated SV
which may not be a HV any more, hence the assert failure.

This doesn't seem like a security issue, since malicious code that has the
ability to delete stashes can probably do lots of harm anyway.

If no-one objects, I'll move this to the public queue soon.

No objection, but i have a question. I chased this down a bit as well,
and didnt get as far as you did I think, but on the other hand, I did
try reverting the patch from the bisect, and it does reliably fix this
problem. Also, this code is a bit "interesting", as the bless call is
coming from Perl itself, internally, when it is constructing the qr//.
So it is not actually clear to me that this is a refcount bug.

Here is what I see when I trace the code, we end up calling
S_find_default_stash() from
gv.c line 2355​:

  if (!stash && !find_default_stash(&stash, name, len, is_utf8, add,
sv_type)) {
  return NULL;
  }

Which looks like this in the gdb trace​:

S_find_default_stash (my_perl=0xaee010, stash=0x7fffffffd770,
name=0xb32d68 "nfess", len=5,
  is_utf8=0, add=0, sv_type=SVt_PVIO) at gv.c​:1765
1765 if (IN_PERL_COMPILETIME) {
(gdb)
1804 *stash = CopSTASH(PL_curcop);
(gdb)
1808 if (!*stash) {
(gdb)
1839 if (!SvREFCNT(*stash)) /* symbol table under destruction */
(gdb)
1842 return TRUE;
(gdb)
1843 }
(gdb)
Perl_gv_fetchpvn_flags (my_perl=0xaee010, nambeg=0xb32d68 "nfess",
full_len=5, flags=0,
  sv_type=SVt_PVIO) at gv.c​:2357
2357 gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
  REFCNT = 1
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0xb1c4a8 "Regexp"
  CUR = 6
  LEN = 0

And, if I revert FC's patch the bug goes away. FC's patch amounts to this​:

  if (Gv_AMG(stash))
  SvAMAGIC_on(sv);
  else
  (void)SvAMAGIC_off(sv);

Which BTW, results in the else branch being called, however, it
appears to me that the important part is not the else but the
conditional itself, if I replace that code with simply doing​:

  Gv_AMG(stash);

then the segfault also goes away. This combined with the fact that
this is the special Regexp class being created by the internals makes
me think that we are somehow not correctly setting up the Regexp stash
properly.

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From @iabyn

On Wed, Jun 21, 2017 at 05​:14​:22PM +0200, demerphq wrote​:

Here is what I see when I trace the code, we end up calling
S_find_default_stash() from
gv.c line 2355​:

if \(\!stash && \!find\_default\_stash\(&stash\, name\, len\, is\_utf8\, add\,

sv_type)) {
return NULL;
}

Which looks like this in the gdb trace​:

S_find_default_stash (my_perl=0xaee010, stash=0x7fffffffd770,
name=0xb32d68 "nfess", len=5,
is_utf8=0, add=0, sv_type=SVt_PVIO) at gv.c​:1765
1765 if (IN_PERL_COMPILETIME) {
(gdb)
1804 *stash = CopSTASH(PL_curcop);
(gdb)
1808 if (!*stash) {
(gdb)
1839 if (!SvREFCNT(*stash)) /* symbol table under destruction */
(gdb)
1842 return TRUE;
(gdb)
1843 }
(gdb)
Perl_gv_fetchpvn_flags (my_perl=0xaee010, nambeg=0xb32d68 "nfess",
full_len=5, flags=0,
sv_type=SVt_PVIO) at gv.c​:2357
2357 gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xb1c4a8 "Regexp"
CUR = 6
LEN = 0

What you're seeing is an SV that has been freed, and then later
reallocated by other code (as a PV in your case - I saw an AV). It's
supposed to be a HV.

--
The crew of the Enterprise encounter an alien life form which is
surprisingly neither humanoid nor made from pure energy.
  -- Things That Never Happen in "Star Trek" #22

[p5pRT]

From @demerphq

On 21 June 2017 at 17​:14, demerphq <demerphq@​gmail.com> wrote​:

On 21 June 2017 at 16​:57, Dave Mitchell <davem@​iabyn.com> wrote​:

On Tue, Jun 20, 2017 at 12​:41​:02AM -0700, sung wrote​:

Attached file below triggered crash because reference to unknow address in
funtion Perl_hv_common.

The code can be reduced to

package F \{
    sub x \{ blah\->c\(\); \}
\}

my $sub = sub \{ F​::x\(\); \} ;

delete $\{'​::'\}\{'F​::'\};

my $pat = qr/X/;
"" =~ /$pat/;

eval \{ $sub\->\(\) \};

the call to the class method 'blah->c' involves a lookup of the stash
'blah', which isn't found, so S_find_default_stash() falls back
using CopSTASH(PL_curcop). The current stash is F​::, but that's been
deleted, and it appears that CopSTASH() (via PL_stashpad[n] on threaded
builds, and maybe an issue on unthreaded too?) doesn't hold a reference
count on the stash. So the

delete $\{'​::'\}\{'F​::'\};

frees the stash and leaves the cops pointing at a freed or reallocated SV
which may not be a HV any more, hence the assert failure.

This doesn't seem like a security issue, since malicious code that has the
ability to delete stashes can probably do lots of harm anyway.

If no-one objects, I'll move this to the public queue soon.

No objection, but i have a question. I chased this down a bit as well,
and didnt get as far as you did I think, but on the other hand, I did
try reverting the patch from the bisect, and it does reliably fix this
problem. Also, this code is a bit "interesting", as the bless call is
coming from Perl itself, internally, when it is constructing the qr//.
So it is not actually clear to me that this is a refcount bug.

Here is what I see when I trace the code, we end up calling
S_find_default_stash() from
gv.c line 2355​:

if \(\!stash && \!find\_default\_stash\(&stash\, name\, len\, is\_utf8\, add\,

sv_type)) {
return NULL;
}

Which looks like this in the gdb trace​:

S_find_default_stash (my_perl=0xaee010, stash=0x7fffffffd770,
name=0xb32d68 "nfess", len=5,
is_utf8=0, add=0, sv_type=SVt_PVIO) at gv.c​:1765
1765 if (IN_PERL_COMPILETIME) {
(gdb)
1804 *stash = CopSTASH(PL_curcop);
(gdb)
1808 if (!*stash) {
(gdb)
1839 if (!SvREFCNT(*stash)) /* symbol table under destruction */
(gdb)
1842 return TRUE;
(gdb)
1843 }
(gdb)
Perl_gv_fetchpvn_flags (my_perl=0xaee010, nambeg=0xb32d68 "nfess",
full_len=5, flags=0,
sv_type=SVt_PVIO) at gv.c​:2357
2357 gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add);

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xb1c4a8 "Regexp"
CUR = 6
LEN = 0

And, if I revert FC's patch the bug goes away. FC's patch amounts to this​:

if \(Gv\_AMG\(stash\)\)
    SvAMAGIC\_on\(sv\);
else
    \(void\)SvAMAGIC\_off\(sv\);

Which BTW, results in the else branch being called, however, it
appears to me that the important part is not the else but the
conditional itself, if I replace that code with simply doing​:

Gv_AMG(stash);

then the segfault also goes away. This combined with the fact that
this is the special Regexp class being created by the internals makes
me think that we are somehow not correctly setting up the Regexp stash
properly.

And If I dump the Regexp stash in sv.c with and without the
Gv_AMG(stash) call I see significant differences between the two.
Gv_AMG(stash) has significant side-effects, the code that FC removed
does much much more than it looks like it does.

With​:

SV = PVHV(0xaf99f8) at 0xb1a2b8
  REFCNT = 2
  FLAGS = (RMG,OOK,SHAREKEYS)
  MAGIC = 0xb2e858
  MG_VIRTUAL = &PL_vtbl_ovrld
  MG_TYPE = PERL_MAGIC_overload_table(c)
  MG_LEN = 8
  MG_PTR = 0xb131e8 "\0\2\0\0\10\0\0\0"
  AUX_FLAGS = 0
  ARRAY = 0xb1c3e8 (0​:7, 1​:1)
  hash quality = 100.0%
  KEYS = 1
  FILL = 1
  MAX = 7
  RITER = -1
  EITER = 0x0
  RAND = 0x6bee8911
  NAME = "Regexp"
  ENAME = "Regexp"
  BACKREFS = 0xb1a2d0
  SV = PVGV(0xb10d98) at 0xb1a2d0
  REFCNT = 1
  FLAGS = (RMG,MULTI)
  MAGIC = 0xb1c608
  MG_VIRTUAL = &PL_vtbl_backref
  MG_TYPE = PERL_MAGIC_backref(<)
  MG_OBJ = 0xb1a2e8
  NAME = "DESTROY"
  NAMELEN = 7
  GvSTASH = 0xb1a2b8 "Regexp"
  FLAGS = 0x2
  GP = 0xb1c528
  SV = 0x0
  REFCNT = 1
  IO = 0x0
  FORM = 0x0
  AV = 0x0
  HV = 0x0
  CV = 0xb1a2e8
  CVGEN = 0x0
  GPFLAGS = 0x0 ()
  LINE = 2147483647
  FILE = "t.pl"
  EGV = 0xb1a2d0 "DESTROY"
  MRO_WHICH = "dfs" (0x837b40)
  CACHE_GEN = 0x1
  PKG_GEN = 0x2
  MRO_LINEAR_CURRENT = 0xaf0f48
  SV = PVAV(0xaf2b70) at 0xaf0f48
  REFCNT = 2
  FLAGS = (READONLY,PROTECT)
  ARRAY = 0xb1db08
  FILL = 0
  MAX = 3
  FLAGS = (REAL)
  ISA = 0xb1a540
  SV = PVHV(0xaf9a98) at 0xb1a540
  REFCNT = 2
  FLAGS = (READONLY,PROTECT,SHAREKEYS)
  ARRAY = 0xb1ddc8 (0​:6, 1​:2)
  hash quality = 125.0%
  KEYS = 2
  FILL = 2
  MAX = 7

Without​:

SV = PVHV(0xaf99f8) at 0xb1a2b8
  REFCNT = 2
  FLAGS = (OOK,SHAREKEYS,OVERLOAD)
  AUX_FLAGS = 0
  ARRAY = 0xb1c3b8 (0​:7, 1​:1)
  hash quality = 100.0%
  KEYS = 1
  FILL = 1
  MAX = 7
  RITER = -1
  EITER = 0x0
  RAND = 0xe94c400a
  NAME = "Regexp"
  ENAME = "Regexp"
  BACKREFS = 0xb1a2d0
  SV = PVGV(0xb10d98) at 0xb1a2d0
  REFCNT = 1
  FLAGS = (RMG,MULTI)
  MAGIC = 0xb1c5d8
  MG_VIRTUAL = &PL_vtbl_backref
  MG_TYPE = PERL_MAGIC_backref(<)
  MG_OBJ = 0xb1a2e8
  NAME = "DESTROY"
  NAMELEN = 7
  GvSTASH = 0xb1a2b8 "Regexp"
  FLAGS = 0x2
  GP = 0xb1c4f8
  SV = 0x0
  REFCNT = 1
  IO = 0x0
  FORM = 0x0
  AV = 0x0
  HV = 0x0
  CV = 0xb1a2e8
  CVGEN = 0x0
  GPFLAGS = 0x0 ()
  LINE = 2147483647
  FILE = "t.pl"
  EGV = 0xb1a2d0 "DESTROY"
  MRO_WHICH = "dfs" (0x8379e0)
  CACHE_GEN = 0x1
  PKG_GEN = 0x2

--
perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From @demerphq

On 21 June 2017 at 17​:29, Dave Mitchell <davem@​iabyn.com> wrote​:

On Wed, Jun 21, 2017 at 05​:14​:22PM +0200, demerphq wrote​:

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xb1c4a8 "Regexp"
CUR = 6
LEN = 0

What you're seeing is an SV that has been freed, and then later
reallocated by other code (as a PV in your case - I saw an AV). It's
supposed to be a HV.

Yes, but my point is that somehow the Gv_AMG() changes the original
var enough that the free does not happen.

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From @demerphq

On 21 June 2017 at 17​:32, demerphq <demerphq@​gmail.com> wrote​:

On 21 June 2017 at 17​:29, Dave Mitchell <davem@​iabyn.com> wrote​:

On Wed, Jun 21, 2017 at 05​:14​:22PM +0200, demerphq wrote​:

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xb1c4a8 "Regexp"
CUR = 6
LEN = 0

What you're seeing is an SV that has been freed, and then later
reallocated by other code (as a PV in your case - I saw an AV). It's
supposed to be a HV.

Yes, but my point is that somehow the Gv_AMG() changes the original
var enough that the free does not happen.

With the Gv_AMG() call, PL_curcop ends up as NULL not as a dangling
pointer. I think there is something wrong with FC's patch.

Yves

--
perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From @demerphq

On 21 June 2017 at 17​:41, demerphq <demerphq@​gmail.com> wrote​:

On 21 June 2017 at 17​:32, demerphq <demerphq@​gmail.com> wrote​:

On 21 June 2017 at 17​:29, Dave Mitchell <davem@​iabyn.com> wrote​:

On Wed, Jun 21, 2017 at 05​:14​:22PM +0200, demerphq wrote​:

When I dump the stash object its REFCNT is 1, which doesnt seem to
line up with your analysis​:
(gdb) call Perl_sv_dump(my_perl,stash)
SV = PV(0xaf1b18) at 0xb273a0
REFCNT = 1
FLAGS = (POK,IsCOW,pPOK)
PV = 0xb1c4a8 "Regexp"
CUR = 6
LEN = 0

What you're seeing is an SV that has been freed, and then later
reallocated by other code (as a PV in your case - I saw an AV). It's
supposed to be a HV.

Yes, but my point is that somehow the Gv_AMG() changes the original
var enough that the free does not happen.

With the Gv_AMG() call, PL_curcop ends up as NULL not as a dangling
pointer. I think there is something wrong with FC's patch.

So for instance, if I take the code that FC removed from sv_bless()
and put it into pp_qr() in pp_hot.c the segfault reliably goes away​:

$ git diff

Inline Patch

diff --git a/pp_hot.c b/pp_hot.c
index 7c98c90..2394464 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1923,6 +1923,10 @@ PP(pp_qr)
        HV *const stash = gv_stashsv(pkg, GV_ADD);
        SvREFCNT_dec_NN(pkg);
        (void)sv_bless(rv, stash);
+        if (Gv_AMG(stash))
+            SvAMAGIC_on(rv);
+        else
+            (void)SvAMAGIC_off(rv);
     }

     if (UNLIKELY(RX_ISTAINTED(rx))) {

-- 

perl -Mre=debug -e "/just|another|perl|hacker/"

[p5pRT]

From @iabyn

On Wed, Jun 21, 2017 at 05​:49​:36PM +0200, demerphq wrote​:

Yes, but my point is that somehow the Gv_AMG() changes the original
var enough that the free does not happen.

I'm afraid you are mistaken. With all 6 combinations of
  1) blead
  2) FC's patch reverted
  3) the "FC blob" of code added to pp_qr instead
against
  A) OP's original poc file
  B) my stripped down variant

I see an assertion failure, and using a watchpoint under gdb shows the
stash being prematurely freed by the delete ${'​::'}{'SubHelper​::'}
(or more precisely in the freetmps in the scope exit following the delete),
and then that freed SV being reallocated when the qr// is compiled.

I think everything else you see is just a side affect of
1) the regex code (legitimately) treating an SV as a regex object;
2) some other code (illegitimately) treating the SV as a stash.

I think FC's patch is probably correct. I don't remember the full details,
but the way he changed things was that stashes get kind of speculatively
marked as maybe having cached overload methods, then the first time
an overload is tried, it properly regenerates the cache, realises there
isn't that particular type of overloading and returns. Then subsequent
overload checks fail quickly.

--
Music lesson​: a symbiotic relationship whereby a pupil's embellishments
concerning the amount of practice performed since the last lesson are
rewarded with embellishments from the teacher concerning the pupil's
progress over the corresponding period.

[p5pRT]

From @cpansprout

On Thu, 22 Jun 2017 03​:55​:01 -0700, davem wrote​:

On Wed, Jun 21, 2017 at 05​:49​:36PM +0200, demerphq wrote​:

Yes, but my point is that somehow the Gv_AMG() changes the original
var enough that the free does not happen.

I'm afraid you are mistaken. With all 6 combinations of
1) blead
2) FC's patch reverted
3) the "FC blob" of code added to pp_qr instead
against
A) OP's original poc file
B) my stripped down variant

I see an assertion failure, and using a watchpoint under gdb shows the
stash being prematurely freed by the delete ${'​::'}{'SubHelper​::'}
(or more precisely in the freetmps in the scope exit following the delete),
and then that freed SV being reallocated when the qr// is compiled.

I think everything else you see is just a side affect of
1) the regex code (legitimately) treating an SV as a regex object;
2) some other code (illegitimately) treating the SV as a stash.

This variant fails an assertion all the way back to 5.002​:

{ package F ;
  sub x { blah->c(); }
}
delete $​::{"F​::"};
my $thing = [(0) x 5000];
F​::x();

The $thing assignment (with a ridiculous repeat count for good measure) makes sure that the freed stash gets reused as an IV.

How do we go about fixing this kind of bug?

For GVs being freed when there are still CVs, we give the CV a strong pointer, instead of a weak one. I.e., we switch the direction of the weak pointer.

That complicates the code, so I wonder whether it is the right thing to do in the case of freed stashes, which are much rarer than freed globs.

Would the right thing to do be simply to plug the code paths that can fail an assertion when CopSTASH(&PL_curcop) is something weird (as I did for pp_caller)? What about those cases when a freed stash is reused as another stash (in which case you get subtle bugs hard to track down)?

I thought about perhaps nulling out the pointer in PL_stashpad when the stash is freed (and plugging the crashing code paths), but that does not help us with non-threaded builds, which have their stash pointers directly in the COP. (And I don’t like to expand the complexity of PL_stashpad to unthreaded builds, just for the sake of this.)

BTW, the test case crashes because it is looking to see whether the class method call could actually be a filehandle method call, which takes precedence over classes.

I think FC's patch is probably correct. I don't remember the full details,
but the way he changed things was that stashes get kind of speculatively
marked as maybe having cached overload methods, then the first time
an overload is tried, it properly regenerates the cache, realises there
isn't that particular type of overloading and returns. Then subsequent
overload checks fail quickly.

Yes, that is how it works. That means that for most classes you get exactly one calculation of the overload table, not one for each blessing. And you can change your overload methods and have them take effect immediately on existing objects, instead of waiting for the next blessing to come along.

--

Father Chrysostomos

[p5pRT]

From @tonycoz

On Wed, 21 Jun 2017 07​:57​:14 -0700, davem wrote​:

This doesn't seem like a security issue, since malicious code that has the
ability to delete stashes can probably do lots of harm anyway.

If no-one objects, I'll move this to the public queue soon.

I agree, now public.

Tony