From root@s10.ucoz.ru

This is a bug report for perl from yuriy@​uch.net,
generated with the help of perlbug 1.35 running under perl v5.8.8.

Change 30946, patch 30633 "PerlIO_exportFILE() and
PerlIO_releaseFILE() should manage the fd reference counts correctly" breaks
compatibility with some perl modules leading to file descriptor leakage.

GD-2.35 module contains functions like
GD​::Image->newFromJpeg($file, [$truecolor])
which can take file descriptor as first argument.

Following code produces "Too many open files" error, which does not appear on 5.8.8-stable
(there should be some JPG-file named 1.jpg for this test to work)​:

use GD;
foreach(1..2000) {
  open(F,"<1.jpg") || die "$!\n";
  my $im=GD​::Image->newFromJpeg(\*F,1);
  close(F);
  }

"close" does not close the file.

Some experiments were held. newFromJpeg is realized as follows​:

#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg(PerlIO_findFILE(x))

GD​::Image
gd_newFromJpeg(packname="GD​::Image", filehandle, ...)
  char * packname
  InputStream filehandle
  PROTOTYPE​: $$;$
  PREINIT​:
#ifdef START_MY_CXT
  dMY_CXT;
  int truecolor = MY_CXT.truecolor_default;
#else
  int truecolor = truecolor_default;
#endif
  CODE​:
  RETVAL = GDIMAGECREATEFROMJPEG(filehandle);
  if (items > 2) truecolor = (int)SvIV(ST(2));
  gd_chkimagefmt(RETVAL, truecolor);
  OUTPUT​:
  RETVAL

According to documentation (perlapio) PerlIO_findFILE does not require to call PerlIO_releaseFILE. But
documentation says that PerlIO_findFILE can call PerlIO_exportFILE (if provided PerlIO object has no stdio layer present)
which in turn requires PerlIO_releaseFILE (docs inconsistency?). So, GD.xs were changed to produce such code​:

FILE* tmp;
RETVAL=gdImageCreateFromJpeg(tmp=PerlIO_findFILE(filehandle));
PerlIO_releaseFILE(filehandle,tmp);

and another try was made with​:

FILE* tmp;
RETVAL=gdImageCreateFromJpeg(tmp=PerlIO_exportFILE(filehandle,NULL));
PerlIO_releaseFILE(filehandle,tmp);

Both variants solved the problem of descriptor leakage but introduced a new one - unknown errors
when passing file descriptors opened in write mode. It was my own extension to GD module​:

void
gdjpegfile(image,filehandle,quality=-1)
  GD​::Image image
  InputStream filehandle
  int quality
  PROTOTYPE​: $$
  PREINIT​:
  FILE* tmp;
  CODE​:
  {
  gdImageJpeg(image,tmp=PerlIO_findFILE(filehandle),quality);
  PerlIO_releaseFILE(filehandle,tmp); //THIS LINE WAS ADDED TRYING TO AVOID LEAKS
  }

trying to call jpegfile after newFromJpeg, such code

open(F,">image1.jpg");
$img->jpegfile(F);
close(F);

produces just empty file 'image2.jpg'. If PerlIO_releaseFILE is absent, file descriptor is not closed. It seems
that PerlIO_releaseFILE just reopens file and thereof truncates it.

In general, I found two ways for solving this problem without changing GD module​:
1. open files with explicit 'stdio' layer​: open(F,"<​:stdio","filename") and open(F,">​:stdio","filename");
2. revert patch 30633

Flags​:
  category=core
  severity=critical

Site configuration information for perl v5.8.8​:

Configured by root at Tue Oct 2 16​:39​:17 MSD 2007.

Summary of my perl5 (revision 5 version 8 subversion 8 patch 31996) configuration​:
  Platform​:
  osname=linux, osvers=2.6.22.9, archname=x86_64-linux
  uname='linux localhost 2.6.22.9 #3 smp mon oct 1 04​:14​:47 msd 2007 x86_64 gnulinux '
  config_args=''
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
  useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
  use64bitint=define use64bitall=define uselongdouble=undef
  usemymalloc=y, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2',
  cppflags='-fno-strict-aliasing -pipe -I/usr/local/include'
  ccversion='', gccversion='4.2.1 (Debian 4.2.1-4)', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=8, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -L/usr/local/lib'
  libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64
  libs=-lnsl -ldb -ldl -lm -lcrypt -lutil -lc
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
  libc=/lib/libc-2.6.1.so, so=so, useshrplib=true, libperl=libperl.so
  gnulibc_version='2.6.1'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl5/5.8.8/x86_64-linux/CORE'
  cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib'

Locally applied patches​:
  MAINT30961

@​INC for perl v5.8.8​:
  /usr/lib/perl5/5.8.8/x86_64-linux
  /usr/lib/perl5/5.8.8
  /usr/lib/perl5/site_perl/5.8.8/x86_64-linux
  /usr/lib/perl5/site_perl/5.8.8
  .

Environment for perl v5.8.8​:
  HOME=/root
  LANG=ru_RU.CP1251
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/usr/local/sbin​:/usr/local/bin​:/usr/sbin​:/usr/bin​:/sbin​:/bin​:/usr/bin/X11
  PERL_BADLANG (unset)
  SHELL=/bin/bash

From @eserte

"root@​s10.ucoz.ru (via RT)" <perlbug-followup@​perl.org> writes​:

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

This is a bug report for perl from yuriy@​uch.net,
generated with the help of perlbug 1.35 running under perl v5.8.8.

-----------------------------------------------------------------
Change 30946, patch 30633 "PerlIO_exportFILE() and
PerlIO_releaseFILE() should manage the fd reference counts correctly" breaks
compatibility with some perl modules leading to file descriptor leakage.

[...]

Confirmed also for perl5.10.0@​32039 on amd64-freebsd. This seems to
cause problems also in other modules. Here a (silly) example with
Term​::Size​:

$ limits -n 100 perl5.10.0 -Mblib -MTerm​::Size=chars -e 'for (1..100) { open(TTY, "/dev/tty") or die "$! ($i)"; $i++; chars(\*TTY); close TTY }'
Too many open files (97) at -e line 1.

Regards,
  Slaven

--
Slaven Rezic - slaven <at> rezic <dot> de
  babybike - routeplanner for cyclists in Berlin
  handheld (e.g. Compaq iPAQ with Linux) version of bbbike
  http​://bbbike.sourceforge.net

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