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

tie *ARGV{SCALAR} + <> + undef *ARGV = crash, Perl_nextargv #13408

Open
p5pRT opened this issue Nov 10, 2013 · 3 comments
Open

tie *ARGV{SCALAR} + <> + undef *ARGV = crash, Perl_nextargv #13408

p5pRT opened this issue Nov 10, 2013 · 3 comments

Comments

@p5pRT
Copy link

p5pRT commented Nov 10, 2013

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

Searchable as RT120502$

@p5pRT
Copy link
Author

p5pRT commented Nov 10, 2013

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 <Bad Ptr> } hek *
---------------------------------------------------
gp_sv is NULL.

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.

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl 5.19.6:

Configured by Owner at Sat Nov  9 01:09:06 2013.

Summary of my perl5 (revision 5 version 19 subversion 6) configuration:
  Local Commit: 4db2be0644a9380878a0eb2eab262a09ee7b520f
  Ancestor: ea238638ab35cef3a59dff8b7a19970b7d76c1fd
  Platform:
    osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
    use64bitint=undef, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -GF -W3 -Od -MD -Zi -DDEBUGGING -DWIN32 
-D_CONSOLE -DNO_STRICT  -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT 
-DPERL_IMPLICIT_SYS -DUSE_PERLIO -D_USE_32BIT_TIME_T',
    optimize='-Od -MD -Zi -DDEBUGGING',
    cppflags='-DWIN32'
    ccversion='12.00.8168', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', 
lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug  
-libpath:"c:\perl519\lib\CORE"  -machine:x86'
    libpth=C:\PROGRA~1\MIAF9D~1\VC98\lib
    libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  
netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib 
odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib 
winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib 
oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  
version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl519.lib
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug  
-libpath:"c:\perl519\lib\CORE"  -machine:x86'

Locally applied patches:
    461c7b21c26bf26659af04213a80fc3135f5c7ac
    0c661792bbd9b65224b5e258405288b6feabea69
    4db2be0644a9380878a0eb2eab262a09ee7b520f


@INC for perl 5.19.6:
    ..\lib
    C:/perl519/src/t/lib
    .


Environment for perl 5.19.6:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=rmved
    PERL_BADLANG (unset)
    PERL_JSON_BACKEND=JSON::XS
    PERL_YAML_BACKEND=YAML
    SHELL (unset)


@p5pRT
Copy link
Author

p5pRT commented Nov 10, 2013

From @cpansprout

On Sat Nov 09 18​:38​:59 2013, bulk88 wrote​:

while \(av\_len\(GvAV\(gv\)\) >= 0\) \{  /////////why not just an av\_shift 

and compare to PL_sv_undef?

That would change the behaviour after $#ARGV++, I think.

    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

Yes, that code is awful.

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 would say, yes, fix it, but it is not high priority. These types of crashes tend to show up in corner cases involving 30 modules. It is just a matter of time. :-)

I dont have any ideas how to fix this,

I would suggest doing GvSVn once and saving the value to an auto. Also SvREFCNT_inc and sv_2mortal.

If someone undefines *ARGV then it is his own fault if he cannot get to $ARGV.

and if it is appropriate to fix
this in the first place. What if ARGV is deleted from main​:: stash?

PL_argvgv is refcounted as of v5.19.5-75-g722fa0e to solve this sort of thing.

What
if @​ARGV is tied?

And SHIFT undefines *ARGV? Ouch.

What about messing with *ARGVOUT and undefing it (it
too could be susceptible because of )?

I don’t *think* that would crash.

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)?

Ouch.

What if $ARGV is blessed?

Blessings would not hurt, but what if $ARGV were tied and its set-magic undefined *ARGV? Then the SvPVx on the next line would crash.

I wont mention the existence of overload since
that is too complicated for me to explore.

SvPV would trigger overloading, just as it triggers get-magic.

--

Father Chrysostomos

@p5pRT
Copy link
Author

p5pRT commented Nov 10, 2013

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant