File::Temp - return name and handle of a temporary file safely
+=begin __INTERNALS
+
+=head1 PORTABILITY
+
+This section is at the top in order to provide easier access to
+porters. It is not expected to be rendered by a standard pod
+formatting tool. Please skip straight to the SYNOPSIS section if you
+are not trying to port this module to a new platform.
+
+This module is designed to be portable across operating systems and it
+currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
+(Classic). 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 not 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 /;
+ use File::Temp qw/ tempfile tempdir /;
- $dir = tempdir( CLEANUP => 1 );
- ($fh, $filename) = tempfile( DIR => $dir );
+ $fh = tempfile();
+ ($fh, $filename) = tempfile();
($fh, $filename) = tempfile( $template, DIR => $dir);
($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
- $fh = tempfile();
+
+ $dir = tempdir( CLEANUP => 1 );
+ ($fh, $filename) = tempfile( DIR => $dir );
+
+Object interface:
+
+ require File::Temp;
+ use File::Temp ();
+ use File::Temp qw/ :seekable /;
+
+ $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.
MkTemp family:
$fh = tmpfile();
($fh, $file) = tmpnam();
- ($fh, $file) = tmpfile();
-
Compatibility functions:
$unopened_file = File::Temp::tempnam( $dir, $pfx );
-=begin later
-
-Objects (NOT YET IMPLEMENTED):
-
- require File::Temp;
-
- $fh = new File::Temp($template);
- $fname = $fh->filename;
-
-=end later
-
=head1 DESCRIPTION
-C<File::Temp> can be used to create and open temporary files in a safe way.
-The tempfile() function can be used to return the name and the open
-filehandle of a temporary file. The tempdir() function can
-be used to create a temporary directory.
+C<File::Temp> can be used to create and open temporary files in a safe
+way. There is both a function interface and an object-oriented
+interface. The File::Temp constructor or the tempfile() function can
+be used to return the name and the open filehandle of a temporary
+file. The tempdir() function can 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(),
=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 Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
-
-# Need the Symbol package if we are running older perl
+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 IO::Seekable /;
+use overload '""' => "STRINGIFY", fallback => 1;
# use 'our' on v5.6.0
-use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
+use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
$DEBUG = 0;
+$KEEP_ALL = 0;
# We are exporting functions
mkstemps
mkdtemp
unlink0
+ cleanup
+ SEEK_SET
+ SEEK_CUR
+ SEEK_END
};
# Groups of functions for export
%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 number
-$VERSION = '0.09';
+$VERSION = '0.18';
# This is a list of characters that can be used in random filenames
# Maximum number of tries to make a temp file before failing
-use constant MAX_TRIES => 10;
+use constant MAX_TRIES => 1000;
# Minimum number of X characters that should be in a template
use constant MINX => 4;
my $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 };
+unless ($^O eq 'MacOS') {
+ for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
+ my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+ no strict 'refs';
+ $OPENFLAGS |= $bit if eval {
+ # Make sure that redefined die handlers do not cause problems
+ # e.g. CGI::Carp
+ local $SIG{__DIE__} = sub {};
+ local $SIG{__WARN__} = sub {};
+ $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;
+unless ($^O eq 'MacOS') {
+ for my $oflag (qw/ TEMPORARY /) {
+ my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
+ no strict 'refs';
+ $OPENTEMPFLAGS |= $bit if eval {
+ # Make sure that redefined die handlers do not cause problems
+ # e.g. CGI::Carp
+ local $SIG{__DIE__} = sub {};
+ local $SIG{__WARN__} = sub {};
+ $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
+
+# Optionally a reference to a scalar can be passed into the function
+# On error this will be used to store the reason for the error
+# "ErrStr" => \$errstr
+
# "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().
# ($fh, $name) = _gettemp($template, "open" => 1);
# for the current version, failures are associated with
-# a carp to give the reason whilst debugging
-
+# stored in an error string and returned to give the reason whilst debugging
+# This routine is not called by any external function
sub _gettemp {
croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
unless scalar(@_) >= 1;
+ # the internal error string - expect it to be overridden
+ # Need this in case the caller decides not to supply us a value
+ # need an anonymous scalar
+ my $tempErrStr;
+
# Default options
my %options = (
"open" => 0,
"mkdir" => 0,
"suffixlen" => 0,
+ "unlink_on_close" => 0,
+ "ErrStr" => \$tempErrStr,
);
# Read the template
my $template = shift;
if (ref($template)) {
+ # Use a warning here since we have not yet merged ErrStr
carp "File::Temp::_gettemp: template must not be a reference";
return ();
}
# Check that the number of entries on stack are even
if (scalar(@_) % 2 != 0) {
+ # Use a warning here since we have not yet merged ErrStr
carp "File::Temp::_gettemp: Must have even number of options";
return ();
}
# Read the options and merge with defaults
%options = (%options, @_) if @_;
+ # Make sure the error string is set to undef
+ ${$options{ErrStr}} = undef;
+
# Can not open the file and make a directory in a single call
if ($options{"open"} && $options{"mkdir"}) {
- carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n";
+ ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
return ();
}
# 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
# we know where we are looking and what we are looking for
if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
- carp "File::Temp::_gettemp: The template must contain at least ". MINX ." 'X' characters\n";
+ ${$options{ErrStr}} = "The template must end with at least ".
+ MINX . " 'X' characters\n";
return ();
}
# Split the directory and put it back together again
my @dirs = File::Spec->splitdir($directories);
- # If @dirs only has one entry that means we are in the current
- # directory
+ # If @dirs only has one entry (i.e. the directory template) that means
+ # we are in the current directory
if ($#dirs == 0) {
$parent = File::Spec->curdir;
} else {
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
}
- # Check that the parent directories exist
+ # Check that the parent directories exist
# Do this even for the case where we are simply returning a name
# not a file -- no point returning a name that includes a directory
# that does not exist or is not writable
- unless (-d $parent && -w _) {
- carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory"
- . " or is not writable\n";
+ unless (-d $parent) {
+ ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
+ return ();
+ }
+ unless (-w $parent) {
+ ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
return ();
}
+
# Check the stickiness of the directory and chown giveaway if required
# If the directory is world writable the sticky bit
# must be set
if (File::Temp->safe_level == MEDIUM) {
- unless (_is_safe($parent)) {
- carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+ my $safeerr;
+ unless (_is_safe($parent,\$safeerr)) {
+ ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
return ();
}
} elsif (File::Temp->safe_level == HIGH) {
- unless (_is_verysafe($parent)) {
- carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
+ my $safeerr;
+ unless (_is_verysafe($parent, \$safeerr)) {
+ ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
return ();
}
}
- # 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++) {
# Try to make sure this will be marked close-on-exec
# XXX: Win32 doesn't respect this, nor the proper fcntl,
# 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);
+ local $^F = 2;
# Attempt to open the file
- if ( sysopen($fh, $path, $OPENFLAGS, 0600) ) {
+ my $open_success = undef;
+ if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
+ # 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"} && !$KEEP_ALL) ?
+ $OPENTEMPFLAGS :
+ $OPENFLAGS );
+ $open_success = sysopen($fh, $path, $flags, 0600);
+ }
+ if ( $open_success ) {
+
+ # in case of odd umask force rw
+ chmod(0600, $path);
- # Reset umask
- umask($umask);
-
# Opened successfully - return file handle and name
return ($fh, $path);
} else {
- # Reset umask
- umask($umask);
# Error opening file - abort with error
# if the reason was anything but EEXIST
- unless ($! == EEXIST) {
- carp "File::Temp: Could not create temp file $path: $!";
+ unless ($!{EEXIST}) {
+ ${$options{ErrStr}} = "Could not create temp file $path: $!";
return ();
}
# Loop round for another try
-
+
}
} 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);
+ # in case of odd umask
+ chmod(0700, $path);
return undef, $path;
} else {
- # Reset umask
- umask($umask);
-
# Abort with error if the reason for failure was anything
# except EEXIST
- unless ($! == EEXIST) {
- carp "File::Temp: Could not create directory $path: $!";
+ unless ($!{EEXIST}) {
+ ${$options{ErrStr}} = "Could not create directory $path: $!";
return ();
}
# Check for out of control looping
if ($counter > $MAX_GUESS) {
- carp "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
+ ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
return ();
}
}
# If we get here, we have run out of tries
- carp "Have exceeded the maximum number of attempts (".MAX_TRIES .
- ") to open temp file/dir";
+ ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
+ . MAX_TRIES . ") to open temp file/dir";
return ();
}
# Internal routine to replace the XXXX... with random characters
-# This has to be done by _gettemp() every time it fails to
+# This has to be done by _gettemp() every time it fails to
# open a temp file/dir
-# Arguments: $template (the template with XXX),
+# Arguments: $template (the template with XXX),
# $ignore (number of characters at end to ignore)
# Returns: modified template
} else {
$path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
}
-
return $path;
}
+# Internal routine to force a temp file to be writable after
+# it is created so that we can unlink it. Windows seems to occassionally
+# force a file to be readonly when written to certain temp locations
+sub _force_writable {
+ my $file = shift;
+ chmod 0600, $file;
+}
+
+
# internal routine to check to see if the directory is safe
# First checks to see if the directory is not owned by the
# current user or root. Then checks to see if anyone else
# Will not work on systems that do not support sticky bit
#Args: directory path to check
+# Optionally: reference to scalar to contain error message
# Returns true if the path is safe and false otherwise.
# Returns undef if can not even run stat() on the path
sub _is_safe {
my $path = shift;
+ my $err_ref = shift;
# Stat path
my @info = stat($path);
- return 0 unless scalar(@info);
+ unless (scalar(@info)) {
+ $$err_ref = "stat(path) returned no values";
+ return 0;
+ };
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] != $<) {
- 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 euid=$< path='$path'",
+ File::Temp->top_system_uid());
+
+ $$err_ref = "Directory owned neither by root nor the current user"
+ if ref($err_ref);
return 0;
}
# mode is in info[2]
if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
- return 0 unless -d _; # Must be a directory
- return 0 unless -k _; # Must be sticky
+ # Must be a directory
+ unless (-d $path) {
+ $$err_ref = "Path ($path) is not a directory"
+ if ref($err_ref);
+ return 0;
+ }
+ # Must have sticky bit set
+ unless (-k $path) {
+ $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
+ if ref($err_ref);
+ return 0;
+ }
}
return 1;
}
# Internal routine to check whether a directory is safe
-# for temp files. Safer than _is_safe since it checks for
+# for temp files. Safer than _is_safe since it checks for
# the possibility of chown giveaway and if that is a possibility
# checks each directory in the path to see if it is safe (with _is_safe)
# If _PC_CHOWN_RESTRICTED is not set, does the full test of each
# directory anyway.
+# Takes optional second arg as scalar ref to error reason
+
sub _is_verysafe {
# Need POSIX - but only want to bother if really necessary due to overhead
require POSIX;
my $path = shift;
+ print "_is_verysafe testing $path\n" if $DEBUG;
return 1 if $^O eq 'VMS'; # owner delete control at file level
+ my $err_ref = shift;
+
# Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
# and If it is not there do the extensive test
my $chown_restricted;
if (defined $chown_restricted) {
# Return if the current directory is safe
- return _is_safe($path) if POSIX::sysconf( $chown_restricted );
+ return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
}
# Split directory into components - assume no file
my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
- # Slightly less efficient than having a a function in File::Spec
+ # Slightly less efficient than having a function in File::Spec
# to chop off the end of a directory or even a function that
# can handle ../ in a directory tree
# Sometimes splitdir() returns a blank at the end
print "TESTING DIR $dir\n" if $DEBUG;
# Check the directory
- return 0 unless _is_safe($dir);
+ return 0 unless _is_safe($dir,$err_ref);
}
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' || $^O eq 'MacOS') {
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' || $^O eq 'MacOS' || $^O eq 'mpeix') {
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
- # removed. One array for files, another for directories
- # They will only exist in this block
- # This means we only have to set up a single END block to remove all files
- # @files_to_unlink contains an array ref with the filehandle and filename
- my (@files_to_unlink, @dirs_to_unlink);
+ # removed. One array for files, another for directories They will
+ # only exist in this block.
+
+ # This means we only have to set up a single END block to remove
+ # all files.
+
+ # in order to prevent child processes inadvertently deleting the parent
+ # temp files we use a hash to store the temp files and directories
+ # created by a particular process id.
+
+ # %files_to_unlink contains values that are references to an array of
+ # array references containing the filehandle and filename associated with
+ # the temp file.
+ my (%files_to_unlink, %dirs_to_unlink);
# Set up an end block to use these arrays
END {
- # Files
- foreach my $file (@files_to_unlink) {
- # close the filehandle without checking its state
- # in order to make real sure that this is closed
- # if its already closed then I dont care about the answer
- # probably a better way to do this
- close($file->[0]); # file handle is [0]
-
- if (-f $file->[1]) { # file name is [1]
- unlink $file->[1] or warn "Error removing ".$file->[1];
+ cleanup();
+ }
+
+ # Cleanup function. Always triggered on END but can be invoked
+ # manually.
+ sub cleanup {
+ if (!$KEEP_ALL) {
+ # Files
+ my @files = (exists $files_to_unlink{$$} ?
+ @{ $files_to_unlink{$$} } : () );
+ foreach my $file (@files) {
+ # close the filehandle without checking its state
+ # in order to make real sure that this is closed
+ # if its already closed then I dont care about the answer
+ # probably a better way to do this
+ close($file->[0]); # file handle is [0]
+
+ if (-f $file->[1]) { # file name is [1]
+ _force_writable( $file->[1] ); # for windows
+ unlink $file->[1] or warn "Error removing ".$file->[1];
+ }
}
- }
- # Dirs
- foreach my $dir (@dirs_to_unlink) {
- if (-d $dir) {
- rmtree($dir, $DEBUG, 1);
+ # Dirs
+ my @dirs = (exists $dirs_to_unlink{$$} ?
+ @{ $dirs_to_unlink{$$} } : () );
+ foreach my $dir (@dirs) {
+ if (-d $dir) {
+ rmtree($dir, $DEBUG, 0);
+ }
}
- }
-
+ # clear the arrays
+ @{ $files_to_unlink{$$} } = ()
+ if exists $files_to_unlink{$$};
+ @{ $dirs_to_unlink{$$} } = ()
+ if exists $dirs_to_unlink{$$};
+ }
}
+
# This is the sub called to register a file for deferred unlinking
# This could simply store the input parameters and defer everything
# until the END block. For now we do a bit of checking at this
if (-d $fname) {
# Directory exists so store it
- push (@dirs_to_unlink, $fname);
+ # first on VMS turn []foo into [.foo] for rmtree
+ $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
+ $dirs_to_unlink{$$} = []
+ unless exists $dirs_to_unlink{$$};
+ 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" if $^W;
}
} else {
if (-f $fname) {
# file exists so store handle and name for later removal
- push(@files_to_unlink, [$fh, $fname]);
+ $files_to_unlink{$$} = []
+ unless exists $files_to_unlink{$$};
+ push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
} else {
- carp "Request to remove file $fname could not be completed since it is not there!\n";
+ carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
}
}
}
+=head1 OBJECT-ORIENTED INTERFACE
+
+This is the primary interface for interacting with
+C<File::Temp>. Using the OO interface a temporary file can be created
+when the object is constructed and the file can be removed when the
+object is no longer required.
+
+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, 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
+
+=item B<new>
+
+Create a temporary file object.
+
+ my $tmp = new File::Temp();
+
+by default the object is constructed as if C<tempfile>
+was called without options, but with the additional behaviour
+that the temporary file is removed by the object destructor
+if UNLINK is set to true (the default).
+
+Supported arguments are the same as for C<tempfile>: UNLINK
+(defaulting to true), DIR and SUFFIX. Additionally, the filename
+template is specified using the TEMPLATE option. The OPEN option
+is not supported (the file is always opened).
+
+ $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
+ DIR => 'mydir',
+ SUFFIX => '.dat');
+
+Arguments are case insensitive.
+
+Can call croak() if an error occurs.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+
+ # read arguments and convert keys to upper case
+ my %args = @_;
+ %args = map { uc($_), $args{$_} } keys %args;
+
+ # see if they are unlinking (defaulting to yes)
+ my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
+ delete $args{UNLINK};
+
+ # template (store it in an error so that it will
+ # disappear from the arg list of tempfile
+ my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
+ delete $args{TEMPLATE};
+
+ # Protect OPEN
+ delete $args{OPEN};
+
+ # Open the file and retain file handle and file name
+ my ($fh, $path) = tempfile( @template, %args );
+
+ print "Tmp: $fh - $path\n" if $DEBUG;
+
+ # Store the filename in the scalar slot
+ ${*$fh} = $path;
+
+ # Store unlink information in hash slot (plus other constructor info)
+ %{*$fh} = %args;
+
+ # create the object
+ bless $fh, $class;
+
+ # final method-based configuration
+ $fh->unlink_on_destroy( $unlink );
+
+ return $fh;
+}
+
+=item B<filename>
+
+Return the name of the temporary file associated with this object.
+
+ $filename = $tmp->filename;
+
+This method is called automatically when the object is used as
+a string.
+
+=cut
+
+sub filename {
+ my $self = shift;
+ return ${*$self};
+}
+
+sub STRINGIFY {
+ my $self = shift;
+ return $self->filename;
+}
+
+=item B<unlink_on_destroy>
+
+Control whether the file is unlinked when the object goes out of scope.
+The file is removed if this value is true and $KEEP_ALL is not.
+
+ $fh->unlink_on_destroy( 1 );
+
+Default is for the file to be removed.
+
+=cut
+
+sub unlink_on_destroy {
+ my $self = shift;
+ if (@_) {
+ ${*$self}{UNLINK} = shift;
+ }
+ return ${*$self}{UNLINK};
+}
+
+=item B<DESTROY>
+
+When the object goes out of scope, the destructor is called. This
+destructor will attempt to unlink the file (using C<unlink1>)
+if the constructor was called with UNLINK set to 1 (the default state
+if UNLINK is not specified).
+
+No error is given if the unlink fails.
+
+If the global variable $KEEP_ALL is true, the file will not be removed.
+
+=cut
+
+sub DESTROY {
+ my $self = shift;
+ if (${*$self}{UNLINK} && !$KEEP_ALL) {
+ print "# ---------> Unlinking $self\n" if $DEBUG;
+
+ # The unlink1 may fail if the file has been closed
+ # by the caller. This leaves us with the decision
+ # of whether to refuse to remove the file or simply
+ # do an unlink without test. Seems to be silly
+ # to do this when we are trying to be careful
+ # about security
+ _force_writable( $self->filename ); # for windows
+ unlink1( $self, $self->filename )
+ or unlink($self->filename);
+ }
+}
+
+=back
+
=head1 FUNCTIONS
This section describes the recommended interface for generating
This is the basic function to generate temporary files.
The behaviour of the file can be changed using various options:
+ $fh = tempfile();
($fh, $filename) = tempfile();
Create a temporary file in the directory specified for temporary
Create a temporary file in the current directory using the supplied
template. Trailing `X' characters are replaced with random letters to
generate the filename. At least four `X' characters must be present
-in the template.
+at the end of the template.
($fh, $filename) = tempfile($template, SUFFIX => $suffix)
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 (dependent on
+$KEEP_ALL). Default is for the file to be removed if a file handle is
+requested and to be kept if the filename is requested. In a scalar
+context (where no filename is returned) the file is always deleted
+either (depending on the operating system) on exit or when it is
+closed (unless $KEEP_ALL is true when the temp file is created).
+
+Use the object-oriented interface if fine-grained control of when
+a file is removed is required.
+
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
+(L<File::Spec>) unless a directory is specified explicitly with the
DIR option.
$fh = tempfile( $template, DIR => $dir );
-If called in scalar context, only the filehandle is returned
-and the file will automatically be deleted when closed (see
-the description of tmpfile() elsewhere in this document).
-This is the preferred mode of operation, as if you only
-have a filehandle, you can never create a race condition
-by fumbling with the filename. On systems that can not unlink
-an open file (for example, Windows NT) the file is marked for
-deletion when the program ends (equivalent to setting UNLINK to 1).
+If called in scalar context, only the filehandle is returned and the
+file will automatically be deleted when closed on operating systems
+that support this (see the description of tmpfile() elsewhere in this
+document). This is the preferred mode of operation, as if you only
+have a filehandle, you can never create a race condition by fumbling
+with the filename. On systems that can not unlink an open file or can
+not mark a file as temporary when it is opened (for example, Windows
+NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
+the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
+flag is ignored if present.
(undef, $filename) = tempfile($template, OPEN => 0);
This will return the filename based on the template but
will not open this file. Cannot be used in conjunction with
-UNLINK set to true. Default is to always open the file
+UNLINK set to true. Default is to always open the file
to protect from possible race conditions. A warning is issued
if warnings are turned on. Consider using the tmpnam()
and mktemp() functions described elsewhere in this document
if opening the file is not required.
+Options can be combined as required.
+
+Will croak() if there is an error.
+
=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
# Now add a suffix
$template .= $options{"SUFFIX"};
+ # Determine whether we should tell _gettemp to unlink the file
+ # On unix this is irrelevant and can be worked out after the file is
+ # opened (simply by unlinking the open filehandle). On Windows or VMS
+ # we have to indicate temporary-ness when we open the file. In general
+ # we only want a true temporary file if we are returning just the
+ # filehandle - if the user wants the filename they probably do not
+ # want the file to disappear as soon as they close it (which may be
+ # important if they want a child process to use the file)
+ # For this reason, tie unlink_on_close to the return context regardless
+ # of OS.
+ my $unlink_on_close = ( wantarray ? 0 : 1);
+
# Create the file
- my ($fh, $path);
- croak "Error in tempfile() using $template"
+ my ($fh, $path, $errstr);
+ croak "Error in tempfile() using $template: $errstr"
unless (($fh, $path) = _gettemp($template,
- "open" => $options{'OPEN'},
+ "open" => $options{'OPEN'},
"mkdir"=> 0 ,
+ "unlink_on_close" => $unlink_on_close,
"suffixlen" => length($options{'SUFFIX'}),
+ "ErrStr" => \$errstr,
) );
# Set up an exit handler that can do whatever is right for the
- # system. Do not check return status since this is all done with
- # END blocks
+ # system. This removes files at exit when requested explicitly or when
+ # system is asked to unlink_on_close but is unable to do so because
+ # of OS limitations.
+ # The latter should be achieved by using a tied filehandle.
+ # Do not check return status since this is all done with END blocks.
_deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
# Return
$tempdir = tempdir ( $template, TMPDIR => 1 );
-Using the supplied template, creat the temporary directory in
+Using the supplied template, create the temporary directory in
a standard location for temporary files. Equivalent to doing
$tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
$tempdir = tempdir( $template, CLEANUP => 1);
-Create a temporary directory using the supplied template, but
+Create a temporary directory using the supplied template, but
attempt to remove it (and all files inside it) when the program
exits. Note that an attempt will be made to remove all files from
the directory even if they were not created by this module (otherwise
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
# '
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}) {
$template =~ m/([\.\]:>]+)$/;
$suffixlen = length($1);
}
- croak "Error in tempdir() using $template"
+ if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+ # dir name has a trailing ':'
+ ++$suffixlen;
+ }
+
+ my $errstr;
+ croak "Error in tempdir() using $template: $errstr"
unless ((undef, $tempdir) = _gettemp($template,
"open" => 0,
"mkdir"=> 1 ,
"suffixlen" => $suffixlen,
+ "ErrStr" => \$errstr,
) );
# Install exit handler; must be dynamic to get lexical
=head1 MKTEMP FUNCTIONS
-The following functions are Perl implementations of the
+The following functions are Perl implementations of the
mktemp() family of temp file generation system calls.
=over 4
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
my $template = shift;
- my ($fh, $path);
- croak "Error in mkstemp using $template"
+ my ($fh, $path, $errstr);
+ croak "Error in mkstemp using $template: $errstr"
unless (($fh, $path) = _gettemp($template,
"open" => 1,
"mkdir"=> 0 ,
"suffixlen" => 0,
+ "ErrStr" => \$errstr,
) );
if (wantarray()) {
Returns just the filehandle alone when called in scalar context.
+Will croak() if there is an error.
+
=cut
sub mkstemps {
$template .= $suffix;
- my ($fh, $path);
- croak "Error in mkstemps using $template"
+ my ($fh, $path, $errstr);
+ croak "Error in mkstemps using $template: $errstr"
unless (($fh, $path) = _gettemp($template,
- "open" => 1,
+ "open" => 1,
"mkdir"=> 0 ,
"suffixlen" => length($suffix),
+ "ErrStr" => \$errstr,
) );
if (wantarray()) {
$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
$template =~ m/([\.\]:>]+)$/;
$suffixlen = length($1);
}
- my ($junk, $tmpdir);
- croak "Error creating temp directory from template $template\n"
+ if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
+ # dir name has a trailing ':'
+ ++$suffixlen;
+ }
+ my ($junk, $tmpdir, $errstr);
+ croak "Error creating temp directory from template $template\: $errstr"
unless (($junk, $tmpdir) = _gettemp($template,
"open" => 0,
"mkdir"=> 1 ,
"suffixlen" => $suffixlen,
+ "ErrStr" => \$errstr,
) );
return $tmpdir;
Template is the same as that required by mkstemp().
+Will croak() if there is an error.
+
=cut
sub mktemp {
my $template = shift;
- my ($tmpname, $junk);
- croak "Error getting name to temp file from template $template\n"
+ my ($tmpname, $junk, $errstr);
+ croak "Error getting name to temp file from template $template: $errstr"
unless (($junk, $tmpname) = _gettemp($template,
"open" => 0,
"mkdir"=> 0 ,
"suffixlen" => 0,
+ "ErrStr" => \$errstr,
) );
return $tmpname;
=head1 POSIX FUNCTIONS
This section describes the re-implementation of the tmpnam()
-and tmpfile() functions described in L<POSIX>
+and tmpfile() functions described in L<POSIX>
using the mkstemp() from this module.
Unlike the L<POSIX|POSIX> implementations, the directory used
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 {
=item B<tmpfile>
-In scalar context, returns the filehandle of a temporary file.
+Returns the filehandle of a temporary file.
$fh = tmpfile();
The file is removed when the filehandle is closed or when the program
exits. No access to the filename is provided.
+If the temporary file can not be created undef is returned.
+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 {
- # 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
- unlink0($fh, $file) or croak "Unable to unlink temporary file: $!";
+ # This will fail on NFS
+ unlink0($fh, $file)
+ or return undef;
return $fh;
with common tempfile generation C library functions.
They are not exported and must be addressed using the full package
-name.
+name.
=over 4
Return the name of a temporary file in the specified directory
using a prefix. The file is guaranteed not to exist at the time
-the function was called, but such guarantees are good for one
+the function was called, but such guarantees are good for one
clock tick only. Always use the proper form of C<sysopen>
with C<O_CREAT | O_EXCL> if you must open such a filename.
$filename = File::Temp::tempnam( $dir, $prefix );
Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
-(using unix file convention as an example)
+(using unix file convention as an example)
Because this function uses mktemp(), it can suffer from race conditions.
+Will croak() if there is an error.
+
=cut
sub tempnam {
closest you can come to making sure that the filename unlinked was the
same as the file whose descriptor you hold.
- unlink0($fh, $path) or die "Error unlinking file $path safely";
+ 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
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
not always go to zero immediately after unlinking. Currently, this
command is expected to fail on NFS disks.
+This function is disabled if the global variable $KEEP_ALL is true
+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 {
# Read args
my ($fh, $path) = @_;
- warn "Unlinking $path using unlink0\n"
+ cmpstat($fh, $path) or return 0;
+
+ # attempt remove the file (does not work on some platforms)
+ if (_can_unlink_opened_file()) {
+
+ # return early (Without unlink) if we have been instructed to retain files.
+ return 1 if $KEEP_ALL;
+
+ # XXX: do *not* call this on a directory; possible race
+ # resulting in recursive removal
+ croak "unlink0: $path has become a directory!" if -d $path;
+ unlink($path) or return 0;
+
+ # Stat the filehandle
+ my @fh = stat $fh;
+
+ print "Link count = $fh[3] \n" if $DEBUG;
+
+ # Make sure that the link count is zero
+ # - Cygwin provides deferred unlinking, however,
+ # on Win9x the link count remains 1
+ # On NFS the link count may still be 1 but we cant know that
+ # we are on NFS
+ return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
+
+ } else {
+ _deferred_unlink($fh, $path, 0);
+ return 1;
+ }
+
+}
+
+=item B<cmpstat>
+
+Compare C<stat> of filehandle with C<stat> of provided filename. This
+can be used to check that the filename and filehandle initially point
+to the same file and that the number of links to the file is 1 (all
+fields returned by stat() are compared).
+
+ cmpstat($fh, $path)
+ or die "Error comparing handle with file";
+
+Returns false if the stat information differs or if the link count is
+greater than 1. Calls croak if there is a security anomaly.
+
+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
+accurate than C<stat(filename)>, presumably because of caching issues
+even when using autoflush (this is usually overcome by waiting a while
+after writing to the tempfile before attempting to C<unlink0> it).
+
+Not exported by default.
+
+=cut
+
+sub cmpstat {
+
+ croak 'Usage: cmpstat(filehandle, filename)'
+ unless scalar(@_) == 2;
+
+ # Read args
+ my ($fh, $path) = @_;
+
+ warn "Comparing stat\n"
if $DEBUG;
- # Stat the filehandle
- my @fh = stat $fh;
+ # Stat the filehandle - which may be closed if someone has manually
+ # closed the file. Can not turn off warnings without using $^W
+ # unless we upgrade to 5.006 minimum requirement
+ my @fh;
+ {
+ local ($^W) = 0;
+ @fh = stat $fh;
+ }
+ return unless @fh;
if ($fh[3] > 1 && $^W) {
- carp "unlink0: fstat found too many links; SB=@fh";
+ carp "unlink0: fstat found too many links; SB=@fh" if $^W;
}
# Stat the path
}
# this is no longer a file, but may be a directory, or worse
- unless (-f _) {
+ unless (-f $path) {
confess "panic: $path is no longer a file: SB=@fh";
}
@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);
+ } elsif ($^O eq 'mpeix') {
+ @okstat = (0..4,8..10);
}
# Now compare each entry explicitly by number
}
}
- # attempt remove the file (does not work on some platforms)
- if (_can_unlink_opened_file()) {
- # XXX: do *not* call this on a directory; possible race
- # resulting in recursive removal
- croak "unlink0: $path has become a directory!" if -d $path;
- unlink($path) or return 0;
+ return 1;
+}
- # Stat the filehandle
- @fh = stat $fh;
+=item B<unlink1>
- print "Link count = $fh[3] \n" if $DEBUG;
+Similar to C<unlink0> except after file comparison using cmpstat, the
+filehandle is closed prior to attempting to unlink the file. This
+allows the file to be removed without using an END block, but does
+mean that the post-unlink comparison of the filehandle state provided
+by C<unlink0> is not available.
- # Make sure that the link count is zero
- return ( $fh[3] == 0 ? 1 : 0);
+ unlink1($fh, $path)
+ or die "Error closing and unlinking file";
- } else {
- _deferred_unlink($fh, $path, 0);
- return 1;
- }
+Usually called from the object destructor when using the OO interface.
+Not exported by default.
+
+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 {
+ croak 'Usage: unlink1(filehandle, filename)'
+ unless scalar(@_) == 2;
+
+ # Read args
+ my ($fh, $path) = @_;
+
+ cmpstat($fh, $path) or return 0;
+
+ # Close the file
+ close( $fh ) or return 0;
+
+ # Make sure the file is writable (for windows)
+ _force_writable( $path );
+
+ # return early (without unlink) if we have been instructed to retain files.
+ return 1 if $KEEP_ALL;
+
+ # remove the file
+ return unlink($path);
}
+=item B<cleanup>
+
+Calling this function will cause any temp files or temp directories
+that are registered for removal to be removed. This happens automatically
+when the process exits but can be triggered manually if the caller is sure
+that none of the temp files are required. This method can be registered as
+an Apache callback.
+
+On OSes where temp files are automatically removed when the temp file
+is closed, calling this function will have no effect other than to remove
+temporary directories (which may include temporary files).
+
+ File::Temp::cleanup();
+
+Not exported by default.
+
=back
=head1 PACKAGE VARIABLES
In addition to the MEDIUM security checks, also check for the
possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
sysconf() function. If this is a possibility, each directory in the
-path is checked in turn for safeness, recursively walking back to the
+path is checked in turn for safeness, recursively walking back to the
root directory.
For platforms that do not support the L<POSIX|POSIX>
-C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
+C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
assumed that ``chown() giveaway'' is possible and the recursive test
is performed.
The level constants are not exported by the module.
Currently, you must be running at least perl v5.6.0 in order to
-run with MEDIUM or HIGH security. This is simply because the
+run with MEDIUM or HIGH security. This is simply because the
safety tests use functions from L<Fcntl|Fcntl> that are not
available in older versions of perl. The problem is that the version
number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
simply examine the return value of C<safe_level>.
$newlevel = File::Temp->safe_level( File::Temp::HIGH );
- die "Could not change to high security"
+ die "Could not change to high security"
if $newlevel != File::Temp::HIGH;
=cut
my $LEVEL = STANDARD;
sub safe_level {
my $self = shift;
- if (@_) {
+ if (@_) {
my $level = shift;
if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
- carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n";
+ carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
} else {
# Dont allow this on perl 5.005 or earlier
if ($] < 5.006 && $level != STANDARD) {
=item TopSystemUID
This is the highest UID on the current system that refers to a root
-UID. This is used to make sure that the temporary directory is
-owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
+UID. This is used to make sure that the temporary directory is
+owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
simply by root.
This is required since on many unix systems C</tmp> is not owned
This value can be adjusted to reduce security checking if required.
The value is only relevant when C<safe_level> is set to MEDIUM or higher.
-=back
-
=cut
{
my $TopSystemUID = 10;
+ $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
sub top_system_uid {
my $self = shift;
if (@_) {
}
}
+=item B<$KEEP_ALL>
+
+Controls whether temporary files and directories should be retained
+regardless of any instructions in the program to remove them
+automatically. This is useful for debugging but should not be used in
+production code.
+
+ $File::Temp::KEEP_ALL = 1;
+
+Default is for files to be removed as requested by the caller.
+
+In some cases, files will only be retained if this variable is true
+when the file is created. This means that you can not create a temporary
+file, set this variable and expect the temp file to still be around
+when the program exits.
+
+=item B<$DEBUG>
+
+Controls whether debugging messages should be enabled.
+
+ $File::Temp::DEBUG = 1;
+
+Default is for debugging mode to be disabled.
+
+=back
+
=head1 WARNING
For maximum security, endeavour always to avoid ever looking at,
fcntl($tmpfh, F_SETFD, 0)
or die "Can't clear close-on-exec flag on temp fh: $!\n";
+=head2 Temporary files and NFS
+
+Some problems are associated with using temporary files that reside
+on NFS file systems and it is recommended that a local filesystem
+is used whenever possible. Some of the security tests will most probably
+fail when the temp file is not local. Additionally, be aware that
+the performance of I/O operations over NFS will not be as good as for
+a local disk.
+
+=head2 Forking
+
+In some cases files created by File::Temp are removed from within an
+END block. Since END blocks are triggered when a child process exits
+(unless C<POSIX::_exit()> is used by the child) File::Temp takes care
+to only remove those temp files created by a particular process ID. This
+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
+if such a mode is available. If that is not correct, use the binmode()
+function to change the mode of the filehandle.
+
=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.
+operating system and to help with portability. The module was shipped
+as a standard part of perl from v5.6.1.
=head1 SEE ALSO
L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
-See L<File::MkTemp> for a different implementation of temporary
-file handling.
+See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
+different implementations of temporary file handling.
=head1 AUTHOR
-Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
+Tim Jenness E<lt>tjenness@cpan.orgE<gt>
-Copyright (C) 1999, 2000 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.
-Original Perl implementation loosely based on the OpenBSD C code for
+Original Perl implementation loosely based on the OpenBSD C code for
mkstemp(). Thanks to Tom Christiansen for suggesting that this module
should be written and providing ideas for code improvements and
security enhancements.
=cut
-
1;
projects / p5sagit/p5-mst-13.2.git / blobdiff