diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-01-07 15:54:07 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-01-07 15:54:07 +0000 |
commit | af9379e9ed4daaed65ba42baa492afc842917dd5 (patch) | |
tree | 9d6f2aecf256df32ea7fc0334a059c7f472fd02f /t | |
parent | 0f13ebd5d71f81771c1044e2c89aff29b408bfec (diff) | |
download | perl-af9379e9ed4daaed65ba42baa492afc842917dd5.tar.gz |
Avoid race conditions with files in /tmp, by explicitly checking dev & inode.
(Concerns raised by and the form of the solution suggested by Bram.)
Diffstat (limited to 't')
-rw-r--r-- | t/io/perlio.t | 34 |
1 files changed, 19 insertions, 15 deletions
diff --git a/t/io/perlio.t b/t/io/perlio.t index 3a81512c82..d95e3963e2 100644 --- a/t/io/perlio.t +++ b/t/io/perlio.t @@ -101,30 +101,34 @@ ok(close($utffh)); # 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); + my $filename = find_filename($x, $perlio_tmp_file_glob); + is($filename, undef, "No tmp files leaked"); + unlink $filename if defined $filename; 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'); - @after = glob $perlio_tmp_file_glob; - is( "@after", "@before", "No tmp files leaked"); - - unlink_new(\@before, \@after); + $filename = find_filename($x, $perlio_tmp_file_glob); + is($filename, undef, "No tmp files leaked"); + unlink $filename if defined $filename; } } -sub unlink_new { - my ($before, $after) = @_; - my %before; - @before{@$before} = (); - unlink grep {!exists $before{$_}} @$after; +sub find_filename { + my ($fh, @globs) = @_; + my ($dev, $inode) = stat $fh; + die "Can't stat $fh: $!" unless defined $dev; + + foreach (@globs) { + foreach my $file (glob $_) { + my ($this_dev, $this_inode) = stat $file; + next unless defined $this_dev; + return $file if $this_dev == $dev && $this_inode == $inode; + } + } + return; } # in-memory open |