p5pRT
commented
10 years ago From @bulk88
Created by @bulk88
I was trying to write a patch for my own ticket #115860 "multiple evaluation problems in Perl_nextargv". In the process\, all the derefs and magic calls started looking strange to me. See comments in code sample of my ideas to refactor the area and location of crash sample script makes.
------------------------------------------ PerlIO * Perl_nextargv(pTHX_ GV *gv) { dVAR; SV *sv; #ifndef FLEXFILENAMES int filedev; int fileino; #endif Uid_t fileuid; Gid_t filegid; IO * const io = GvIOp(gv);
PERL_ARGS_ASSERT_NEXTARGV;
if (!PL_argvoutgv) PL_argvoutgv = gv_fetchpvs("ARGVOUT"\, GV_ADD|GV_NOTQUAL\, SVt_PVIO); if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) { IoFLAGS(io) &= ~IOf_START; if (PL_inplace) { assert(PL_defoutgv); Perl_av_create_and_push(aTHX_ &PL_argvout_stack\, SvREFCNT_inc_simple_NN(PL_defoutgv)); } } if (PL_filemode & (S_ISUID|S_ISGID)) { PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */ #ifdef HAS_FCHMOD if (PL_lastfd != -1) (void)fchmod(PL_lastfd\,PL_filemode); #else (void)PerlLIO_chmod(PL_oldname\,PL_filemode); #endif } PL_lastfd = -1; PL_filemode = 0; if (!GvAV(gv)) return NULL; while (av_len(GvAV(gv)) >= 0) { /////////why not just an av_shift and compare to PL_sv_undef? STRLEN oldlen; sv = av_shift(GvAV(gv)); SAVEFREESV(sv); SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */ \<\<\<\<\<\<\<\<\<\< make SCALAR once\, but taint is a flag in mg struct\, not general get magic call sv_setsv(GvSVn(gv)\,sv); \<\<\<\<\<\<\<\<\<\< make SCALAR again (but it was just made!!!!\, unless getmagic on a slice of @ARGV undefs/replaces/nulls out something the *ARGV{SCALAR}\, but sv_setsv probably would crash at that point since dest SV was freed after the get magic call inside sv_setsv) SvSETMAGIC(GvSV(gv)); ///// deref the GV again? could SCALAR really have changed but not be null? replace with sv_setsv_mg??? //////////////line below is crash SV slot in the GV is NULL PL_oldname = SvPVx(GvSV(gv)\, oldlen); /// GvSV(gv) doesn't have side effects\, SvPVx writes to interp * global unefficienct on non-GCC extensions compilers\, replace with SvPV if (do_open(gv\,PL_oldname\,oldlen\,PL_inplace!=0\,O_RDONLY\,0\,NULL)) { ------------------------------------------
So I tried to write a sample script to see if I can ref count crash it. My Perl typeglob syntax knowledge isn't good\, so I couldn't figure out a way to selectively remove {SCALAR} slice of *ARGV (NULL on Peek's Dump()). Script below segvs by derefing NULL.
---------------------------------------------------- package NewStdScalar; require Tie::Scalar; @ISA = qw(Tie::StdScalar); #use Devel::Peek 'Dump';
#sub FETCH { # return ${$_[0]}; #} # sub STORE { #Dump(*ARGV{SCALAR}); ${$_[0]} = $_[1]; #Dump(*ARGV); undef(*ARGV); #*ARGV = *FOO; #this also crashes #Dump(*ARGV); #Dump(*ARGV{SCALAR}); } package main;
die 'I need atleast 1 param in @ARGV to crash' if @ARGV == 0; tie(${*ARGV{SCALAR}}\, 'NewStdScalar'); while (\<>) { 0; } ----------------------------------------------------
var gv is
---------------------------------------------------
+ sv_any 0x008f27e4 {xmg_stash=0x00000000 {sv_any=???
sv_refcnt=??? sv_flags=??? ...} xmg_u={xmg_magic=0x00000000
{mg_moremagic=??? mg_virtual=??? mg_private=??? ...}
xmg_ourstash=0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...}
xmg_hash_index=0 } xpv_cur=10 ...} xpvgv *
sv_refcnt 6 unsigned long
sv_flags 163849 unsigned long
- sv_u {svu_pv=0x00900acc "" svu_iv=9439948 svu_uv=9439948 ...}
__unnamed
+ svu_pv 0x00900acc "" char *
svu_iv 9439948 long
svu_uv 9439948 unsigned long
+ svu_rv 0x00900acc {sv_any=0x00000000 sv_refcnt=0 sv_flags=0
...} sv *
+ svu_rx 0x00900acc {xmg_stash=0x00000000 {sv_any=???
sv_refcnt=??? sv_flags=??? ...} xmg_u={xmg_magic=0x00000000
{mg_moremagic=??? mg_virtual=??? mg_private=??? ...}
xmg_ourstash=0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...}
xmg_hash_index=0 } xpv_cur=0 ...} regexp *
+ svu_array 0x00900acc sv * *
+ svu_hash 0x00900acc he * *
- svu_gp 0x00900acc {gp_sv=0x00000000 {sv_any=??? sv_refcnt=???
sv_flags=??? ...} gp_io=0x00000000 {sv_any=??? sv_refcnt=???
sv_flags=??? ...} gp_cv=0x00000000 {sv_any=??? sv_refcnt=???
sv_flags=??? ...} ...} gp *
+ gp_sv 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} sv *
+ gp_io 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} io *
+ gp_cv 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} cv *
gp_cvgen 0 unsigned long
gp_refcnt 1 unsigned long
+ gp_hv 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} hv *
+ gp_av 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} av *
+ gp_form 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=???
...} cv *
+ gp_egv 0x008fd534 {sv_any=0x008f27e4 {xmg_stash=0x00000000
{sv_any=??? sv_refcnt=??? sv_flags=??? ...} xmg_u={xmg_magic=0x00000000
{mg_moremagic=??? mg_virtual=??? mg_private=??? ...}
xmg_ourstash=0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...}
xmg_hash_index=0 } xpv_cur=10 ...} sv_refcnt=6 sv_flags=163849 ...} gv *
gp_line 14 unsigned long
+ gp_file_hek 0x00000000 {hek_hash=??? hek_len=???
hek_key=0x00000008 \
since this is SvPVx call\, which is uses ISv -------------------------------------------------- + ISv 0x00000000 {sv_any=??? sv_refcnt=??? sv_flags=??? ...} sv * --------------------------------------------------
crash happens in "PL_oldname = SvPVx(GvSV(gv)\, oldlen);"
C call stack --------------------------------------------------
perl519.dll!Perl_nextargv(interpreter * my_perl=0x00366014\, gv * gv=0x008fd534) Line 760 + 0x1a C perl519.dll!Perl_do_readline(interpreter * my_perl=0x00366014)
Line 1555 + 0x13 C perl519.dll!Perl_pp_readline(interpreter * my_perl=0x00366014)
Line 447 + 0x9 C perl519.dll!Perl_runops_debug(interpreter * my_perl=0x00366014)
Line 2274 + 0xd C perl519.dll!S_run_body(interpreter * my_perl=0x00366014\, long oldscope=1) Line 2433 + 0xd C perl519.dll!perl_run(interpreter * my_perl=0x00366014) Line 2352 C perl519.dll!RunPerl(int argc=4\, char * * argv=0x003639b8\, char * * env=0x003653a0) Line 270 + 0xc C++ perl.exe!main(int argc=4\, char * * argv=0x003639b8\, char * * env=0x00362df8) Line 23 + 0x12 C perl.exe!_mainCRTStartup() + 0xe3
kernel32.dll!_BaseProcessStart@4() + 0x23
-------------------------------------------------
So\, is there any point in fixing this or is this a wont fix since tying then playing with symbol table in the tie meth call has no useful purpose?
I dont have any ideas how to fix this\, and if it is appropriate to fix this in the first place. What if ARGV is deleted from main:: stash? What if @ARGV is tied? What about messing with *ARGVOUT and undefing it (it too could be susceptible because of )? What if blessed refs are placed in @ARGV (the user wants file "SCALAR(0x8fda54)" to be opened) and their destructors run (another way to call Pure Perl at unexpected places)? What if $ARGV is blessed? I wont mention the existence of overload since that is too complicated for me to explore.
Migrated from rt.perl.org#120502 (status was 'open')
Searchable as RT120502$