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

PerlIO resource leaks on open() and then :pop in :unix and :stdio #9406

Closed
p5pRT opened this issue Jul 6, 2008 · 8 comments
Closed

PerlIO resource leaks on open() and then :pop in :unix and :stdio #9406

p5pRT opened this issue Jul 6, 2008 · 8 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Jul 6, 2008

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

Searchable as RT56644$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

From g.psy.va@gmail.com

This is a bug report for perl from garo@​goro.nonet,
generated with the help of perlbug 1.36 running under perl 5.10.0.


Hi, perl5porters.

I found some problems in perlio.c; please see and try the following​:

#!perl
my $file = '/dev/null'; # it doesn't matter
for(1 .. 10){
  open my $fh, '<​:unix', $file;
  print fileno($in), "\n";
  binmode $fh, '​:pop';
}
__END__

It leads to resource leaks when :unix and :stdio are used.

The :pop pseudo layer invokes a destructor Popped() of the vtable, and
the destructor should release their resources. However, the :unix and
:stdio layers
do nothing on Popped(). They release their resources only when their
Close() is called.

(Moreover, PerlIOMmap_close() is defined in perlio.c, but it is not
used anywhere, although it may be harmless. I think these issues come
from a bad design of PerlIO virtual table; there are two kind of
destructors, Popped() and Close(), which may confuse the PerlIO
authors. Actually, only Popped() might be required.)

The "ioleaks.diff" solves these problems, and "ioleaks.t" is its tests.

P.S.
I also found a trivial mistake in perliol.pod. See the "perliol.diff".



Flags​:
  category=core
  severity=low


Site configuration information for perl 5.10.0​:

Configured by garo at Sun Jan 6 08​:39​:07 JST 2008.

Summary of my perl5 (revision 5 version 10 subversion 0) configuration​:
  Platform​:
  osname=cygwin, osvers=1.5.25(0.15642), archname=cygwin-thread-multi
  uname='cygwin_nt-5.1 goro 1.5.25(0.15642) 2007-12-14 19​:21 i686 cygwin '
  config_args='-de -Dmksymlnks -Doptimize=-O3 -Dusethreads
-Acccdlflags=-s -Alddlflags=-s -Accdlflags=-s -Dman3ext=3pm'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
  use64bitint=undef, use64bitall=undef, uselongdouble=undef
  usemymalloc=y, bincompat5005=undef
  Compiler​:
  cc='gcc', ccflags ='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__
-fno-strict-aliasing -pipe -Wall -Wextra -Wmissing-prototypes
-Winit-self',
  optimize='-O3',
  cppflags='-DPERL_USE_SAFE_PUTENV -U__STRICT_ANSI__
-fno-strict-aliasing -pipe'
  ccversion='', gccversion='3.4.4 (cygming special, gdc 0.12, using
dmd 0.125)', 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=8, prototype=define
  Linker and Libraries​:
  ld='g++', ldflags =' -Wl,--enable-auto-import
-Wl,--export-all-symbols -Wl,--stack,8388608
-Wl,--enable-auto-image-base -Wl,--enable-auto-import
-L/usr/local/lib'
  libpth=/usr/local/lib /usr/lib /lib
  libs=-ldl -lcrypt
  perllibs=-ldl -lcrypt
  libc=/usr/lib/libc.a, so=dll, useshrplib=true, libperl=libperl.a
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' -s'
  cccdlflags=' -s', lddlflags=' --shared -Wl,--enable-auto-import
-Wl,--export-all-symbols -Wl,--stack,8388608
-Wl,--enable-auto-image-base -Wl,--enable-auto-import -s
-L/usr/local/lib'

Locally applied patches​:


@​INC for perl 5.10.0​:
  /usr/local/lib/perl5/5.10.0/cygwin-thread-multi
  /usr/local/lib/perl5/5.10.0
  /usr/local/lib/perl5/site_perl/5.10.0/cygwin-thread-multi
  /usr/local/lib/perl5/site_perl/5.10.0
  .


Environment for perl 5.10.0​:
  HOME=/home/garo
  LANG (unset)
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/usr/local/parrot/bin​:/usr/local/bin​:/usr/bin​:/bin​:/usr/X11R6/bin​:/usr/local/bin​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/Common7/IDE​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/VC/BIN​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/Common7/Tools​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/Common7/Tools/bin​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/VC/PlatformSDK/bin​:/cygdrive/c/Program
Files/Microsoft Visual Studio
8/SDK/v2.0/bin​:/cygdrive/c/WINDOWS/Microsoft.NET/Framework/v2.0.50727​:/cygdrive/c/Program
Files/Microsoft Visual Studio 8/VC/VCPackages​:/cygdrive/c/program
files/imagemagick-6.2.8-q16​:/cygdrive/c/ActivePerl5.10/bin​:/cygdrive/c/WINDOWS/system32​:/cygdrive/c/WINDOWS​:/cygdrive/c/WINDOWS/System32/Wbem​:/cygdrive/c/Program
Files/ATI Technologies/ATI Control Panel​:/cygdrive/c/Program
Files/Microsoft SQL
Server/90/Tools/binn/​:/cygdrive/c/PROGRA1/IBM/IBMHOM1.04/Outloud​:/cygdrive/c/Program
Files/QuickTime/QTSystem/​:/cygdrive/c/Program Files/Microsoft Visual
Studio 8/VC/bin​:/cygdrive/c/Program Files/R/bin​:/cygdrive/c/program
files/imagemagick-6.2.8-q16​:/cygdrive/c/ActivePerl5.10/bin​:/cygdrive/c/WINDOWS/system32​:/cygdrive/c/WINDOWS​:/cygdrive/c/WINDOWS/System32/Wbem​:/cygdrive/c/Program
Files/ATI Technologies/ATI Control Panel​:/cygdrive/c/Program
Files/Microsoft SQL
Server/90/Tools/binn/​:/cygdrive/c/PROGRA1/IBM/IBMHOM1.04/Outloud​:/cygdrive/c/Program
Files/QuickTime/QTSystem/
  PERLIO=​:perlio
  PERL_BADLANG (unset)
  SHELL (unset)

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

From @gfx

I'm sorry. I forgot to attach the files.

--
Goro Fuji

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

From @gfx

#!perl
# ioleaks.t

use strict;
use warnings;
use Test​::More 'no_plan';

# :unix -> not ok
# :stdio -> not ok
# :perlio -> ok
# :crlf -> ok

foreach my $layer(qw(​:unix :stdio :perlio :crlf)){
  my $base_fd = do{ open my $in, '<', $0 or die $!; fileno $in };

  for(1 .. 3){
  open my $fh, "<$layer", $0 or die $!;

  is fileno($fh), $base_fd, $layer;
  binmode $fh, '​:pop';
  }
}

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

From @gfx

ioleaks.diff
--- perlio.c~	2008-05-24 19:08:07.373992000 +0900
+++ perlio.c	2008-07-06 20:36:43.547300800 +0900
@@ -2723,10 +2723,15 @@
     return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR);
 }
 
-
 IV
 PerlIOUnix_close(pTHX_ PerlIO *f)
 {
+	return PerlIOBase_noop_ok(aTHX_ f);
+}
+
+IV
+PerlIOUnix_popped(pTHX_ PerlIO *f)
+{
     dVAR;
     const int fd = PerlIOSelf(f, PerlIOUnix)->fd;
     int code = 0;
@@ -2759,7 +2764,7 @@
     sizeof(PerlIOUnix),
     PERLIO_K_RAW,
     PerlIOUnix_pushed,
-    PerlIOBase_popped,
+    PerlIOUnix_popped,
     PerlIOUnix_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,
@@ -3109,6 +3114,12 @@
 IV
 PerlIOStdio_close(pTHX_ PerlIO *f)
 {
+	return PerlIOBase_noop_ok(aTHX_ f);
+}
+
+IV
+PerlIOStdio_popped(pTHX_ PerlIO *f)
+{
     FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio;
     if (!stdio) {
 	errno = EBADF;
@@ -3505,7 +3516,7 @@
     sizeof(PerlIOStdio),
     PERLIO_K_BUFFERED|PERLIO_K_RAW,
     PerlIOStdio_pushed,
-    PerlIOBase_popped,
+    PerlIOStdio_popped,
     PerlIOStdio_open,
     PerlIOBase_binmode,         /* binmode */
     NULL,

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

From @gfx

perliol.diff
--- perliol.pod~	2007-12-18 19:47:08.000000000 +0900
+++ perliol.pod	2008-07-06 18:31:41.720203200 +0900
@@ -145,7 +145,7 @@
    IV		(*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab);
    IV		(*Popped)(pTHX_ PerlIO *f);
    PerlIO *	(*Open)(pTHX_ PerlIO_funcs *tab,
-  			AV *layers, IV n,
+  			PerlIO_list_t *layers, IV n,
   			const char *mode,
   			int fd, int imode, int perm,
   			PerlIO *old,
@@ -486,7 +486,7 @@
 follows:
 
  PerlIO *	(*Open)(pTHX_ PerlIO_funcs *tab,
-			AV *layers, IV n,
+			PerlIO_list_t *layers, IV n,
 			const char *mode,
 			int fd, int imode, int perm,
 			PerlIO *old,
@@ -494,7 +494,7 @@
 
 Open should (perhaps indirectly) call C<PerlIO_allocate()> to allocate
 a slot in the table and associate it with the layers information for
-the opened file, by calling C<PerlIO_push>.  The I<layers> AV is an
+the opened file, by calling C<PerlIO_push>.  The I<layers> is an
 array of all the layers destined for the C<PerlIO *>, and any
 arguments passed to them, I<n> is the index into that array of the
 layer being called. The macro C<PerlIOArg> will return a (possibly

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Jul 6, 2008

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 8, 2008

From @smpeters

On Sun Jul 06 16​:05​:22 2008, gfuji@​cpan.org wrote​:

I'm sorry. I forgot to attach the files.

Thanks so much for the excellent work! These patches were applied as change #34775.

Steve Peters.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 8, 2008

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

Loading

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

Successfully merging a pull request may close this issue.

None yet
1 participant