From @jlokier

Created by @jlokier

The following code causes the error message "Attempt to free
unreferenced scalar at test.pl line 1."​:

  { local $handle = new (); undef; }
  sub TIEHANDLE { $_[1] }
  sub DESTROY { close $handle; }
  sub new {
  my $iosym = \*{"FOO"};
  delete ${"main​::"}{"FOO"};
  tie *$iosym, __PACKAGE__, (bless [], __PACKAGE__);
  *$iosym{IO};
  }

Although that test looks contrived and silly, it is the result of
pruning a real (and far too large to submit) program down to the
essential circumstances which trigger this bug.

The general problem appears to be that it the destructor, DESTROY,
calls anything which would re-enter the tied handle object, that
causes the error. That can be problematic when something like STDOUT
is tied, and DESTROY calls functions which try to print. In theory,
the methods of the tied handle (in the more complex program) will
detect reentrancy, but they don't get the chance.

The obvious workaround is to not call anything much from DESTROY. But
it shouldn't crash Perl or trash its heap.

When the real program runs, there are several messages like that, plus
some more​:

Attempt to free unreferenced scalar at httpd.pl line 516.
Attempt to free non-existent shared string 'content-length' during global destruction.
Unbalanced string table refcount​: (1) for "content-length" during global destruction.

A short while after comes "Segmentation fault".

Here is a test program which immediately triggers a segmentation fault​:

  { local $handle = new (); undef; }
  sub TIEHANDLE { $_[1] }
  sub CLOSE { close $handle; }
  sub DESTROY { close $handle; }
  sub new {
  my $iosym = \*{"FOO"};
  delete ${"main​::"}{"FOO"};
  tie *$iosym, __PACKAGE__, (bless [], __PACKAGE__);
  return *$iosym{IO};
  }

Thanks,
-- Jamie

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.8.0:

Configured by bhcompile'
cf_email='bhcompile at Wed Aug 13 11:45:59 EDT 2003.

Summary of my rderl (revision 5.0 version 8 subversion 0) configuration:
  Platform:
    osname=linux, osvers=2.4.21-1.1931.2.382.entsmp, archname=i386-linux-thread-multi
    uname='linux str'
    config_args='-des -Doptimize=-O2 -g -pipe -march=i386 -mcpu=i686 -Dmyhostname=localhost -Dperladmin=root@localhost -Dcc=gcc -Dcf_by=Red Hat, Inc. -Dinstallprefix=/usr -Dprefix=/usr -Darchname=i386-linux -Dvendorprefix=/usr -Dsiteprefix=/usr -Dotherlibdirs=/usr/lib/perl5/5.8.0 -Duseshrplib -Dusethreads -Duseithreads -Duselargefiles -Dd_dosuid -Dd_semctl_semun -Di_db -Ui_ndbm -Di_gdbm -Di_shadow -Di_syslog -Dman3ext=3pm -Duseperlio -Dinstallusrbinperl -Ubincompat5005 -Uversiononly -Dpager=/usr/bin/less -isr'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=define use5005threads=undef'
 useithreads=define usemultiplicity=
    useperlio= d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=un uselongdouble=
    usemymalloc=, bincompat5005=undef
  Compiler:
    cc='gcc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DTHREADS_HAVE_PIDS -DDEBUGGING -fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='3.2.2 20030222 (Red Hat Linux 3.2.2-5)', gccosandvers=''
gccversion='3.2.2 200302'
    intsize=r, longsize=r, ptrsize=5, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long'
k', ivsize=4'
ivtype='l, nvtype='double'
o_nonbl', nvsize=, Off_t='', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='gcc'
l', ldflags =' -L/u'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lgdbm -ldb -ldl -lm -lpthread -lc -lcrypt -lutil
    perllibs=
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=true, libperl=libper
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so', d_dlsymun=undef, ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.8.0/i386-linux-thread-multi/CORE'
    cccdlflags='-fPIC'
ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5', lddlflags='s Unicode/Normalize XS/A'

Locally applied patches:
    MAINT18379


@INC for perl v5.8.0:
    /usr/lib/perl5/5.8.0/i386-linux-thread-multi
    /usr/lib/perl5/5.8.0
    /usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi
    /usr/lib/perl5/site_perl/5.8.0
    /usr/lib/perl5/site_perl
    /usr/lib/perl5/vendor_perl/5.8.0/i386-linux-thread-multi
    /usr/lib/perl5/vendor_perl/5.8.0
    /usr/lib/perl5/vendor_perl
    /usr/lib/perl5/5.8.0/i386-linux-thread-multi
    /usr/lib/perl5/5.8.0
    .


Environment for perl v5.8.0:
    HOME=/home/jamie
    LANG=en_GB.UTF-8
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/usr/local/bin:/bin:/usr/bin:/usr/X11R6/bin:/home/jamie/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash
    dlflags='-share (unset)

From @iabyn

On Sun, Mar 14, 2004 at 03​:11​:25PM -0000, Jamie Lokier wrote​:

The following code causes the error message "Attempt to free
unreferenced scalar at test.pl line 1."​:

\{ local $handle = new \(\); undef; \}
sub TIEHANDLE \{ $\_\[1\] \}
sub DESTROY \{ close $handle; \}
sub new \{
my $iosym = \\\*\{"FOO"\};
delete $\{"main​::"\}\{"FOO"\};
tie \*$iosym\, \_\_PACKAGE\_\_\, \(bless \[\]\, \_\_PACKAGE\_\_\);
\*$iosym\{IO\};
\}

Thanks for the report. The heart of the fault turns out to be the way that
Perl restores local variables; it frees the old value before putting the
original value back into the variable; thus there is a small window (eg in
DESTROY) where the program can see the old value of the variable which is
currently being freed, and any attempt to do anything with it can result
in the 'Attempt to free unreferenced scalar' error or coredumps, as you've
found.

It can be triggered with the following even simpler code​:

  sub X​::DESTROY { $x=0 };
  { local $x = \ bless {}, 'X'; 1; }

$ perl583 /tmp/p1
Attempt to free unreferenced scalar​: SV 0x8175be4 at /tmp/p1 line 6.

The fix is trivial, and I've applied the patch below to the development
version of Perl.

--
Technology is dominated by two types of people​: those who understand what
they do not manage, and those who manage what they do not understand.

Change 22500 by davem@​davem-percy on 2004/03/14 20​:13​:47

  [perl #27638] scope exit could expose freed local() value

Affected files ...

... //depot/perl/scope.c#119 edit
... //depot/perl/t/op/localref.t#2 edit

Differences ...

==== //depot/perl/scope.c#119 (text) ====

@​@​ -782,8 +782,8 @​@​
  * mg_get() in save_scalar_at() croaked */
  SvMAGIC(value) = 0;
  }
+ *(SV**)ptr = value;
  SvREFCNT_dec(sv);
- *(SV**)ptr = value;
  PL_localizing = 2;
  SvSETMAGIC(value);
  PL_localizing = 0;

==== //depot/perl/t/op/localref.t#2 (text) ====

@​@​ -3,7 +3,7 @​@​
chdir 't' if -d 't';
@​INC = qw(. ../lib);
require "test.pl";
-plan( tests => 63 );
+plan( tests => 64 );

$aa = 1;
{ local $aa; $aa = 2; is($aa,2); }
@​@​ -83,3 +83,17 @​@​
eval { local %{$y}; }; test_err_localref;
eval { local %{\%aa}; }; test_err_localref;
eval { local %{{a=>1}}; };test_err_localref;
+
+
+{
+ # [perl #27638] when restoring a localized variable, the thing being
+ # freed shouldn't be visible
+ my $ok;
+ $x = 0;
+ sub X​::DESTROY { $ok = !ref($x); }
+ {
+ local $x = \ bless {}, 'X';
+ 1;
+ }
+ok($ok,'old value not visible during restore');
+}

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

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

From @ysth

On Sun, Mar 14, 2004 at 08​:38​:21PM +0000, Dave Mitchell <davem@​fdisolutions.com> wrote​:

The fix is trivial, and I've applied the patch below to the development
version of Perl.

Is #27268 related to this?

From @iabyn

On Sun, Mar 14, 2004 at 03​:41​:35PM -0800, Yitzchak Scott-Thoennes wrote​:

On Sun, Mar 14, 2004 at 08​:38​:21PM +0000, Dave Mitchell <davem@​fdisolutions.com> wrote​:

The fix is trivial, and I've applied the patch below to the development
version of Perl.

Is #27268 related to this?

No :-(

--
Fire extinguisher (n) a device for holding open fire doors.