# 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: h
ttp://rt.perl.org/rt3/Ticket/Display.html?id=46207 >
This is a bug report for perl from yuriyuch.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(filehand
le,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
|