File-Temp
view release on metacpan or search on metacpan
lib/File/Temp.pm view on Meta::CPAN
# or a tempfile
my ($volume, $directories, $file);
my $parent; # parent directory
if ($options{"mkdir"}) {
# There is no filename at the end
($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
# The parent is then $directories without the last directory
# Split the directory and put it back together again
my @dirs = File::Spec->splitdir($directories);
# 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
$parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
# ...and attach the volume (no filename)
$parent = File::Spec->catpath($volume, $parent, '');
}
}
} else {
# Get rid of the last filename (use File::Basename for this?)
($volume, $directories, $file) = File::Spec->splitpath( $path );
# Join up without the file part
$parent = File::Spec->catpath($volume,$directories,'');
# If $parent is empty replace with curdir
$parent = File::Spec->curdir
unless $directories ne '';
}
# 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 (-e $parent) {
${$options{ErrStr}} = "Parent directory ($parent) does not exist";
return ();
}
unless (-d $parent) {
${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
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) {
my $safeerr;
unless (_is_safe($parent,\$safeerr)) {
${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
return ();
}
} elsif (File::Temp->safe_level == HIGH) {
my $safeerr;
unless (_is_verysafe($parent, \$safeerr)) {
${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
return ();
}
}
my $perms = $options{file_permissions};
my $has_perms = defined $perms;
$perms = 0600 unless $has_perms;
# Now try MAX_TRIES time to open the file
for (my $i = 0; $i < MAX_TRIES; $i++) {
# Try to open the file if requested
if ($options{"open"}) {
my $fh;
# If we are running before perl5.6.0 we can not auto-vivify
if ($] < 5.006) {
$fh = &Symbol::gensym;
}
# 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;
# Attempt to open the file
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, $perms, 'fop=dlt');
$open_success = $fh;
} else {
my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
$OPENTEMPFLAGS :
$OPENFLAGS );
$flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
$open_success = sysopen($fh, $path, $flags, $perms);
}
if ( $open_success ) {
# in case of odd umask force rw
chmod($perms, $path) unless $has_perms;
# Opened successfully - return file handle and name
return ($fh, $path);
} else {
lib/File/Temp.pm view on Meta::CPAN
# This routine based on version written by Tom Christiansen
# Presumably, by the time we actually attempt to create the
# file or directory in this directory, it may not be safe
# anymore... Have to run _is_safe directly after the open.
sub _is_safe {
my $path = shift;
my $err_ref = shift;
# Stat path
my @info = stat($path);
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 effective uid from the $> variable
# UID is in [4]
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;
}
# check whether group or other can write file
# use 066 to detect either reading or writing
# use 022 to check writability
# Do it with S_IWOTH and S_IWGRP for portability (maybe)
# mode is in info[2]
if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
# 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
# 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
local($@);
my $chown_restricted;
$chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
# If chown_resticted is set to some value we should test it
if (defined $chown_restricted) {
# Return if the current directory is safe
return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
}
# To reach this point either, the _PC_CHOWN_RESTRICTED symbol
# was not available or the symbol was there but chown giveaway
# is allowed. Either way, we now have to test the entire tree for
# safety.
# Convert path to an absolute directory if required
unless (File::Spec->file_name_is_absolute($path)) {
$path = File::Spec->rel2abs($path);
}
# Split directory into components - assume no file
my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
# 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
# so we will probably check the bottom directory twice in some cases
my @dirs = File::Spec->splitdir($directories);
# Concatenate one less directory each time around
foreach my $pos (0.. $#dirs) {
# Get a directory name
my $dir = File::Spec->catpath($volume,
File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
''
);
print "TESTING DIR $dir\n" if $DEBUG;
# Check the directory
return 0 unless _is_safe($dir,$err_ref);
}
return 1;
}
# internal routine to determine whether unlink works on this
# platform for files that are currently open.
# Returns true if we can, false otherwise.
# Currently WinNT, OS/2 and VMS can not unlink an opened file
# On VMS this is because the O_EXCL flag is used to open the
# temporary file. Currently I do not know enough about the issues
# on VMS to decide whether O_EXCL is a requirement.
sub _can_unlink_opened_file {
if (grep $^O eq $_, qw/MSWin32 os2 VMS dos MacOS haiku/) {
return 0;
} else {
return 1;
}
}
# internal routine to decide which security levels are allowed
# see safe_level() for more information on this
lib/File/Temp.pm view on Meta::CPAN
#pod =item B<cleanup>
#pod
#pod Calling this function will cause any temp files or temp directories
#pod that are registered for removal to be removed. This happens automatically
#pod when the process exits but can be triggered manually if the caller is sure
#pod that none of the temp files are required. This method can be registered as
#pod an Apache callback.
#pod
#pod Note that if a temp directory is your current directory, it cannot be
#pod removed. C<chdir()> out of the directory first before calling
#pod C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
#pod is set, this happens automatically.)
#pod
#pod On OSes where temp files are automatically removed when the temp file
#pod is closed, calling this function will have no effect other than to remove
#pod temporary directories (which may include temporary files).
#pod
#pod File::Temp::cleanup();
#pod
#pod Not exported by default.
#pod
#pod Current API available since 0.15.
#pod
#pod =back
#pod
#pod =head1 PACKAGE VARIABLES
#pod
#pod These functions control the global state of the package.
#pod
#pod =over 4
#pod
#pod =item B<safe_level>
#pod
#pod Controls the lengths to which the module will go to check the safety of the
#pod temporary file or directory before proceeding.
#pod Options are:
#pod
#pod =over 8
#pod
#pod =item STANDARD
#pod
#pod Do the basic security measures to ensure the directory exists and is
#pod writable, that temporary files are opened only if they do not already
#pod exist, and that possible race conditions are avoided. Finally the
#pod L<unlink0|"unlink0"> function is used to remove files safely.
#pod
#pod =item MEDIUM
#pod
#pod In addition to the STANDARD security, the output directory is checked
#pod to make sure that it is owned either by root or the user running the
#pod program. If the directory is writable by group or by other, it is then
#pod checked to make sure that the sticky bit is set.
#pod
#pod Will not work on platforms that do not support the C<-k> test
#pod for sticky bit.
#pod
#pod =item HIGH
#pod
#pod In addition to the MEDIUM security checks, also check for the
#pod possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
#pod sysconf() function. If this is a possibility, each directory in the
#pod path is checked in turn for safeness, recursively walking back to the
#pod root directory.
#pod
#pod For platforms that do not support the L<POSIX|POSIX>
#pod C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
#pod assumed that ``chown() giveaway'' is possible and the recursive test
#pod is performed.
#pod
#pod =back
#pod
#pod The level can be changed as follows:
#pod
#pod File::Temp->safe_level( File::Temp::HIGH );
#pod
#pod The level constants are not exported by the module.
#pod
#pod Currently, you must be running at least perl v5.6.0 in order to
#pod run with MEDIUM or HIGH security. This is simply because the
#pod safety tests use functions from L<Fcntl|Fcntl> that are not
#pod available in older versions of perl. The problem is that the version
#pod number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
#pod they are different versions.
#pod
#pod On systems that do not support the HIGH or MEDIUM safety levels
#pod (for example Win NT or OS/2) any attempt to change the level will
#pod be ignored. The decision to ignore rather than raise an exception
#pod allows portable programs to be written with high security in mind
#pod for the systems that can support this without those programs failing
#pod on systems where the extra tests are irrelevant.
#pod
#pod If you really need to see whether the change has been accepted
#pod simply examine the return value of C<safe_level>.
#pod
#pod $newlevel = File::Temp->safe_level( File::Temp::HIGH );
#pod die "Could not change to high security"
#pod if $newlevel != File::Temp::HIGH;
#pod
#pod Available since 0.05.
#pod
#pod =cut
{
# protect from using the variable itself
my $LEVEL = STANDARD;
sub safe_level {
my $self = shift;
if (@_) {
my $level = shift;
if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
} else {
# Don't allow this on perl 5.005 or earlier
if ($] < 5.006 && $level != STANDARD) {
# Cant do MEDIUM or HIGH checks
croak "Currently requires perl 5.006 or newer to do the safe checks";
}
# Check that we are allowed to change level
# Silently ignore if we can not.
$LEVEL = $level if _can_do_level($level);
}
}
return $LEVEL;
}
}
#pod =item TopSystemUID
lib/File/Temp.pm view on Meta::CPAN
=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.
Note that if a temp directory is your current directory, it cannot be
removed. C<chdir()> out of the directory first before calling
C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
is set, this happens automatically.)
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.
Current API available since 0.15.
=back
=head1 PACKAGE VARIABLES
These functions control the global state of the package.
=over 4
=item B<safe_level>
Controls the lengths to which the module will go to check the safety of the
temporary file or directory before proceeding.
Options are:
=over 8
=item STANDARD
Do the basic security measures to ensure the directory exists and is
writable, that temporary files are opened only if they do not already
exist, and that possible race conditions are avoided. Finally the
L<unlink0|"unlink0"> function is used to remove files safely.
=item MEDIUM
In addition to the STANDARD security, the output directory is checked
to make sure that it is owned either by root or the user running the
program. If the directory is writable by group or by other, it is then
checked to make sure that the sticky bit is set.
Will not work on platforms that do not support the C<-k> test
for sticky bit.
=item HIGH
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
root directory.
For platforms that do not support the L<POSIX|POSIX>
C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
assumed that ``chown() giveaway'' is possible and the recursive test
is performed.
=back
The level can be changed as follows:
File::Temp->safe_level( File::Temp::HIGH );
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
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
they are different versions.
On systems that do not support the HIGH or MEDIUM safety levels
(for example Win NT or OS/2) any attempt to change the level will
be ignored. The decision to ignore rather than raise an exception
allows portable programs to be written with high security in mind
for the systems that can support this without those programs failing
on systems where the extra tests are irrelevant.
If you really need to see whether the change has been accepted
simply examine the return value of C<safe_level>.
$newlevel = File::Temp->safe_level( File::Temp::HIGH );
die "Could not change to high security"
if $newlevel != File::Temp::HIGH;
Available since 0.05.
=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
simply by root.
This is required since on many unix systems C</tmp> is not owned
by root.
Default is to assume that any UID less than or equal to 10 is a root
UID.
File::Temp->top_system_uid(10);
my $topid = File::Temp->top_system_uid;
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.
Available since 0.05.
=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.
( run in 1.773 second using v1.01-cache-2.11-cpan-71847e10f99 )