This is a bug report for perl from Niko Tyni <nt...@debian.org>, generated with the help of perlbug 1.39 running under perl 5.11.0.
----------------------------------------------------------------- In <http://bugs.debian.org/528544>, Norbert Buchmuller <no...@nix.hu> requests that opening an anonymous temporary file with the idiom `open($fh, '+>', undef)' should use $ENV{TMPDIR} instead of hardcoding /tmp. I'm attaching a patch against current blead based on his original one. I'm uneasy on failing when TMPDIR is set but doesn't exist or isn't writable. The obvious alternative is to stat it every time and fall back on /tmp if necessary. Also, should we worry about tainting issues? ----------------------------------------------------------------- --- Flags: category=core severity=wishlist --- Site configuration information for perl 5.11.0: Configured by niko at Sat May 30 21:54:25 EEST 2009. Summary of my perl5 (revision 5 version 11 subversion 0) configuration: Local Commit: e97df03b198389a9fe2eb71def8423a0bfbf6df8 Ancestor: f6085ff72b72f58d9b82bcc722d8a8fe8438b807 Platform: osname=linux, osvers=2.6.26-2-openvz-amd64, archname=x86_64-linux-gnu-thread-multi uname='linux minerva 2.6.26-2-openvz-amd64 #1 smp wed may 13 16:46:17 utc 2009 x86_64 gnulinux ' config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.11 -Darchlib=/usr/lib/perl/5.11 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.11.0 -Dsitearch=/usr/local/lib/perl/5.11.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Dman1ext=1 -Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -DDEBUGGING=-g -Doptimize=-O2 -Dusedevel -Duseshrplib -Dlibperl=libperl.so.5.11.0 -des' hint=recommended, useposix=true, d_sigaction=define useithreads=define, usemultiplicity=define useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef use64bitint=define, use64bitall=define, uselongdouble=undef usemymalloc=n, bincompat5005=undef Compiler: cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64', optimize='-O2 -g', cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include' ccversion='', gccversion='4.3.2', 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 =' -fstack-protector -L/usr/local/lib' libpth=/usr/local/lib /lib /usr/lib /lib64 /usr/lib64 libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc libc=/lib/libc-2.7.so, so=so, useshrplib=true, libperl=libperl.so.5.11.0 gnulibc_version='2.7' Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E -Wl,-rpath,/usr/lib/perl/5.11/CORE' cccdlflags='-fPIC', lddlflags='-shared -O2 -g -L/usr/local/lib -fstack-protector' Locally applied patches: PERL_GIT_UNPUSHED_COMMITS /* do not remove this line */ PERL_GIT_UNCOMMITTED_CHANGES /* do not remove this line */ --- @INC for perl 5.11.0: lib /usr/local/lib/perl/5.11.0 /usr/local/share/perl/5.11.0 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.11 /usr/share/perl/5.11 /usr/local/share/perl /usr/share/perl5 . --- Environment for perl 5.11.0: HOME=/home/niko LANG=en_US.UTF-8 LANGUAGE (unset) LC_CTYPE=fi_FI.UTF-8 LD_LIBRARY_PATH=. LOGDIR (unset) PATH=/home/niko/bin:/home/niko/bin:/home/niko/bin:/usr/local/bin:/usr/bin:/bin:/usr/games:/sbin:/usr/sbin PERL_BADLANG (unset) SHELL=/bin/zsh
>From e97df03b198389a9fe2eb71def8423a0bfbf6df8 Mon Sep 17 00:00:00 2001 From: Niko Tyni <nt...@debian.org> Date: Tue, 9 Jun 2009 22:56:32 +0300 Subject: [PATCH] Honor TMPDIR when open()ing an anonymous temporary file As reported in <http://bugs.debian.org/528544>, opening an anonymous temporary file with the magical open($fh, '+>', undef) currently ignores TMPDIR. Original patch by Norbert Buchmuller <no...@nix.hu>. --- perlio.c | 4 +++- t/io/perlio.t | 15 ++++++++++++++- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/perlio.c b/perlio.c index e92a32a..89718e9 100644 --- a/perlio.c +++ b/perlio.c @@ -5174,7 +5174,9 @@ PerlIO_tmpfile(void) f = PerlIO_fdopen(fd, "w+b"); #else /* WIN32 */ # if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2) - SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX"); + const char * const tmpdir = PerlEnv_getenv("TMPDIR"); + SV * const sv = newSVpv(tmpdir ? tmpdir : "/tmp", 0); + sv_catpv(sv, "/PerlIO_XXXXXX"); /* * I have no idea how portable mkstemp() is ... NI-S */ diff --git a/t/io/perlio.t b/t/io/perlio.t index c145945..8d76d91 100644 --- a/t/io/perlio.t +++ b/t/io/perlio.t @@ -8,13 +8,14 @@ BEGIN { } } -use Test::More tests => 37; +use Test::More tests => 39; use_ok('PerlIO'); my $txt = "txt$$"; my $bin = "bin$$"; my $utf = "utf$$"; +my $nonexistent = "nex$$"; my $txtfh; my $binfh; @@ -89,6 +90,17 @@ ok(close($utffh)); # report after STDOUT is restored ok($status, ' re-open STDOUT'); close OLDOUT; + + SKIP: { + skip("TMPDIR not honored on this platform", 2) + if !$Config{d_mkstemp} + || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2'; + local $ENV{TMPDIR} = $nonexistent; + ok( !open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - fails if TMPDIR points to a non-existent dir'); + + mkdir $ENV{TMPDIR}; + ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir'); + } } # in-memory open @@ -136,5 +148,6 @@ END { 1 while unlink $txt; 1 while unlink $bin; 1 while unlink $utf; + 1 while rmdir $nonexistent; } -- 1.5.6.5
