summaryrefslogtreecommitdiff
path: root/t/io/perlio.t
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2010-01-07 15:54:07 +0000
committerNicholas Clark <nick@ccl4.org>2010-01-07 15:54:07 +0000
commitaf9379e9ed4daaed65ba42baa492afc842917dd5 (patch)
tree9d6f2aecf256df32ea7fc0334a059c7f472fd02f /t/io/perlio.t
parent0f13ebd5d71f81771c1044e2c89aff29b408bfec (diff)
downloadperl-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/io/perlio.t')
-rw-r--r--t/io/perlio.t34
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