From: Rafael Garcia-Suarez Date: Wed, 10 Jun 2009 20:42:15 +0000 (+0200) Subject: Do not honor TMPDIR for anonymous temporary files when tainting X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0b99e9860ee94a7d55fe93fe492e8286fdfa409d;p=p5sagit%2Fp5-mst-13.2.git Do not honor TMPDIR for anonymous temporary files when tainting Use a default of /tmp on Unixes when TMPDIR is unset or empty, or when creation of a temporary file in it fails This goes on top of commit 26e8050aaf2eeca2f04cdc7bc5df07f8dc4ff0f9 --- diff --git a/perlio.c b/perlio.c index 89718e9..10a32c1 100644 --- a/perlio.c +++ b/perlio.c @@ -5174,20 +5174,30 @@ PerlIO_tmpfile(void) f = PerlIO_fdopen(fd, "w+b"); #else /* WIN32 */ # if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2) - const char * const tmpdir = PerlEnv_getenv("TMPDIR"); - SV * const sv = newSVpv(tmpdir ? tmpdir : "/tmp", 0); - sv_catpv(sv, "/PerlIO_XXXXXX"); + int fd = -1; + char tempname[] = "/tmp/PerlIO_XXXXXX"; + const char * const tmpdir = PL_tainting ? NULL : PerlEnv_getenv("TMPDIR"); + SV * const sv = tmpdir && *tmpdir ? newSVpv(tmpdir, 0) : NULL; /* * I have no idea how portable mkstemp() is ... NI-S */ - const int fd = mkstemp(SvPVX(sv)); + if (sv) { + /* if TMPDIR is set and not empty, we try that first */ + sv_catpv(sv, tempname + 4); + fd = mkstemp(SvPVX(sv)); + } + if (fd < 0) { + /* else we try /tmp */ + fd = mkstemp(tempname); + } if (fd >= 0) { f = PerlIO_fdopen(fd, "w+"); if (f) PerlIOBase(f)->flags |= PERLIO_F_TEMP; - PerlLIO_unlink(SvPVX_const(sv)); + PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); } - SvREFCNT_dec(sv); + if (sv) + SvREFCNT_dec(sv); # else /* !HAS_MKSTEMP, fallback to stdio tmpfile(). */ FILE * const stdio = PerlSIO_tmpfile(); diff --git a/t/io/perlio.t b/t/io/perlio.t index 8d76d91..c1eebec 100644 --- a/t/io/perlio.t +++ b/t/io/perlio.t @@ -96,7 +96,7 @@ ok(close($utffh)); 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'); + ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works 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'); @@ -148,6 +148,6 @@ END { 1 while unlink $txt; 1 while unlink $bin; 1 while unlink $utf; - 1 while rmdir $nonexistent; + rmdir $nonexistent; }