p5pRT
commented
15 years ago From perl@profvince.com
Created by perl@province.com
This bug isn't specific to 5.10 or to H::U::FH\, but it gives a convenient way to show it without writing XS code.
perl -MHash::Util::FieldHash=fieldhash -e 'fieldhash %SIG; @a = %SIG = (A => sub { })'
segfaults with backtrace
Program received signal SIGSEGV\, Segmentation fault. 0x00000000004788fe in S_magic_methcall (sv=0x12a6d00\, mg=0x0\, meth=0x5a2c13 "EXISTS"\, flags=0\, n=2\, val=0x0) at mg.c:1605 1605 PUSHs(SvTIED_obj(sv\, mg)); (gdb) bt #0 0x00000000004788fe in S_magic_methcall (sv=0x12a6d00\, mg=0x0\, meth=0x5a2c13 "EXISTS"\, flags=0\, n=2\, val=0x0) at mg.c:1605 #1 0x0000000000478bdf in S_magic_methpack (sv=0x12a6d00\, mg=0x0\, meth=0x5a2c13 "EXISTS") at mg.c:1634 #2 0x0000000000479ea6 in Perl_magic_existspack (sv=0x12a6d00\, mg=0x0) at mg.c:1738 #3 0x0000000000482178 in Perl_hv_common (hv=0x1292ce0\, keysv=0x12a6940\, key=0x1258170 "A"\, klen=1\, flags=0\, action=8\, val=0x0\, hash=0) at hv.c:486 #4 0x0000000000499932 in Perl_pp_aassign () at pp_hot.c:1057 #5 0x000000000046beef in Perl_runops_debug () at dump.c:1931 #6 0x000000000048f677 in S_run_body (oldscope=1) at perl.c:2384 #7 0x000000000048f133 in perl_run (my_perl=0x1238010) at perl.c:2302 #8 0x000000000041f8dd in main (argc=4\, argv=0x7fffa4ab6b08\, env=0x7fffa4ab6b30) at perlmain.c:113 (gdb) call Perl_sv_dump(sv) SV = NULL(0x0) at 0x12a6d00 REFCNT = 1 FLAGS = (TEMP) (gdb) p mg $1 = (const MAGIC *) 0x0 (gdb) up 3 #3 0x0000000000482178 in Perl_hv_common (hv=0x1292ce0\, keysv=0x12a6940\, key=0x1258170 "A"\, klen=1\, flags=0\, action=8\, val=0x0\, hash=0) at hv.c:486 486 magic_existspack(svret\, mg_find(sv\, PERL_MAGIC_tiedelem)); (gdb) l 481 } else { 482 mg_copy((SV*)hv\, sv\, key\, klen); 483 } 484 if (flags & HVhek_FREEKEY) 485 Safefree(key); 486 magic_existspack(svret\, mg_find(sv\, PERL_MAGIC_tiedelem)); 487 /* This cast somewhat evil\, but I'm merely using NULL/ 488 not NULL to return the boolean exists. 489 And I know hv is not NULL. */ 490 return SvTRUE(svret) ? (void *)hv : NULL; (gdb) l 470 465 } /* ISFETCH */ 466 else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { 467 if (mg_find((SV*)hv\, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { 468 /* I don't understand why hv_exists_ent has svret and sv\, 469 whereas hv_exists only had one. */ 470 SV * const svret = sv_newmortal(); 471 sv = sv_newmortal(); 472 473 if (keysv || is_utf8) { 474 if (!keysv) { (gdb) call Perl_sv_dump(hv) SV = PVHV(0x12428a0) at 0x1292ce0 REFCNT = 1 FLAGS = (GMG\,SMG\,RMG\,SHAREKEYS) MAGIC = 0x1257f50 MG_VIRTUAL = &PL_vtbl_uvar MG_TYPE = PERL_MAGIC_uvar(U) MG_LEN = 24 MG_PTR = 0x125aab0 "\332`f\233\225\177\0\0\0\0\0\0\0\0\0\0\10\0\0\0\0\0\0\0" MAGIC = 0x12a6060 MG_VIRTUAL = &PL_vtbl_sig MG_TYPE = PERL_MAGIC_sig(S) ARRAY = 0x12aa1f0 KEYS = 0 FILL = 0 MAX = 127 RITER = -1 EITER = 0x0
What happens is that %SIG originally has RMG set\, because sig magic doesn't have set/get magic callbacks. When uvar magic is applied on it with fieldhash()\, GMG is also set. If %SIG is assigned in list context\, pp_aassign calls exist ; and since SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS) && SvGMAGICAL((SV*)hv) is true\, the hash is wrongly handled as a tied hash.
A first memory misread happens with mg_find(sv\, PERL_MAGIC_tiedelem)\, because sv is not a PVMG (mg_copy couldn't upgrade it since there's no copy magic in this case). This doesn't cause the segfault in this example\, but it's still wrong. And even if this would be right\, SvTIED_obj(sv\, mg) segvs later because mg (which should be the tied magic token) is righteously NULL.
This example is pretty unlikely to happen in real life\, but this problem applies also to any extension magic that has both get and clear callbacks (which I think is quite reasonable).
Vincent.
Migrated from rt.perl.org#62486 (status was 'open')
Searchable as RT62486$