Package: perl
Version: 5.10.0-19
Severity: normal
Tags: patch
Currently the PerlIO layer ignores the TMPDIR environment variable when
opening tempfiles with the "open(FH, '+<', undef)" idiom. Pretty
annoying when eg. a git-svn import eats up the small /tmp and there's no
way to override it..
See the attached patch.
norbi
-- System Information:
Debian Release: 5.0.1
APT prefers stable
APT policy: (500, 'stable')
Architecture: i386 (i686)
Kernel: Linux 2.6.26 (PREEMPT)
Locale: LANG=C, LC_CTYPE=hu_HU (charmap=ISO-8859-2)
Shell: /bin/sh linked to /bin/bash
Versions of packages perl depends on:
ii libc6 2.7-18 GNU C Library: Shared libraries
ii libdb4.6 4.6.21-11 Berkeley v4.6 Database Libraries [
ii libgdbm3 1.8.3-3 GNU dbm database routines (runtime
ii perl-base 5.10.0-19 minimal Perl system
ii perl-modules 5.10.0-19 Core Perl modules
Versions of packages perl recommends:
ii netbase 4.34 Basic TCP/IP networking system
Versions of packages perl suggests:
ii libterm-readline-perl-perl 1.0302-1 Perl implementation of Readline li
ii perl-doc 5.10.0-19 Perl documentation
-- no debconf information
diff -Naur perl-5.10.0/ext/PerlIO/t/PerlIO.t perl-5.10.0-fixed/ext/PerlIO/t/PerlIO.t
--- perl-5.10.0/ext/PerlIO/t/PerlIO.t 2007-12-18 11:47:07.000000000 +0100
+++ perl-5.10.0-fixed/ext/PerlIO/t/PerlIO.t 2009-04-26 00:19:31.000000000 +0200
@@ -8,13 +8,14 @@
}
}
-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,16 @@
# report after STDOUT is restored
ok($status, ' re-open STDOUT');
close OLDOUT;
+
+ {
+ local $ENV{TMPDIR} = $nonexistent;
+ my $success = eval { $success = open(my $x,"+<",undef) };
+ ok( !$success, 'TMPDIR honored by magic temp file via 3 arg open with undef - fails if TMPDIR points to a non-existent dir');
+
+ mkdir $ENV{TMPDIR};
+ $success = eval { $success = open(my $x,"+<",undef) };
+ ok( $success, 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');
+ }
}
# in-memory open
@@ -132,5 +143,6 @@
1 while unlink $txt;
1 while unlink $bin;
1 while unlink $utf;
+ 1 while unlink $nonexistent;
}
diff -Naur perl-5.10.0/perlio.c perl-5.10.0-fixed/perlio.c
--- perl-5.10.0/perlio.c 2009-04-25 20:05:27.000000000 +0200
+++ perl-5.10.0-fixed/perlio.c 2009-04-26 01:04:49.000000000 +0200
@@ -5116,16 +5116,20 @@
f = PerlIO_fdopen(fd, "w+b");
#else /* WIN32 */
# if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2)
- SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX");
- /*
- * I have no idea how portable mkstemp() is ... NI-S
- */
- const int fd = mkstemp(SvPVX(sv));
- if (fd >= 0) {
- f = PerlIO_fdopen(fd, "w+");
- if (f)
- PerlIOBase(f)->flags |= PERLIO_F_TEMP;
- PerlLIO_unlink(SvPVX_const(sv));
+ 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
+ */
+ const int fd = mkstemp(SvPVX(sv));
+ if (fd >= 0) {
+ f = PerlIO_fdopen(fd, "w+");
+ if (f)
+ PerlIOBase(f)->flags |= PERLIO_F_TEMP;
+ PerlLIO_unlink(SvPVX_const(sv));
+ }
}
SvREFCNT_dec(sv);
# else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */
