From af9379e9ed4daaed65ba42baa492afc842917dd5 Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Thu, 7 Jan 2010 15:54:07 +0000 Subject: Avoid race conditions with files in /tmp, by explicitly checking dev & inode. (Concerns raised by and the form of the solution suggested by Bram.) --- t/io/perlio.t | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) (limited to 't') 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 -- cgit v1.2.1