p5pRT
commented
17 years ago 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
Migrated from rt.perl.org#46207 (status was 'open')
Searchable as RT46207$