From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 7 Jan 2010 14:22:39 +0000 (+0000)
Subject: Unlink PerlIO's tempfiles for the case of no -T, but bogus $ENV{TMPDIR}
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7299ca586a6a78a40081a6e7e2e94c3b1a8aa538;p=p5sagit%2Fp5-mst-13.2.git

Unlink PerlIO's tempfiles for the case of no -T, but bogus $ENV{TMPDIR}

When -T is enabled, or when $ENV{TMPDIR} is bogus, perlio.c used a pathname
matching </tmp/PerlIO_??????>. However, it was only correctly unlinking the
file for the case of -T enabled.
---

diff --git a/perlio.c b/perlio.c
index 7da7505..ddcc357 100644
--- a/perlio.c
+++ b/perlio.c
@@ -5157,16 +5157,18 @@ PerlIO_tmpfile(void)
      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;
+     SV * sv;
      /*
       * I have no idea how portable mkstemp() is ... NI-S
       */
-     if (sv) {
+     if (tmpdir && *tmpdir) {
 	 /* if TMPDIR is set and not empty, we try that first */
+	 sv = newSVpv(tmpdir, 0);
 	 sv_catpv(sv, tempname + 4);
 	 fd = mkstemp(SvPVX(sv));
      }
      if (fd < 0) {
+	 sv = NULL;
 	 /* else we try /tmp */
 	 fd = mkstemp(tempname);
      }
diff --git a/t/io/perlio.t b/t/io/perlio.t
index 1499ca2..3a81512 100644
--- a/t/io/perlio.t
+++ b/t/io/perlio.t
@@ -9,7 +9,7 @@ BEGIN {
 	require './test.pl';
 }
 
-plan tests => 40;
+plan tests => 42;
 
 use_ok('PerlIO');
 
@@ -97,16 +97,36 @@ ok(close($utffh));
         if !$Config{d_mkstemp}
         || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
       local $ENV{TMPDIR} = $nonexistent;
+
+      # hardcoded default temp path
+      my $perlio_tmp_file_glob = '/tmp/PerlIO_??????';
+
+      my @before = glob $perlio_tmp_file_glob;
+
       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');
 
+      my @after = glob $perlio_tmp_file_glob;
+      is( "@after", "@before", "No tmp files leaked");
+
+      unlink_new(\@before, \@after);
+
       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');
 
-      # hardcoded default temp path
-      unlink </tmp/PerlIO_*>;
+      @after = glob $perlio_tmp_file_glob;
+      is( "@after", "@before", "No tmp files leaked");
+
+      unlink_new(\@before, \@after);
     }
 }
 
+sub unlink_new {
+    my ($before, $after) = @_;
+    my %before;
+    @before{@$before} = ();
+    unlink grep {!exists $before{$_}} @$after;
+}
+
 # in-memory open
 SKIP: {
     eval { require PerlIO::scalar };