Change 30246 by [EMAIL PROTECTED] on 2007/02/12 21:59:14
Integrate:
[ 26573]
Documentation fix for File::Temp::new
Subject: [perl #38127] Bug in perldoc File::Temp
From: [EMAIL PROTECTED] (via RT) <[EMAIL PROTECTED]>
Date: Mon, 02 Jan 2006 02:48:41 -0800
Message-ID: <[EMAIL PROTECTED]>
[ 28755]
Upgrade to File-Temp-0.17. Also, a change to Tim Jenness's email.
[ 29935]
Upgrade to File-Temp-0.18.
Affected files ...
... //depot/maint-5.8/perl/AUTHORS#44 integrate
... //depot/maint-5.8/perl/MANIFEST#322 integrate
... //depot/maint-5.8/perl/lib/File/Temp.pm#8 integrate
... //depot/maint-5.8/perl/lib/File/Temp/t/cmp.t#1 branch
... //depot/maint-5.8/perl/lib/File/Temp/t/seekable.t#1 branch
Differences ...
==== //depot/maint-5.8/perl/AUTHORS#44 (text) ====
Index: perl/AUTHORS
--- perl/AUTHORS#43~30244~ 2007-02-12 13:35:09.000000000 -0800
+++ perl/AUTHORS 2007-02-12 13:59:14.000000000 -0800
@@ -812,7 +812,7 @@
Tim Bunce <[EMAIL PROTECTED]>
Tim Conrow <[EMAIL PROTECTED]>
Tim Freeman <[EMAIL PROTECTED]>
-Tim Jenness <[EMAIL PROTECTED]>
+Tim Jenness <[EMAIL PROTECTED]>
Tim Mooney <[EMAIL PROTECTED]>
Tim Sweetman <[EMAIL PROTECTED]>
Tim Witham <[EMAIL PROTECTED]>
==== //depot/maint-5.8/perl/MANIFEST#322 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#321~30242~ 2007-02-12 13:17:51.000000000 -0800
+++ perl/MANIFEST 2007-02-12 13:59:14.000000000 -0800
@@ -1510,10 +1510,12 @@
lib/File/stat.pm By-name interface to Perl's builtin stat
lib/File/stat.t See if File::stat works
lib/File/Temp.pm create safe temporary files and file handles
+lib/File/Temp/t/cmp.t See if File::Temp works
lib/File/Temp/t/mktemp.t See if File::Temp works
lib/File/Temp/t/object.t See if File::Temp works
lib/File/Temp/t/posix.t See if File::Temp works
lib/File/Temp/t/security.t See if File::Temp works
+lib/File/Temp/t/seekable.t See if File::Temp works
lib/File/Temp/t/tempfile.t See if File::Temp works
lib/filetest.pm For "use filetest"
lib/filetest.t See if filetest works
==== //depot/maint-5.8/perl/lib/File/Temp.pm#8 (text) ====
Index: perl/lib/File/Temp.pm
--- perl/lib/File/Temp.pm#7~24144~ 2005-04-03 08:18:11.000000000 -0700
+++ perl/lib/File/Temp.pm 2007-02-12 13:59:14.000000000 -0800
@@ -61,13 +61,18 @@
require File::Temp;
use File::Temp ();
+ use File::Temp qw/ :seekable /;
- $fh = new File::Temp($template);
+ $fh = new File::Temp();
+ $fname = $fh->filename;
+
+ $fh = new File::Temp(TEMPLATE => $template);
$fname = $fh->filename;
$tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
print $tmp "Some data\n";
print "Filename is $tmp\n";
+ $tmp->seek( 0, SEEK_END );
The following interfaces are provided for compatibility with
existing APIs. They should not be used in new code.
@@ -128,23 +133,30 @@
=cut
# 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
-# People would like a version on 5.005 so give them what they want :-)
-use 5.005;
+# People would like a version on 5.004 so give them what they want :-)
+use 5.004;
use strict;
use Carp;
use File::Spec 0.8;
use File::Path qw/ rmtree /;
use Fcntl 1.03;
+use IO::Seekable; # For SEEK_*
use Errno;
require VMS::Stdio if $^O eq 'VMS';
+# pre-emptively load Carp::Heavy. If we don't when we run out of file
+# handles and attempt to call croak() we get an error message telling
+# us that Carp::Heavy won't load rather than an error telling us we
+# have run out of file handles. We either preload croak() or we
+# switch the calls to croak from _gettemp() to use die.
+require Carp::Heavy;
+
# Need the Symbol package if we are running older perl
require Symbol if $] < 5.006;
### For the OO interface
-use base qw/ IO::Handle /;
-use overload '""' => "STRINGIFY";
-
+use base qw/ IO::Handle IO::Seekable /;
+use overload '""' => "STRINGIFY", fallback => 1;
# use 'our' on v5.6.0
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
@@ -169,6 +181,9 @@
mkdtemp
unlink0
cleanup
+ SEEK_SET
+ SEEK_CUR
+ SEEK_END
};
# Groups of functions for export
@@ -176,14 +191,15 @@
%EXPORT_TAGS = (
'POSIX' => [qw/ tmpnam tmpfile /],
'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
+ 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
);
# add contents of these tags to @EXPORT
-Exporter::export_tags('POSIX','mktemp');
+Exporter::export_tags('POSIX','mktemp','seekable');
# Version number
-$VERSION = '0.16';
+$VERSION = '0.18';
# This is a list of characters that can be used in random filenames
@@ -220,7 +236,7 @@
no strict 'refs';
$OPENFLAGS |= $bit if eval {
# Make sure that redefined die handlers do not cause problems
- # eg CGI::Carp
+ # e.g. CGI::Carp
local $SIG{__DIE__} = sub {};
local $SIG{__WARN__} = sub {};
$bit = &$func();
@@ -243,7 +259,7 @@
no strict 'refs';
$OPENTEMPFLAGS |= $bit if eval {
# Make sure that redefined die handlers do not cause problems
- # eg CGI::Carp
+ # e.g. CGI::Carp
local $SIG{__DIE__} = sub {};
local $SIG{__WARN__} = sub {};
$bit = &$func();
@@ -346,7 +362,7 @@
# Substr starts from 0
my $start = length($template) - 1 - $options{"suffixlen"};
- # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
+ # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
# (taking suffixlen into account). Any fewer is insecure.
# Do it using substr - no reason to use a pattern match since
@@ -467,12 +483,6 @@
# but may have O_NOINHERIT. This may or may not be in Fcntl.
local $^F = 2;
- # Store callers umask
- my $umask = umask();
-
- # Set a known umask
- umask(066);
-
# Attempt to open the file
my $open_success = undef;
if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
@@ -487,15 +497,13 @@
}
if ( $open_success ) {
- # Reset umask
- umask($umask) if defined $umask;
+ # in case of odd umask force rw
+ chmod(0600, $path);
# Opened successfully - return file handle and name
return ($fh, $path);
} else {
- # Reset umask
- umask($umask) if defined $umask;
# Error opening file - abort with error
# if the reason was anything but EEXIST
@@ -509,24 +517,14 @@
}
} elsif ($options{"mkdir"}) {
- # Store callers umask
- my $umask = umask();
-
- # Set a known umask
- umask(066);
-
# Open the temp directory
if (mkdir( $path, 0700)) {
- # created okay
- # Reset umask
- umask($umask) if defined $umask;
+ # in case of odd umask
+ chmod(0700, $path);
return undef, $path;
} else {
- # Reset umask
- umask($umask) if defined $umask;
-
# Abort with error if the reason for failure was anything
# except EEXIST
unless ($!{EEXIST}) {
@@ -639,10 +637,7 @@
# force a file to be readonly when written to certain temp locations
sub _force_writable {
my $file = shift;
- my $umask = umask();
- umask(066);
chmod 0600, $file;
- umask($umask) if defined $umask;
}
@@ -679,11 +674,11 @@
return 1 if $^O eq 'VMS'; # owner delete control at file level
# Check to see whether owner is neither superuser (or a system uid) nor me
- # Use the real uid from the $< variable
+ # Use the effective uid from the $> variable
# UID is in [4]
- if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+ if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
- Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$< path='$path'",
File::Temp->top_system_uid());
$$err_ref = "Directory owned neither by root nor the current user"
@@ -969,7 +964,9 @@
Note that there is no method to obtain the filehandle from the
C<File::Temp> object. The object itself acts as a filehandle. Also,
the object is configured such that it stringifies to the name of the
-temporary file.
+temporary file, and can be compared to a filename directly. The object
+isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
+available.
=over 4
@@ -995,6 +992,8 @@
Arguments are case insensitive.
+Can call croak() if an error occurs.
+
=cut
sub new {
@@ -1189,6 +1188,8 @@
Options can be combined as required.
+Will croak() if there is an error.
+
=cut
sub tempfile {
@@ -1360,6 +1361,8 @@
Of course, if the template is not specified, the temporary directory
will be created in tmpdir() and will also be removed at program exit.
+Will croak() if there is an error.
+
=cut
# '
@@ -1480,6 +1483,8 @@
to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
with unique alphanumeric combinations.
+Will croak() if there is an error.
+
=cut
@@ -1521,6 +1526,8 @@
Returns just the filehandle alone when called in scalar context.
+Will croak() if there is an error.
+
=cut
sub mkstemps {
@@ -1559,10 +1566,11 @@
$tmpdir_name = mkdtemp($template);
Returns the name of the temporary directory created.
-Returns undef on failure.
Directory must be removed by the caller.
+Will croak() if there is an error.
+
=cut
#' # for emacs
@@ -1604,6 +1612,8 @@
Template is the same as that required by mkstemp().
+Will croak() if there is an error.
+
=cut
sub mktemp {
@@ -1664,6 +1674,8 @@
See L<File::Spec/tmpdir> for information on the choice of temporary
directory for a particular operating system.
+Will croak() if there is an error.
+
=cut
sub tmpnam {
@@ -1698,6 +1710,8 @@
Currently this command will probably not work when the temporary
directory is on an NFS file system.
+Will croak() if there is an error.
+
=cut
sub tmpfile {
@@ -1741,6 +1755,8 @@
Because this function uses mktemp(), it can suffer from race conditions.
+Will croak() if there is an error.
+
=cut
sub tempnam {
@@ -1781,8 +1797,9 @@
unlink0($fh, $path)
or die "Error unlinking file $path safely";
-Returns false on error. The filehandle is not closed since on some
-occasions this is not required.
+Returns false on error but croaks() if there is a security
+anomaly. The filehandle is not closed since on some occasions this is
+not required.
On some platforms, for example Windows NT, it is not possible to
unlink an open file (the file must be closed first). On those
@@ -1808,6 +1825,10 @@
and an unlink on open file is supported. If the unlink is to be deferred
to the END block, the file is still registered for removal.
+This function should not be called if you are using the object oriented
+interface since the it will interfere with the object destructor deleting
+the file.
+
=cut
sub unlink0 {
@@ -1861,9 +1882,9 @@
or die "Error comparing handle with file";
Returns false if the stat information differs or if the link count is
-greater than 1.
+greater than 1. Calls croak if there is a security anomaly.
-On certain platofms, eg Windows, not all the fields returned by stat()
+On certain platforms, for example Windows, not all the fields returned by
stat()
can be compared. For example, the C<dev> and C<rdev> fields seem to be
different in Windows. Also, it seems that the size of the file
returned by stat() does not always agree, with C<stat(FH)> being more
@@ -1963,6 +1984,9 @@
This function is disabled if the global variable $KEEP_ALL is true.
+Can call croak() if there is a security anomaly during the stat()
+comparison.
+
=cut
sub unlink1 {
@@ -2203,6 +2227,12 @@
means that a child will not attempt to remove temp files created by the
parent process.
+If you are forking many processes in parallel that are all creating
+temporary files, you may need to reset the random number seed using
+srand(EXPR) in each child else all the children will attempt to walk
+through the same set of random file names and may well cause
+themselves to give up if they exceed the number of retry attempts.
+
=head2 BINMODE
The file returned by File::Temp will have been opened in binary mode
@@ -2222,14 +2252,14 @@
L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
-See L<IO::File> and L<File::MkTemp>, L<Apachae::TempFile> for
+See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
different implementations of temporary file handling.
=head1 AUTHOR
Tim Jenness E<lt>[EMAIL PROTECTED]<gt>
-Copyright (C) 1999-2005 Tim Jenness and the UK Particle Physics and
+Copyright (C) 1999-2007 Tim Jenness and the UK Particle Physics and
Astronomy Research Council. All Rights Reserved. This program is free
software; you can redistribute it and/or modify it under the same
terms as Perl itself.
==== //depot/maint-5.8/perl/lib/File/Temp/t/cmp.t#1 (text) ====
Index: perl/lib/File/Temp/t/cmp.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/lib/File/Temp/t/cmp.t 2007-02-12 13:59:14.000000000 -0800
@@ -0,0 +1,11 @@
+#!perl -w
+# Test overloading
+
+use Test::More tests => 3;
+use strict;
+
+BEGIN {use_ok( "File::Temp" ); }
+
+my $fh = new File::Temp();
+ok( "$fh" ne "foo", "compare stringified object with string");
+ok( $fh ne "foo", "compare object with string");
\ No newline at end of file
==== //depot/maint-5.8/perl/lib/File/Temp/t/seekable.t#1 (text) ====
Index: perl/lib/File/Temp/t/seekable.t
--- /dev/null 2007-01-16 11:55:45.526841103 -0800
+++ perl/lib/File/Temp/t/seekable.t 2007-02-12 13:59:14.000000000 -0800
@@ -0,0 +1,32 @@
+# -*- perl -*-
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl File-Temp.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 7;
+BEGIN { use_ok('File::Temp') };
+
+#########################
+
+# Insert your test code below, the Test::More module is use()ed here so read
+# its man page ( perldoc Test::More ) for help writing this test script.
+
+# make sure we can create a tmp file...
+$tmp = File::Temp->new;
+isa_ok( $tmp, 'File::Temp' );
+isa_ok( $tmp, 'IO::Handle' );
+isa_ok( $tmp, 'IO::Seekable' );
+
+# make sure the seek method is available...
+ok( File::Temp->can('seek'), 'tmp can seek' );
+
+# make sure IO::Handle methods are still there...
+ok( File::Temp->can('print'), 'tmp can print' );
+
+# let's see what we're exporting...
+$c = scalar @File::Temp::EXPORT;
+$l = join ' ', @File::Temp::EXPORT;
+ok( $c == 9, "really exporting $c: $l" );
End of Patch.
