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

croak crashd when shifting @ARGV #8774

Closed
p5pRT opened this issue Feb 15, 2007 · 9 comments
Closed

croak crashd when shifting @ARGV #8774

p5pRT opened this issue Feb 15, 2007 · 9 comments

Comments

@p5pRT
Copy link

p5pRT commented Feb 15, 2007

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

Searchable as RT41512$

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2007

From delphi@alberta.botik.ru

Created by delphi@alberta.botik.ru

Perl Info

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.8:

Configured by Debian Project at Wed Dec  6 23:17:41 UTC 2006.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
  Platform:
    osname=linux, osvers=2.6.18.3, archname=i486-linux-gnu-thread-multi
    uname='linux saens 2.6.18.3 #1 smp sat nov 25 13:39:52 est 2006 i686 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=i486-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.8 -Darchlib=/usr/lib/perl/5.8 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.8.8 -Dsitearch=/usr/local/lib/perl/5.8.8 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Uusesfio -Uusenm -Duseshrplib -Dlibperl=libperl.so.5.8.8 -Dd_dosuid -des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=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='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBIAN -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='4.1.2 20061115 (prerelease) (Debian 4.1.1-20)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=/lib/libc-2.3.6.so, so=so, useshrplib=true, libperl=libperl.so.5.8.8
    gnulibc_version='2.3.6'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.8:
    /etc/perl
    /usr/local/lib/perl/5.8.8
    /usr/local/share/perl/5.8.8
    /usr/lib/perl5
    /usr/share/perl5
    /usr/lib/perl/5.8
    /usr/share/perl/5.8
    /usr/local/lib/site_perl
    /usr/local/lib/perl/5.8.0
    /usr/local/share/perl/5.8.0
    .


Environment for perl v5.8.8:
    HOME=/home/delphi
    LANG=ru_RU.KOI8-R
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin:/usr/games:/usr/X11R6/bin:/home/delphi/docs/soft/OpenWrt-SDK-Linux-i686-1/staging_dir_mipsel/bin
    PERL_BADLANG (unset)
    SHELL=/bin/zsh

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2007

From @nwc10

On Thu, Feb 15, 2007 at 05​:25​:03AM -0800, delphi @​ alberta. botik. ru wrote​:

# New Ticket Created by delphi@​alberta.botik.ru
# Please include the string​: [perl #41512]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=41512 >

This is a bug report for perl from delphi@​alberta.botik.ru,
generated with the help of perlbug 1.35 running under perl v5.8.8.

I`m try to run follow script - "perl ./script.pl 1 1 1"
and get bizarre message​:
"Bizarre copy of ARRAY in sassign at /usr/share/perl/5.8/Carp/Heavy.pm line
39."
If call main () whithout param @​ARGV all works fine.

Thanks for the report. I can replicated it in 5.8.8, but it's fixed in the
maintenance track now, so it will be fixed for 5.8.9
(Unless the change has to be backed out because it has nasty side effects
that are worse than this bug, but that is very unlikely)

I'm not sure what the actual code change was that fixed this.

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2007

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

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2007

From @andk

On Thu, 15 Feb 2007 18​:37​:51 +0000, Nicholas Clark <nick@​ccl4.org> said​:

  > On Thu, Feb 15, 2007 at 05​:25​:03AM -0800, delphi @​ alberta. botik. ru wrote​:

# New Ticket Created by delphi@​alberta.botik.ru
# Please include the string​: [perl #41512]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=41512 >

This is a bug report for perl from delphi@​alberta.botik.ru,
generated with the help of perlbug 1.35 running under perl v5.8.8.

I`m try to run follow script - "perl ./script.pl 1 1 1"
and get bizarre message​:
"Bizarre copy of ARRAY in sassign at /usr/share/perl/5.8/Carp/Heavy.pm line
39."
If call main () whithout param @​ARGV all works fine.

  > Thanks for the report. I can replicated it in 5.8.8, but it's fixed in the
  > maintenance track now, so it will be fixed for 5.8.9
  > (Unless the change has to be backed out because it has nasty side effects
  > that are worse than this bug, but that is very unlikely)

  > I'm not sure what the actual code change was that fixed this.

Just for the record, according to my binary searches in bleadperl the
fix seemed to come with 28330. And while we are at it, the error
started to show up with 26373.

--
andreas

@p5pRT
Copy link
Author

p5pRT commented Feb 15, 2007

From @nwc10

On Thu, Feb 15, 2007 at 11​:38​:16PM +0100, Andreas J. Koenig wrote​:

On Thu, 15 Feb 2007 18​:37​:51 +0000, Nicholas Clark <nick@​ccl4.org> said​:

On Thu, Feb 15, 2007 at 05​:25​:03AM -0800, delphi @​ alberta. botik. ru wrote​:

# New Ticket Created by delphi@​alberta.botik.ru
# Please include the string​: [perl #41512]
# in the subject line of all future correspondence about this issue.
# <URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=41512 >

This is a bug report for perl from delphi@​alberta.botik.ru,
generated with the help of perlbug 1.35 running under perl v5.8.8.

I`m try to run follow script - "perl ./script.pl 1 1 1"
and get bizarre message​:
"Bizarre copy of ARRAY in sassign at /usr/share/perl/5.8/Carp/Heavy.pm line
39."
If call main () whithout param @​ARGV all works fine.

Thanks for the report. I can replicated it in 5.8.8, but it's fixed in the
maintenance track now, so it will be fixed for 5.8.9
(Unless the change has to be backed out because it has nasty side effects
that are worse than this bug, but that is very unlikely)

I'm not sure what the actual code change was that fixed this.

Just for the record, according to my binary searches in bleadperl the
fix seemed to come with 28330. And while we are at it, the error
started to show up with 26373.

Thanks. That is most strange. Why should the 26373 have that side effect?
It doesn't appear to manipulate the stack, or call any API that would tinker
with perl visible data.

I wonder if change 28330 only fixed the symptom​:

@​@​ -28,8 +28,18 @​@​
sub longmess { goto &longmess_jmp }
sub shortmess { goto &shortmess_jmp }
# these two are replaced when Carp​::Heavy is loaded
-sub longmess_jmp {{ local($@​, $!); require Carp​::Heavy} goto &longmess_jmp}
-sub shortmess_jmp {{ local($@​, $!); require Carp​::Heavy} goto &shortmess_jmp}
+sub longmess_jmp {
+ local($@​, $!);
+ eval { require Carp​::Heavy };
+ return $@​ if $@​;
+ goto &longmess_jmp;
+}
+sub shortmess_jmp {
+ local($@​, $!);
+ eval { require Carp​::Heavy };
+ return $@​ if $@​;
+ goto &shortmess_jmp;
+}

( http​://public.activestate.com/cgi-bin/perlbrowse?patch_num=28330&show_patch=Show+Patch )

Nicholas Clark

Change 26373 by stevep@​stevep-mccoy on 2005/12/15 17​:48​:42

  Prevent require() from attempting to open directories and block
  devices. This fixes RT #24404.

Affected files ...

... //depot/perl/embed.fnc#287 edit
... //depot/perl/embed.h#538 edit
... //depot/perl/pp_ctl.c#497 edit
... //depot/perl/proto.h#634 edit

Differences ...

==== //depot/perl/embed.fnc#287 (text) ====

@​@​ -1178,6 +1178,7 @​@​
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
s |void |save_lines |NULLOK AV *array|NN SV *sv
sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq
+sR |PerlIO *|check_type_and_open|NN const char *name|NN const char *mode
sR |PerlIO *|doopen_pm |NN const char *name|NN const char *mode
sR |bool |path_is_absolute|NN const char *name
sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen

==== //depot/perl/embed.h#538 (text+w) ====

@​@​ -1198,6 +1198,7 @​@​
#define dopoptosub_at S_dopoptosub_at
#define save_lines S_save_lines
#define doeval S_doeval
+#define check_type_and_open S_check_type_and_open
#define doopen_pm S_doopen_pm
#define path_is_absolute S_path_is_absolute
#define run_user_filter S_run_user_filter
@​@​ -3208,6 +3209,7 @​@​
#define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b)
#define save_lines(a,b) S_save_lines(aTHX_ a,b)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
+#define check_type_and_open(a,b) S_check_type_and_open(aTHX_ a,b)
#define doopen_pm(a,b) S_doopen_pm(aTHX_ a,b)
#define path_is_absolute(a) S_path_is_absolute(aTHX_ a)
#define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c)

==== //depot/perl/pp_ctl.c#497 (text) ====

@​@​ -2980,6 +2980,23 @​@​
}

STATIC PerlIO *
+S_check_type_and_open(pTHX_ const char *name, const char *mode)
+{
+ Stat_t st;
+ int st_rc;
+ st_rc = PerlLIO_stat(name, &st);
+ if (st_rc < 0) {
+ return Nullfp;
+ }
+
+ if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+ Perl_die(aTHX_ "%s %s not allowed in require",
+ S_ISDIR(st.st_mode) ? "Directory" : "Block device", name);
+ }
+ return PerlIO_open(name, mode);
+}
+
+STATIC PerlIO *
S_doopen_pm(pTHX_ const char *name, const char *mode)
{
#ifndef PERL_DISABLE_PMC
@​@​ -2991,27 +3008,27 @​@​
  const char * const pmc = SvPV_nolen_const(pmcsv);
  Stat_t pmcstat;
  if (PerlLIO_stat(pmc, &pmcstat) < 0) {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
  }
  else {
  Stat_t pmstat;
  if (PerlLIO_stat(name, &pmstat) < 0 ||
  pmstat.st_mtime < pmcstat.st_mtime)
  {
- fp = PerlIO_open(pmc, mode);
+ fp = check_type_and_open(aTHX_ pmc, mode);
  }
  else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
  }
  }
  SvREFCNT_dec(pmcsv);
  }
  else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
  }
  return fp;
#else
- return PerlIO_open(name, mode);
+ return check_type_and_open(aTHX_ name, mode);
#endif /* !PERL_DISABLE_PMC */
}

==== //depot/perl/proto.h#634 (text+w) ====

@​@​ -3285,6 +3285,11 @​@​
STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
  __attribute__warn_unused_result__;

+STATIC PerlIO * S_check_type_and_open(pTHX_ const char *name, const char *mode)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+
STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode)
  __attribute__warn_unused_result__
  __attribute__nonnull__(pTHX_1)

@p5pRT
Copy link
Author

p5pRT commented Feb 14, 2009

From p5p@spam.wizbit.be

On Thu Feb 15 10​:38​:33 2007, nicholas wrote​:

On Thu, Feb 15, 2007 at 05​:25​:03AM -0800, delphi @​ alberta. botik. ru
wrote​:

# New Ticket Created by delphi@​alberta.botik.ru
# Please include the string​: [perl #41512]
# in the subject line of all future correspondence about this
issue.
# <URL​: http​://rt.perl.org/rt3/Ticket/Display.html?id=41512 >

This is a bug report for perl from delphi@​alberta.botik.ru,
generated with the help of perlbug 1.35 running under perl v5.8.8.

I`m try to run follow script - "perl ./script.pl 1 1 1"
and get bizarre message​:
"Bizarre copy of ARRAY in sassign at
/usr/share/perl/5.8/Carp/Heavy.pm line
39."
If call main () whithout param @​ARGV all works fine.

Thanks for the report. I can replicated it in 5.8.8, but it's fixed
in
the
maintenance track now, so it will be fixed for 5.8.9
(Unless the change has to be backed out because it has nasty side
effects
that are worse than this bug, but that is very unlikely)

I'm not sure what the actual code change was that fixed this.

This wasn't fixed, it was just a bit harder to trigger.

Try​:

#!/usr/bin/perl -w

use Carp qw(croak);

sub parse_args
{
  while (defined ($_ = shift @​ARGV)) {
  my $h = {};
  croak "test";
  }
}

sub main
{
  parse_args ();
}

main (@​ARGV);
__END__

$ perl-5.8.9 rt-41512.pl aa
Bizarre copy of HASH in sassign at /opt/perl/5.8.9/lib/5.8.9/Carp/
Heavy.pm line 104.

The real issue is passing an array and then modifiying original array
in the subroutine that was called. This corrupts the stack since it
doesn't do ref counting.

More information in http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

Kind regards,

Bram

@p5pRT
Copy link
Author

p5pRT commented Oct 10, 2009

From @obra

Original issue resolved, but the deeper problem is being tracked in
http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

@p5pRT
Copy link
Author

p5pRT commented Oct 10, 2009

@obra - Status changed from 'open' to 'resolved'

@p5pRT p5pRT closed this as completed Oct 10, 2009
@p5pRT
Copy link
Author

p5pRT commented Oct 10, 2009

From @obra

Original issue resolved, but the deeper problem is being tracked in
http​://rt.perl.org/rt3/Ticket/Display.html?id=52610

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

No branches or pull requests

1 participant