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

'eval'ing a certain format string segfaults perl #9375

Closed
p5pRT opened this issue Jun 12, 2008 · 10 comments
Closed

'eval'ing a certain format string segfaults perl #9375

p5pRT opened this issue Jun 12, 2008 · 10 comments

Comments

@p5pRT
Copy link

p5pRT commented Jun 12, 2008

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

Searchable as RT55668$

@p5pRT
Copy link
Author

p5pRT commented Jun 12, 2008

From kantor@cs.wisc.edu

Created by kantor@cs.wisc.edu

The following program segfaults perl​:

The error has something to do with escaping the $ sign in \$oSpec).

The test case follows​:

#!/usr/bin/perl -w
use strict;

my $optSpec = [
  ["help|h",
  "",
  "print this help message"],
  ["dataDir|d=s",
  "/cworkspace/ifp-32-2/hasegawa/data/telephone/eng/fisher1",
  "The corpus data dir"]
];

printDocOptions($optSpec);

sub printDocOptions{
  my ($optSpec) = @​_;

  print "Options​:\n";
  #TODO make the options spec display
  my $maxOptLength=0;
  foreach my $o (@​$optSpec){
  $maxOptLength =length($o->[0]) if($maxOptLength <
length($o->[0])) ;
  }

  my ($oSpec, $oDefault, $oDesc);
  my $format = "format STDOUT = \n"
  . ' ^' . '<' x $maxOptLength . "\n"
  . '\$oSpec' . "\n"
  . ' ' . ' ' x $maxOptLength . "^* ~~\n"
  . '\$oDesc' . "\n"
  . ".\n";
  print $format;
  eval $format;
  die $@​ if $@​;

  foreach my $o (@​$optSpec){
  ($oSpec, $oDefault, $oDesc) = @​$o;
  write;
  }

  return "";
}

Perl Info

Flags:
    category=core
    severity=medium

This perlbug was built using Perl v5.8.8 in the Red Hat build system.
It is being executed now by Perl v5.8.8 - Tue Apr 29 02:54:41 EDT 2008.

Site configuration information for perl v5.8.8:

Configured by Red Hat, Inc. at Tue Apr 29 02:54:41 EDT 2008.

Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
  Platform:
    osname=linux, osvers=2.6.18-53.1.14.el5xen, 
archname=i386-linux-thread-multi
    uname='linux xenbuilder2.fedora.redhat.com 2.6.18-53.1.14.el5xen #1 
smp tue feb 19 07:33:17 est 2008 i686 i686 i386 gnulinux '
    config_args='-des -Doptimize=-O2 -g -pipe -Wall 
-Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector 
--param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic 
-fasynchronous-unwind-tables -Dversion=5.8.8 -Dmyhostname=localhost 
-Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. 
-Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux 
-Dvendorprefix=/usr -Dsiteprefix=/usr -Duseshrplib -Dusethreads 
-Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db 
-Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio 
-Dinstallusrbinperl=n -Ubincompat5005 -Uversiononly 
-Dpager=/usr/bin/less -isr -Dd_gethostent_r_proto -Ud_endhostent_r_proto 
-Ud_sethostent_r_proto -Ud_endprotoent_r_proto -Ud_setprotoent_r_proto 
-Ud_endservent_r_proto -Ud_setservent_r_proto -Dinc_version_list=5.8.7 
5.8.6 5.8.5 -Dscriptdir=/usr/bin'
    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='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing 
-pipe -Wdeclaration-after-statement -I/usr/local/include 
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='-O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions 
-fstack-protector --param=ssp-buffer-size=4 -m32 -march=i386 
-mtune=generic -fasynchronous-unwind-tables',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -fno-strict-aliasing -pipe 
-Wdeclaration-after-statement -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='4.1.2 20070925 (Red Hat 4.1.2-33)', 
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='gcc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lresolv -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc
    perllibs=-lresolv -lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
    libc=/lib/libc-2.7.so, so=so, useshrplib=true, libperl=libperl.so
    gnulibc_version='2.7'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E 
-Wl,-rpath,/usr/lib/perl5/5.8.8/i386-linux-thread-multi/CORE'
    cccdlflags='-fPIC', lddlflags='-shared -O2 -g -pipe -Wall 
-Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector 
--param=ssp-buffer-size=4 -m32 -march=i386 -mtune=generic 
-fasynchronous-unwind-tables -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.8:
    /usr/lib/perl5/site_perl/5.8.8/i386-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.7/i386-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.6/i386-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.5/i386-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.8
    /usr/lib/perl5/site_perl/5.8.7
    /usr/lib/perl5/site_perl/5.8.6
    /usr/lib/perl5/site_perl/5.8.5
    /usr/lib/perl5/site_perl
    /usr/lib/perl5/vendor_perl/5.8.8/i386-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.7/i386-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.6/i386-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.5/i386-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.8
    /usr/lib/perl5/vendor_perl/5.8.7
    /usr/lib/perl5/vendor_perl/5.8.6
    /usr/lib/perl5/vendor_perl/5.8.5
    /usr/lib/perl5/vendor_perl
    /usr/lib/perl5/5.8.8/i386-linux-thread-multi
    /usr/lib/perl5/5.8.8
    .


Environment for perl v5.8.8:
    HOME=/home/arthur
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    
PATH=/usr/kerberos/bin:/usr/local/bin:/usr/bin:/bin:/usr/X11R6/bin:/home/arthur/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

@p5pRT
Copy link
Author

p5pRT commented Jun 12, 2008

From @chorny

This program does not segfault on 5.10.0 (Strawberry Perl on Win32)
and segfaults on 5.8.8 (ActiveState and Vanilla).
On 5.10.0 error is "Runaway format at (eval 1) line 5.".

2008/6/12 via RT Arthur Kantor <perlbug-followup@​perl.org>​:

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

This is a bug report for perl from kantor@​cs.wisc.edu,
generated with the help of perlbug 1.35 running under perl v5.8.8.

-----------------------------------------------------------------
[Please enter your report here]

The following program segfaults perl​:

The error has something to do with escaping the $ sign in \$oSpec).

The test case follows​:

#!/usr/bin/perl -w
use strict;

my $optSpec = [
["help|h",
"",
"print this help message"],
["dataDir|d=s",
"/cworkspace/ifp-32-2/hasegawa/data/telephone/eng/fisher1",
"The corpus data dir"]
];

printDocOptions($optSpec);

sub printDocOptions{
my ($optSpec) = @​_;

   print "Options&#8203;:\\n";
   \#TODO make the options spec display
   my $maxOptLength=0;
   foreach my $o \(@&#8203;$optSpec\)\{
           $maxOptLength =length\($o\->\[0\]\) if\($maxOptLength \<

length($o->[0])) ;
}

   my \($oSpec\, $oDefault\, $oDesc\);
   my $format  = "format STDOUT = \\n"
           \. '  ^' \. '\<' x $maxOptLength \. "\\n"
           \. '\\$oSpec' \. "\\n"
           \. '    ' \. ' ' x $maxOptLength \. "^\*  ~~\\n"
           \. '\\$oDesc' \. "\\n"
           \. "\.\\n";
   print $format;
   eval $format;
   die $@&#8203; if $@&#8203;;


   foreach my $o \(@&#8203;$optSpec\)\{
           \($oSpec\, $oDefault\, $oDesc\) = @&#8203;$o;
           write;
   \}


   return "";

}

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags​:
category=core
severity=medium
---
This perlbug was built using Perl v5.8.8 in the Red Hat build system.
It is being executed now by Perl v5.8.8 - Tue Apr 29 02​:54​:41 EDT 2008.

--
Alexandr Ciornii, http​://chorny.net

@p5pRT
Copy link
Author

p5pRT commented Jun 12, 2008

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

@p5pRT
Copy link
Author

p5pRT commented Jun 28, 2008

From @nwc10

On Thu, Jun 12, 2008 at 08​:03​:56PM +0300, Alexandr Ciornii wrote​:

This program does not segfault on 5.10.0 (Strawberry Perl on Win32)
and segfaults on 5.8.8 (ActiveState and Vanilla).
On 5.10.0 error is "Runaway format at (eval 1) line 5.".

It still seems to be a real bug. On blead, with all the assertions enabled​:

(gdb) r
Starting program​: /Volumes/Stuff/p4perl/perl/perl -Ilib /Users/nick/p4perl/perl/55668
Reading symbols for shared libraries +++. done
Options​:
format STDOUT =
  ^<<<<<<<<<<<
\$oSpec
  ^* ~~
\$oDesc
.
Assertion failed​: (SvTYPE(sv) >= SVt_PV), function Perl_pp_formline, file pp_ctl.c, line 801.

Program received signal SIGABRT, Aborted.
0x00007fff81917dd6 in __kill ()
(gdb) up
#1 0x00007fff81990c99 in abort ()
(gdb) up
#2 0x00007fff81983bdd in __assert_rtn ()
(gdb) up
#3 0x000000010024dd62 in Perl_pp_formline (my_perl=0x100800000) at pp_ctl.c​:801
warning​: Source file is more recent than executable.
801 SvCUR_set(sv, chophere - item);
(gdb) call Perl_sv_dump(my_perl, sv)
SV = IV(0x100823dc0) at 0x100823dc8
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x1008170e8
  SV = PV(0x100802040) at 0x1008170e8
  REFCNT = 4
  FLAGS = (PADMY,POK,pPOK)
  PV = 0x100511288 "print this help message"\0
  CUR = 23
  LEN = 24
(gdb) p chophere
$1 = 0x100511cf2 ""
(gdb) p item
$2 = 0x100511cdf "SCALAR(0x1008170e8)"
(gdb) p itemsize
$3 = 19

So it seems that the format code is assuming that it can set the length of
something that is not really a string, and coming unstuck. I'm not familiar
with the code, but it looks like the logic here with "oneline" could be
improved​:

  case FF_LINESNGL​:
  chopspace = 0;
  oneline = TRUE;
  goto ff_line;
  case FF_LINEGLOB​:
  oneline = FALSE;
  ff_line​:
  {
  const char *s = item = SvPV_const(sv, len);
  itemsize = len;
  if ((item_is_utf8 = DO_UTF8(sv)))
  itemsize = sv_len_utf8(sv);
  if (itemsize) {
  bool chopped = FALSE;
  const char *const send = s + len;
  gotsome = TRUE;
  chophere = s + itemsize;
  while (s < send) {
  if (*s++ == '\n') {
  if (oneline) {
  chopped = TRUE;
  chophere = s;
  break;
  } else {
  if (s == send) {
  itemsize--;
  chopped = TRUE;
  } else
  lines++;
  }
  }
  }
  SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
  if (targ_is_utf8)
  SvUTF8_on(PL_formtarget);
  if (oneline) {
  SvCUR_set(sv, chophere - item);
  sv_catsv(PL_formtarget, sv);
  SvCUR_set(sv, itemsize);
  } else
  sv_catsv(PL_formtarget, sv);
  if (chopped)
  SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
  SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
  t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
  if (item_is_utf8)
  targ_is_utf8 = TRUE;
  }
  break;
  }

specifically to avoid entering this if unless a '\n' was found​:

  if (oneline) {
  SvCUR_set(sv, chophere - item);
  sv_catsv(PL_formtarget, sv);
  SvCUR_set(sv, itemsize);
  } else

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented Jul 11, 2008

From @nwc10

formats consume their variables​:

$ cat eat.pl
#!perl -w

$a = <<'EOT';
Pie
Good
EOT

print $a;
print "...\n";

formline '^*', $a;

print $a;
__END__
$ perl eat.pl
Pie
Good
...
Good

What should the output of this be?

$ cat eat_overload.pl
#!perl -w
use strict;
package Pie;
use overload '""' => sub { return <<'EOT';
Pie
Good
EOT
};

sub new {
  bless [], shift;
}

package main;

$a = Pie->new;

print $a;
print "...\n";

formline '^*', $a;

print $a;
__END__

[No, I'm not going to give any clues. The current implementation is wrong, and
I don't know what the right answer is. Should the string return from an
overloaded reference be treated as a read only value?]

Nicholas Clark

@p5pRT
Copy link
Author

p5pRT commented May 19, 2014

From @khwilliamson

This is a naasty bug now in 5.20RC1 blead. It hangs my system, forcing me to press and hold the power button to get out of it. It's doing this in the write(). I presume it is gobbling up memory. valgrind doesn't show anything obvious.
--
Karl Williamson

@p5pRT
Copy link
Author

p5pRT commented May 20, 2014

From @jhi

On Monday-201405-19, 14​:47, Karl Williamson via RT wrote​:

This is a naasty bug now in 5.20RC1 blead. It hangs my system, forcing me to press and hold the power button to get out of it. It's doing this in the write(). I presume it is gobbling up memory. valgrind doesn't show anything obvious.

I tried whittling down the test code, attached is my current best.
Didn't touch the single remaining format line.

@p5pRT
Copy link
Author

p5pRT commented May 20, 2014

From @jhi

55668.pl

@p5pRT
Copy link
Author

p5pRT commented May 20, 2014

From @iabyn

On Mon, May 19, 2014 at 09​:44​:05PM -0400, Jarkko Hietaniemi wrote​:

On Monday-201405-19, 14​:47, Karl Williamson via RT wrote​:

This is a naasty bug now in 5.20RC1 blead. It hangs my system, forcing me to press and hold the power button to get out of it. It's doing this in the write(). I presume it is gobbling up memory. valgrind doesn't show anything obvious.

I tried whittling down the test code, attached is my current best.
Didn't touch the single remaining format line.

eval <<'__EOF__';
format STDOUT =
^* ~~
\$foo
.
__EOF__
write;

It's quite reasonable that this exhausts memory.

That format is is roughly equivalent to

  $output = '';
  $str = \$foo;
  do { $output .= $1; $str = \$foo } while $str =~ /^(.*)/;
  print $1;

i.e. its supposed to strip lines off the front of the string and append
them to the output, but the 'variable' it's modifying is actually a temp
ref which gets re-created each time, so you get an infinite loop and an
infinite tmps stack of temporary refs.

As to the older comments in the ticket about pp_formline being unable to
correctly handle non-PV vars, I completely revamped that code a few months
ago so it should be safe now.

So unless anyone can get blead to fail with anything other than an
out-of-memory condition, I think this ticket can be closed.

--
"Emacs isn't a bad OS once you get used to it.
It just lacks a decent editor."

@p5pRT
Copy link
Author

p5pRT commented Mar 29, 2017

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

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