File::Temp - return name and handle of a temporary file safely
+=begin __INTERNALS
+
+=head1 PORTABILITY
+
+This module is designed to be portable across operating systems
+and it currently supports Unix, VMS, DOS, OS/2 and Windows. When
+porting to a new OS there are generally three main issues
+that have to be solved:
+
+=over 4
+
+=item *
+
+Can the OS unlink an open file? If it can't then the
+C<_can_unlink_opened_file> method should be modified.
+
+=item *
+
+Are the return values from C<stat> reliable? By default all the
+return values from C<stat> are compared when unlinking a temporary
+file using the filename and the handle. Operating systems other than
+unix do not always have valid entries in all fields. If C<unlink0> fails
+then the C<stat> comparison should be modified accordingly.
+
+=item *
+
+Security. Systems that can not support a test for the sticky bit
+on a directory can not use the MEDIUM and HIGH security tests.
+The C<_can_do_level> method should be modified accordingly.
+
+=back
+
+=end __INTERNALS
+
=head1 SYNOPSIS
use File::Temp qw/ tempfile tempdir /;
be used to create a temporary directory.
The security aspect of temporary file creation is emphasized such that
-a filehandle and filename are returned together. This helps guarantee that
-a race condition can not occur where the temporary file is created by another process
-between checking for the existence of the file and its
-opening. Additional security levels are provided to check, for
-example, that the sticky bit is set on world writable directories.
-See L<"safe_level"> for more information.
+a filehandle and filename are returned together. This helps guarantee
+that a race condition can not occur where the temporary file is
+created by another process between checking for the existence of the
+file and its opening. Additional security levels are provided to
+check, for example, that the sticky bit is set on world writable
+directories. See L<"safe_level"> for more information.
For compatibility with popular C library functions, Perl implementations of
the mkstemp() family of functions are provided. These are, mkstemp(),
use File::Path qw/ rmtree /;
use Fcntl 1.03;
use Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
+require VMS::Stdio if $^O eq 'VMS';
-# Need the Symbol package if we are running older perl
+# Need the Symbol package if we are running older perl
require Symbol if $] < 5.006;
# Version number
-$VERSION = '0.09';
+$VERSION = '0.10';
# This is a list of characters that can be used in random filenames
my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
-for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
+for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
no strict 'refs';
$OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
}
+# On some systems the O_TEMPORARY flag can be used to tell the OS
+# to automatically remove the file when it is closed. This is fine
+# in most cases but not if tempfile is called with UNLINK=>0 and
+# the filename is requested -- in the case where the filename is to
+# be passed to another routine. This happens on windows. We overcome
+# this by using a second open flags variable
+
+my $OPENTEMPFLAGS = $OPENFLAGS;
+for my $oflag (qw/ TEMPORARY /) {
+ my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+ no strict 'refs';
+ $OPENTEMPFLAGS |= $bit if eval { $bit = &$func(); 1 };
+}
# INTERNAL ROUTINES - not to be used outside of package
# default is 0
# "suffixlen" => number of characters at end of PATH to be ignored.
# default is 0.
+# "unlink_on_close" => indicates that, if possible, the OS should remove
+# the file as soon as it is closed. Usually indicates
+# use of the O_TEMPORARY flag to sysopen.
+# Usually irrelevant on unix
+
# "open" and "mkdir" can not both be true
+# "unlink_on_close" is not used when "mkdir" is true.
# The default options are equivalent to mktemp().
"open" => 0,
"mkdir" => 0,
"suffixlen" => 0,
+ "unlink_on_close" => 0,
);
# Read the template
if ($^O eq 'VMS') { # need volume to avoid relative dir spec
$parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
+ $parent = 'sys$disk:[]' if $parent eq '';
} else {
# Put it back together without the last one
}
- # Calculate the flags that we wish to use for the sysopen
- # Some of these are not always available
-# my $openflags;
-# if ($options{"open"}) {
- # Default set
-# $openflags = O_CREAT | O_EXCL | O_RDWR;
-
-# for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
-# my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
-# no strict 'refs';
-# $openflags |= $bit if eval { $bit = &$func(); 1 };
-# }
-
-# }
-
# Now try MAX_TRIES time to open the file
for (my $i = 0; $i < MAX_TRIES; $i++) {
umask(066);
# Attempt to open the file
- if ( sysopen($fh, $path, $OPENFLAGS, 0600) ) {
+ my $open_success = undef;
+ if ( $^O eq 'VMS' and $options{"unlink_on_close"} ) {
+ # make it auto delete on close by setting FAB$V_DLT bit
+ $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
+ $open_success = $fh;
+ } else {
+ my $flags = ( $options{"unlink_on_close"} ?
+ $OPENTEMPFLAGS :
+ $OPENFLAGS );
+ $open_success = sysopen($fh, $path, $flags, 0600);
+ }
+ if ( $open_success ) {
# Reset umask
umask($umask);
# Check to see whether owner is neither superuser (or a system uid) nor me
# Use the real uid from the $< variable
# UID is in [4]
- if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
- carp "Directory owned neither by root nor the current user";
+ if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
+
+ Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
+ File::Temp->top_system_uid());
+
+ carp "Directory owned neither by root nor the current user.";
return 0;
}
sub _can_unlink_opened_file {
- if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS') {
+ if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos') {
return 0;
} else {
return 1;
return 1 if $level == STANDARD;
# Currently, the systems that can do HIGH or MEDIUM are identical
- if ( $^O eq 'MSWin32' || $^O eq 'os2') {
+ if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos') {
return 0;
} else {
return 1;
# - isdir (flag to indicate that we are being given a directory)
# [and hence no filehandle]
-# Status is not referred to since all the magic is done with and END block
+# Status is not referred to since all the magic is done with an END block
{
# Will set up two lexical variables to contain all the files to be
if (-d $fname) {
# Directory exists so store it
+ # first on VMS turn []foo into [.foo] for rmtree
+ $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
push (@dirs_to_unlink, $fname);
} else {
- carp "Request to remove directory $fname could not be completed since it does not exists!\n";
+ carp "Request to remove directory $fname could not be completed since it does not exist!\n";
}
} else {
Translates the template as before except that a directory name
is specified.
+ ($fh, $filename) = tempfile($template, UNLINK => 1);
+
+Return the filename and filehandle as before except that the file is
+automatically removed when the program exits. Default is for the file
+to be removed if a file handle is requested and to be kept if the
+filename is requested.
+
If the template is not specified, a template is always
automatically generated. This temporary file is placed in tmpdir()
(L<File::Spec>) unless a directory is specified explicitly with the
and mktemp() functions described elsewhere in this document
if opening the file is not required.
+Options can be combined as required.
+
=cut
sub tempfile {
# Default options
my %options = (
"DIR" => undef, # Directory prefix
- "SUFFIX" => '', # Template suffix
- "UNLINK" => 0, # Unlink file on exit
- "OPEN" => 1, # Do not open file
+ "SUFFIX" => '', # Template suffix
+ "UNLINK" => 0, # Do not unlink file on exit
+ "OPEN" => 1, # Open file
);
# Check to see whether we have an odd or even number of arguments
}
+ if ($options{"DIR"} and $^O eq 'VMS') {
+
+ # on VMS turn []foo into [.foo] for concatenation
+ $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
+ }
+
# Construct the template
# Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
my ($fh, $path);
croak "Error in tempfile() using $template"
unless (($fh, $path) = _gettemp($template,
- "open" => $options{'OPEN'},
+ "open" => $options{'OPEN'},
"mkdir"=> 0 ,
+ "unlink_on_close" => $options{'UNLINK'},
"suffixlen" => length($options{'SUFFIX'}),
) );
if ($options{'TMPDIR'} || $options{'DIR'}) {
# Strip parent directory from the filename
- #
+ #
# There is no filename at the end
+ $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
# Last directory is then our template
# Prepend the supplied directory or temp dir
if ($options{"DIR"}) {
- $template = File::Spec->catfile($options{"DIR"}, $template);
+ $template = File::Spec->catdir($options{"DIR"}, $template);
} elsif ($options{TMPDIR}) {
sub tmpfile {
- # Simply call tmpnam() in an array context
+ # Simply call tmpnam() in a list context
my ($fh, $file) = tmpnam();
# Make sure file is removed when filehandle is closed
have access to the filehandle).
Additionally, on Windows NT not all the fields returned by stat() can
-be compared. For example, the C<dev> and C<rdev> fields seem to be different
-and also. Also, it seems that the size of the file returned by stat()
+be compared. For example, the C<dev> and C<rdev> fields seem to be
+different. Also, it seems that the size of the file returned by stat()
does not always agree, with C<stat(FH)> being more accurate than
C<stat(filename)>, presumably because of caching issues even when
using autoflush (this is usually overcome by waiting a while after
@okstat = (1,2,3,4,5,7,8,9,10);
} elsif ($^O eq 'os2') {
@okstat = (0, 2..$#fh);
+ } elsif ($^O eq 'VMS') { # device and file ID are sufficient
+ @okstat = (0, 1);
+ } elsif ($^O eq 'dos') {
+ @okstat = (0,2..7,11..$#fh);
}
# Now compare each entry explicitly by number
print "Link count = $fh[3] \n" if $DEBUG;
# Make sure that the link count is zero
- return ( $fh[3] == 0 ? 1 : 0);
+ # - Cygwin provides deferred unlinking, however,
+ # on Win9x the link count remains 1
+ return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
} else {
_deferred_unlink($fh, $path, 0);
=head1 HISTORY
Originally began life in May 1999 as an XS interface to the system
-mkstemp() function. In March 2000, the mkstemp() code was
+mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
translated to Perl for total control of the code's
security checking, to ensure the presence of the function regardless of
operating system and to help with portability.
projects / p5sagit/p5-mst-13.2.git / blobdiff