5 File::Temp - return name and handle of a temporary file safely
11 This module is designed to be portable across operating systems
12 and it currently supports Unix, VMS, DOS, OS/2, Windows and
13 Mac OS (Classic). When
14 porting to a new OS there are generally three main issues
15 that have to be solved:
21 Can the OS unlink an open file? If it can not then the
22 C<_can_unlink_opened_file> method should be modified.
26 Are the return values from C<stat> reliable? By default all the
27 return values from C<stat> are compared when unlinking a temporary
28 file using the filename and the handle. Operating systems other than
29 unix do not always have valid entries in all fields. If C<unlink0> fails
30 then the C<stat> comparison should be modified accordingly.
34 Security. Systems that can not support a test for the sticky bit
35 on a directory can not use the MEDIUM and HIGH security tests.
36 The C<_can_do_level> method should be modified accordingly.
44 use File::Temp qw/ tempfile tempdir /;
46 $dir = tempdir( CLEANUP => 1 );
47 ($fh, $filename) = tempfile( DIR => $dir );
49 ($fh, $filename) = tempfile( $template, DIR => $dir);
50 ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
59 $fh = new File::Temp($template);
60 $fname = $fh->filename;
62 $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
63 print $tmp "Some data\n";
64 print "Filename is $tmp\n";
69 use File::Temp qw/ :mktemp /;
71 ($fh, $file) = mkstemp( "tmpfileXXXXX" );
72 ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
74 $tmpdir = mkdtemp( $template );
76 $unopened_file = mktemp( $template );
80 use File::Temp qw/ :POSIX /;
85 ($fh, $file) = tmpnam();
89 Compatibility functions:
91 $unopened_file = File::Temp::tempnam( $dir, $pfx );
95 C<File::Temp> can be used to create and open temporary files in a safe
96 way. There is both a function interface and an object-oriented
97 interface. The File::Temp constructor or the tempfile() function can
98 be used to return the name and the open filehandle of a temporary
99 file. The tempdir() function can be used to create a temporary
102 The security aspect of temporary file creation is emphasized such that
103 a filehandle and filename are returned together. This helps guarantee
104 that a race condition can not occur where the temporary file is
105 created by another process between checking for the existence of the
106 file and its opening. Additional security levels are provided to
107 check, for example, that the sticky bit is set on world writable
108 directories. See L<"safe_level"> for more information.
110 For compatibility with popular C library functions, Perl implementations of
111 the mkstemp() family of functions are provided. These are, mkstemp(),
112 mkstemps(), mkdtemp() and mktemp().
114 Additionally, implementations of the standard L<POSIX|POSIX>
115 tmpnam() and tmpfile() functions are provided if required.
117 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
118 but should be used with caution since they return only a filename
119 that was valid when function was called, so cannot guarantee
120 that the file will not exist by the time the caller opens the filename.
124 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
125 # People would like a version on 5.005 so give them what they want :-)
130 use File::Path qw/ rmtree /;
133 require VMS::Stdio if $^O eq 'VMS';
135 # Need the Symbol package if we are running older perl
136 require Symbol if $] < 5.006;
138 ### For the OO interface
139 use base qw/ IO::Handle /;
140 use overload '""' => "STRINGIFY";
143 # use 'our' on v5.6.0
144 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
148 # We are exporting functions
150 use base qw/Exporter/;
152 # Export list - to allow fine tuning of export table
166 # Groups of functions for export
169 'POSIX' => [qw/ tmpnam tmpfile /],
170 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
173 # add contents of these tags to @EXPORT
174 Exporter::export_tags('POSIX','mktemp');
180 # This is a list of characters that can be used in random filenames
182 my @CHARS = (qw/ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
183 a b c d e f g h i j k l m n o p q r s t u v w x y z
184 0 1 2 3 4 5 6 7 8 9 _
187 # Maximum number of tries to make a temp file before failing
189 use constant MAX_TRIES => 10;
191 # Minimum number of X characters that should be in a template
192 use constant MINX => 4;
194 # Default template when no template supplied
196 use constant TEMPXXX => 'X' x 10;
198 # Constants for the security level
200 use constant STANDARD => 0;
201 use constant MEDIUM => 1;
202 use constant HIGH => 2;
204 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
205 # us an optimisation when many temporary files are requested
207 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
209 unless ($^O eq 'MacOS') {
210 for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
211 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
213 $OPENFLAGS |= $bit if eval {
214 # Make sure that redefined die handlers do not cause problems
216 local $SIG{__DIE__} = sub {};
217 local $SIG{__WARN__} = sub {};
224 # On some systems the O_TEMPORARY flag can be used to tell the OS
225 # to automatically remove the file when it is closed. This is fine
226 # in most cases but not if tempfile is called with UNLINK=>0 and
227 # the filename is requested -- in the case where the filename is to
228 # be passed to another routine. This happens on windows. We overcome
229 # this by using a second open flags variable
231 my $OPENTEMPFLAGS = $OPENFLAGS;
232 unless ($^O eq 'MacOS') {
233 for my $oflag (qw/ TEMPORARY /) {
234 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
236 $OPENTEMPFLAGS |= $bit if eval {
237 # Make sure that redefined die handlers do not cause problems
239 local $SIG{__DIE__} = sub {};
240 local $SIG{__WARN__} = sub {};
247 # INTERNAL ROUTINES - not to be used outside of package
249 # Generic routine for getting a temporary filename
250 # modelled on OpenBSD _gettemp() in mktemp.c
252 # The template must contain X's that are to be replaced
253 # with the random values
257 # TEMPLATE - string containing the XXXXX's that is converted
258 # to a random filename and opened if required
260 # Optionally, a hash can also be supplied containing specific options
261 # "open" => if true open the temp file, else just return the name
263 # "mkdir"=> if true, we are creating a temp directory rather than tempfile
265 # "suffixlen" => number of characters at end of PATH to be ignored.
267 # "unlink_on_close" => indicates that, if possible, the OS should remove
268 # the file as soon as it is closed. Usually indicates
269 # use of the O_TEMPORARY flag to sysopen.
270 # Usually irrelevant on unix
272 # Optionally a reference to a scalar can be passed into the function
273 # On error this will be used to store the reason for the error
274 # "ErrStr" => \$errstr
276 # "open" and "mkdir" can not both be true
277 # "unlink_on_close" is not used when "mkdir" is true.
279 # The default options are equivalent to mktemp().
282 # filehandle - open file handle (if called with doopen=1, else undef)
283 # temp name - name of the temp file or directory
286 # ($fh, $name) = _gettemp($template, "open" => 1);
288 # for the current version, failures are associated with
289 # stored in an error string and returned to give the reason whilst debugging
290 # This routine is not called by any external function
293 croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
294 unless scalar(@_) >= 1;
296 # the internal error string - expect it to be overridden
297 # Need this in case the caller decides not to supply us a value
298 # need an anonymous scalar
306 "unlink_on_close" => 0,
307 "ErrStr" => \$tempErrStr,
311 my $template = shift;
312 if (ref($template)) {
313 # Use a warning here since we have not yet merged ErrStr
314 carp "File::Temp::_gettemp: template must not be a reference";
318 # Check that the number of entries on stack are even
319 if (scalar(@_) % 2 != 0) {
320 # Use a warning here since we have not yet merged ErrStr
321 carp "File::Temp::_gettemp: Must have even number of options";
325 # Read the options and merge with defaults
326 %options = (%options, @_) if @_;
328 # Make sure the error string is set to undef
329 ${$options{ErrStr}} = undef;
331 # Can not open the file and make a directory in a single call
332 if ($options{"open"} && $options{"mkdir"}) {
333 ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
337 # Find the start of the end of the Xs (position of last X)
338 # Substr starts from 0
339 my $start = length($template) - 1 - $options{"suffixlen"};
341 # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
342 # (taking suffixlen into account). Any fewer is insecure.
344 # Do it using substr - no reason to use a pattern match since
345 # we know where we are looking and what we are looking for
347 if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
348 ${$options{ErrStr}} = "The template must contain at least ".
349 MINX . " 'X' characters\n";
353 # Replace all the X at the end of the substring with a
354 # random character or just all the XX at the end of a full string.
355 # Do it as an if, since the suffix adjusts which section to replace
356 # and suffixlen=0 returns nothing if used in the substr directly
357 # and generate a full path from the template
359 my $path = _replace_XX($template, $options{"suffixlen"});
362 # Split the path into constituent parts - eventually we need to check
363 # whether the directory exists
364 # We need to know whether we are making a temp directory
367 my ($volume, $directories, $file);
368 my $parent; # parent directory
369 if ($options{"mkdir"}) {
370 # There is no filename at the end
371 ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
373 # The parent is then $directories without the last directory
374 # Split the directory and put it back together again
375 my @dirs = File::Spec->splitdir($directories);
377 # If @dirs only has one entry (i.e. the directory template) that means
378 # we are in the current directory
380 $parent = File::Spec->curdir;
383 if ($^O eq 'VMS') { # need volume to avoid relative dir spec
384 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
385 $parent = 'sys$disk:[]' if $parent eq '';
388 # Put it back together without the last one
389 $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
391 # ...and attach the volume (no filename)
392 $parent = File::Spec->catpath($volume, $parent, '');
399 # Get rid of the last filename (use File::Basename for this?)
400 ($volume, $directories, $file) = File::Spec->splitpath( $path );
402 # Join up without the file part
403 $parent = File::Spec->catpath($volume,$directories,'');
405 # If $parent is empty replace with curdir
406 $parent = File::Spec->curdir
407 unless $directories ne '';
411 # Check that the parent directories exist
412 # Do this even for the case where we are simply returning a name
413 # not a file -- no point returning a name that includes a directory
414 # that does not exist or is not writable
416 unless (-d $parent) {
417 ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
421 ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
426 # Check the stickiness of the directory and chown giveaway if required
427 # If the directory is world writable the sticky bit
430 if (File::Temp->safe_level == MEDIUM) {
432 unless (_is_safe($parent,\$safeerr)) {
433 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
436 } elsif (File::Temp->safe_level == HIGH) {
438 unless (_is_verysafe($parent, \$safeerr)) {
439 ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
445 # Now try MAX_TRIES time to open the file
446 for (my $i = 0; $i < MAX_TRIES; $i++) {
448 # Try to open the file if requested
449 if ($options{"open"}) {
452 # If we are running before perl5.6.0 we can not auto-vivify
454 $fh = &Symbol::gensym;
457 # Try to make sure this will be marked close-on-exec
458 # XXX: Win32 doesn't respect this, nor the proper fcntl,
459 # but may have O_NOINHERIT. This may or may not be in Fcntl.
462 # Store callers umask
468 # Attempt to open the file
469 my $open_success = undef;
470 if ( $^O eq 'VMS' and $options{"unlink_on_close"} ) {
471 # make it auto delete on close by setting FAB$V_DLT bit
472 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
475 my $flags = ( $options{"unlink_on_close"} ?
478 $open_success = sysopen($fh, $path, $flags, 0600);
480 if ( $open_success ) {
483 umask($umask) if defined $umask;
485 # Opened successfully - return file handle and name
490 umask($umask) if defined $umask;
492 # Error opening file - abort with error
493 # if the reason was anything but EEXIST
494 unless ($!{EEXIST}) {
495 ${$options{ErrStr}} = "Could not create temp file $path: $!";
499 # Loop round for another try
502 } elsif ($options{"mkdir"}) {
504 # Store callers umask
510 # Open the temp directory
511 if (mkdir( $path, 0700)) {
514 umask($umask) if defined $umask;
520 umask($umask) if defined $umask;
522 # Abort with error if the reason for failure was anything
524 unless ($!{EEXIST}) {
525 ${$options{ErrStr}} = "Could not create directory $path: $!";
529 # Loop round for another try
535 # Return true if the file can not be found
536 # Directory has been checked previously
538 return (undef, $path) unless -e $path;
540 # Try again until MAX_TRIES
544 # Did not successfully open the tempfile/dir
545 # so try again with a different set of random letters
546 # No point in trying to increment unless we have only
547 # 1 X say and the randomness could come up with the same
548 # file MAX_TRIES in a row.
550 # Store current attempt - in principal this implies that the
551 # 3rd time around the open attempt that the first temp file
552 # name could be generated again. Probably should store each
553 # attempt and make sure that none are repeated
555 my $original = $path;
556 my $counter = 0; # Stop infinite loop
561 # Generate new name from original template
562 $path = _replace_XX($template, $options{"suffixlen"});
566 } until ($path ne $original || $counter > $MAX_GUESS);
568 # Check for out of control looping
569 if ($counter > $MAX_GUESS) {
570 ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
576 # If we get here, we have run out of tries
577 ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
578 . MAX_TRIES . ") to open temp file/dir";
584 # Internal routine to return a random character from the
585 # character list. Does not do an srand() since rand()
586 # will do one automatically
588 # No arguments. Return value is the random character
590 # No longer called since _replace_XX runs a few percent faster if
591 # I inline the code. This is important if we are creating thousands of
596 $CHARS[ int( rand( $#CHARS ) ) ];
600 # Internal routine to replace the XXXX... with random characters
601 # This has to be done by _gettemp() every time it fails to
602 # open a temp file/dir
604 # Arguments: $template (the template with XXX),
605 # $ignore (number of characters at end to ignore)
607 # Returns: modified template
611 croak 'Usage: _replace_XX($template, $ignore)'
612 unless scalar(@_) == 2;
614 my ($path, $ignore) = @_;
616 # Do it as an if, since the suffix adjusts which section to replace
617 # and suffixlen=0 returns nothing if used in the substr directly
618 # Alternatively, could simply set $ignore to length($path)-1
619 # Don't want to always use substr when not required though.
622 substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
624 $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
630 # internal routine to check to see if the directory is safe
631 # First checks to see if the directory is not owned by the
632 # current user or root. Then checks to see if anyone else
633 # can write to the directory and if so, checks to see if
634 # it has the sticky bit set
636 # Will not work on systems that do not support sticky bit
638 #Args: directory path to check
639 # Optionally: reference to scalar to contain error message
640 # Returns true if the path is safe and false otherwise.
641 # Returns undef if can not even run stat() on the path
643 # This routine based on version written by Tom Christiansen
645 # Presumably, by the time we actually attempt to create the
646 # file or directory in this directory, it may not be safe
647 # anymore... Have to run _is_safe directly after the open.
655 my @info = stat($path);
656 unless (scalar(@info)) {
657 $$err_ref = "stat(path) returned no values";
660 return 1 if $^O eq 'VMS'; # owner delete control at file level
662 # Check to see whether owner is neither superuser (or a system uid) nor me
663 # Use the real uid from the $< variable
665 if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
667 Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
668 File::Temp->top_system_uid());
670 $$err_ref = "Directory owned neither by root nor the current user"
675 # check whether group or other can write file
676 # use 066 to detect either reading or writing
677 # use 022 to check writability
678 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
680 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
681 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
682 # Must be a directory
684 $$err_ref = "Path ($path) is not a directory"
688 # Must have sticky bit set
690 $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
699 # Internal routine to check whether a directory is safe
700 # for temp files. Safer than _is_safe since it checks for
701 # the possibility of chown giveaway and if that is a possibility
702 # checks each directory in the path to see if it is safe (with _is_safe)
704 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
707 # Takes optional second arg as scalar ref to error reason
711 # Need POSIX - but only want to bother if really necessary due to overhead
715 print "_is_verysafe testing $path\n" if $DEBUG;
716 return 1 if $^O eq 'VMS'; # owner delete control at file level
720 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
721 # and If it is not there do the extensive test
722 my $chown_restricted;
723 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
724 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
726 # If chown_resticted is set to some value we should test it
727 if (defined $chown_restricted) {
729 # Return if the current directory is safe
730 return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
734 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
735 # was not avialable or the symbol was there but chown giveaway
736 # is allowed. Either way, we now have to test the entire tree for
739 # Convert path to an absolute directory if required
740 unless (File::Spec->file_name_is_absolute($path)) {
741 $path = File::Spec->rel2abs($path);
744 # Split directory into components - assume no file
745 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
747 # Slightly less efficient than having a function in File::Spec
748 # to chop off the end of a directory or even a function that
749 # can handle ../ in a directory tree
750 # Sometimes splitdir() returns a blank at the end
751 # so we will probably check the bottom directory twice in some cases
752 my @dirs = File::Spec->splitdir($directories);
754 # Concatenate one less directory each time around
755 foreach my $pos (0.. $#dirs) {
756 # Get a directory name
757 my $dir = File::Spec->catpath($volume,
758 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
762 print "TESTING DIR $dir\n" if $DEBUG;
764 # Check the directory
765 return 0 unless _is_safe($dir,$err_ref);
774 # internal routine to determine whether unlink works on this
775 # platform for files that are currently open.
776 # Returns true if we can, false otherwise.
778 # Currently WinNT, OS/2 and VMS can not unlink an opened file
779 # On VMS this is because the O_EXCL flag is used to open the
780 # temporary file. Currently I do not know enough about the issues
781 # on VMS to decide whether O_EXCL is a requirement.
783 sub _can_unlink_opened_file {
785 if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
793 # internal routine to decide which security levels are allowed
794 # see safe_level() for more information on this
796 # Controls whether the supplied security level is allowed
798 # $cando = _can_do_level( $level )
805 # Always have to be able to do STANDARD
806 return 1 if $level == STANDARD;
808 # Currently, the systems that can do HIGH or MEDIUM are identical
809 if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
817 # This routine sets up a deferred unlinking of a specified
818 # filename and filehandle. It is used in the following cases:
819 # - Called by unlink0 if an opened file can not be unlinked
820 # - Called by tempfile() if files are to be removed on shutdown
821 # - Called by tempdir() if directories are to be removed on shutdown
824 # _deferred_unlink( $fh, $fname, $isdir );
826 # - filehandle (so that it can be expclicitly closed if open
827 # - filename (the thing we want to remove)
828 # - isdir (flag to indicate that we are being given a directory)
829 # [and hence no filehandle]
831 # Status is not referred to since all the magic is done with an END block
834 # Will set up two lexical variables to contain all the files to be
835 # removed. One array for files, another for directories
836 # They will only exist in this block
837 # This means we only have to set up a single END block to remove all files
838 # @files_to_unlink contains an array ref with the filehandle and filename
839 my (@files_to_unlink, @dirs_to_unlink);
841 # Set up an end block to use these arrays
844 foreach my $file (@files_to_unlink) {
845 # close the filehandle without checking its state
846 # in order to make real sure that this is closed
847 # if its already closed then I dont care about the answer
848 # probably a better way to do this
849 close($file->[0]); # file handle is [0]
851 if (-f $file->[1]) { # file name is [1]
852 unlink $file->[1] or warn "Error removing ".$file->[1];
856 foreach my $dir (@dirs_to_unlink) {
858 rmtree($dir, $DEBUG, 0);
864 # This is the sub called to register a file for deferred unlinking
865 # This could simply store the input parameters and defer everything
866 # until the END block. For now we do a bit of checking at this
867 # point in order to make sure that (1) we have a file/dir to delete
868 # and (2) we have been called with the correct arguments.
869 sub _deferred_unlink {
871 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
872 unless scalar(@_) == 3;
874 my ($fh, $fname, $isdir) = @_;
876 warn "Setting up deferred removal of $fname\n"
879 # If we have a directory, check that it is a directory
884 # Directory exists so store it
885 # first on VMS turn []foo into [.foo] for rmtree
886 $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
887 push (@dirs_to_unlink, $fname);
890 carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
897 # file exists so store handle and name for later removal
898 push(@files_to_unlink, [$fh, $fname]);
901 carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
913 This is the primary interface for interacting with
914 C<File::Temp>. Using the OO interface a temporary file can be created
915 when the object is constructed and the file can be removed when the
916 object is no longer required.
918 Note that there is no method to obtain the filehandle from the
919 C<File::Temp> object. The object itself acts as a filehandle. Also,
920 the object is configured such that it stringifies to the name of the
927 Create a temporary file object.
929 my $tmp = new File::Temp();
931 by default the object is constructed as if C<tempfile>
932 was called without options, but with the additional behaviour
933 that the temporary file is removed by the object destructor
934 if UNLINK is set to true (the default).
936 Supported arguments are the same as for C<tempfile>: UNLINK
937 (defaulting to true), DIR and SUFFIX. Additionally, the filename
938 template is specified using the TEMPLATE option. The OPEN option
939 is not supported (the file is always opened).
941 $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
945 Arguments are case insensitive.
951 my $class = ref($proto) || $proto;
953 # read arguments and convert keys to upper case
955 %args = map { uc($_), $args{$_} } keys %args;
957 # see if they are unlinking (defaulting to yes)
958 my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
959 delete $args{UNLINK};
961 # template (store it in an error so that it will
962 # disappear from the arg list of tempfile
963 my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
964 delete $args{TEMPLATE};
969 # Open the file and retain file handle and file name
970 my ($fh, $path) = tempfile( @template, %args );
972 print "Tmp: $fh - $path\n" if $DEBUG;
974 # Store the filename in the scalar slot
977 # Store unlink information in hash slot (plus other constructor info)
979 ${*$fh}{UNLINK} = $unlink;
988 Return the name of the temporary file associated with this object.
990 $filename = $tmp->filename;
992 This method is called automatically when the object is used as
1004 return $self->filename;
1009 When the object goes out of scope, the destructor is called. This
1010 destructor will attempt to unlink the file (using C<unlink1>)
1011 if the constructor was called with UNLINK set to 1 (the default state
1012 if UNLINK is not specified).
1014 No error is given if the unlink fails.
1020 if (${*$self}{UNLINK}) {
1021 print "# ---------> Unlinking $self\n" if $DEBUG;
1023 # The unlink1 may fail if the file has been closed
1024 # by the caller. This leaves us with the decision
1025 # of whether to refuse to remove the file or simply
1026 # do an unlink without test. Seems to be silly
1027 # to do this when we are trying to be careful
1029 unlink1( $self, $self->filename )
1030 or unlink($self->filename);
1038 This section describes the recommended interface for generating
1039 temporary files and directories.
1045 This is the basic function to generate temporary files.
1046 The behaviour of the file can be changed using various options:
1048 ($fh, $filename) = tempfile();
1050 Create a temporary file in the directory specified for temporary
1051 files, as specified by the tmpdir() function in L<File::Spec>.
1053 ($fh, $filename) = tempfile($template);
1055 Create a temporary file in the current directory using the supplied
1056 template. Trailing `X' characters are replaced with random letters to
1057 generate the filename. At least four `X' characters must be present
1058 at the end of the template.
1060 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1062 Same as previously, except that a suffix is added to the template
1063 after the `X' translation. Useful for ensuring that a temporary
1064 filename has a particular extension when needed by other applications.
1065 But see the WARNING at the end.
1067 ($fh, $filename) = tempfile($template, DIR => $dir);
1069 Translates the template as before except that a directory name
1072 ($fh, $filename) = tempfile($template, UNLINK => 1);
1074 Return the filename and filehandle as before except that the file is
1075 automatically removed when the program exits. Default is for the file
1076 to be removed if a file handle is requested and to be kept if the
1077 filename is requested. In a scalar context (where no filename is
1078 returned) the file is always deleted either on exit or when it is closed.
1080 If the template is not specified, a template is always
1081 automatically generated. This temporary file is placed in tmpdir()
1082 (L<File::Spec>) unless a directory is specified explicitly with the
1085 $fh = tempfile( $template, DIR => $dir );
1087 If called in scalar context, only the filehandle is returned
1088 and the file will automatically be deleted when closed (see
1089 the description of tmpfile() elsewhere in this document).
1090 This is the preferred mode of operation, as if you only
1091 have a filehandle, you can never create a race condition
1092 by fumbling with the filename. On systems that can not unlink
1093 an open file or can not mark a file as temporary when it is opened
1094 (for example, Windows NT uses the C<O_TEMPORARY> flag)
1095 the file is marked for deletion when the program ends (equivalent
1096 to setting UNLINK to 1). The C<UNLINK> flag is ignored if present.
1098 (undef, $filename) = tempfile($template, OPEN => 0);
1100 This will return the filename based on the template but
1101 will not open this file. Cannot be used in conjunction with
1102 UNLINK set to true. Default is to always open the file
1103 to protect from possible race conditions. A warning is issued
1104 if warnings are turned on. Consider using the tmpnam()
1105 and mktemp() functions described elsewhere in this document
1106 if opening the file is not required.
1108 Options can be combined as required.
1114 # Can not check for argument count since we can have any
1119 "DIR" => undef, # Directory prefix
1120 "SUFFIX" => '', # Template suffix
1121 "UNLINK" => 0, # Do not unlink file on exit
1122 "OPEN" => 1, # Open file
1125 # Check to see whether we have an odd or even number of arguments
1126 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
1128 # Read the options and merge with defaults
1129 %options = (%options, @_) if @_;
1131 # First decision is whether or not to open the file
1132 if (! $options{"OPEN"}) {
1134 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1139 if ($options{"DIR"} and $^O eq 'VMS') {
1141 # on VMS turn []foo into [.foo] for concatenation
1142 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1145 # Construct the template
1147 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1148 # functions or simply constructing a template and using _gettemp()
1149 # explicitly. Go for the latter
1151 # First generate a template if not defined and prefix the directory
1152 # If no template must prefix the temp directory
1153 if (defined $template) {
1154 if ($options{"DIR"}) {
1156 $template = File::Spec->catfile($options{"DIR"}, $template);
1162 if ($options{"DIR"}) {
1164 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1168 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
1175 $template .= $options{"SUFFIX"};
1177 # Determine whether we should tell _gettemp to unlink the file
1178 # On unix this is irrelevant and can be worked out after the file is
1179 # opened (simply by unlinking the open filehandle). On Windows or VMS
1180 # we have to indicate temporary-ness when we open the file. In general
1181 # we only want a true temporary file if we are returning just the
1182 # filehandle - if the user wants the filename they probably do not
1183 # want the file to disappear as soon as they close it.
1184 # For this reason, tie unlink_on_close to the return context regardless
1186 my $unlink_on_close = ( wantarray ? 0 : 1);
1189 my ($fh, $path, $errstr);
1190 croak "Error in tempfile() using $template: $errstr"
1191 unless (($fh, $path) = _gettemp($template,
1192 "open" => $options{'OPEN'},
1194 "unlink_on_close" => $unlink_on_close,
1195 "suffixlen" => length($options{'SUFFIX'}),
1196 "ErrStr" => \$errstr,
1199 # Set up an exit handler that can do whatever is right for the
1200 # system. This removes files at exit when requested explicitly or when
1201 # system is asked to unlink_on_close but is unable to do so because
1202 # of OS limitations.
1203 # The latter should be achieved by using a tied filehandle.
1204 # Do not check return status since this is all done with END blocks.
1205 _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1210 if ($options{'OPEN'}) {
1211 return ($fh, $path);
1213 return (undef, $path);
1218 # Unlink the file. It is up to unlink0 to decide what to do with
1219 # this (whether to unlink now or to defer until later)
1220 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1222 # Return just the filehandle.
1231 This is the recommended interface for creation of temporary directories.
1232 The behaviour of the function depends on the arguments:
1234 $tempdir = tempdir();
1236 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1238 $tempdir = tempdir( $template );
1240 Create a directory from the supplied template. This template is
1241 similar to that described for tempfile(). `X' characters at the end
1242 of the template are replaced with random letters to construct the
1243 directory name. At least four `X' characters must be in the template.
1245 $tempdir = tempdir ( DIR => $dir );
1247 Specifies the directory to use for the temporary directory.
1248 The temporary directory name is derived from an internal template.
1250 $tempdir = tempdir ( $template, DIR => $dir );
1252 Prepend the supplied directory name to the template. The template
1253 should not include parent directory specifications itself. Any parent
1254 directory specifications are removed from the template before
1255 prepending the supplied directory.
1257 $tempdir = tempdir ( $template, TMPDIR => 1 );
1259 Using the supplied template, create the temporary directory in
1260 a standard location for temporary files. Equivalent to doing
1262 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1264 but shorter. Parent directory specifications are stripped from the
1265 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1266 explicitly. Additionally, C<TMPDIR> is implied if neither a template
1267 nor a directory are supplied.
1269 $tempdir = tempdir( $template, CLEANUP => 1);
1271 Create a temporary directory using the supplied template, but
1272 attempt to remove it (and all files inside it) when the program
1273 exits. Note that an attempt will be made to remove all files from
1274 the directory even if they were not created by this module (otherwise
1275 why ask to clean it up?). The directory removal is made with
1276 the rmtree() function from the L<File::Path|File::Path> module.
1277 Of course, if the template is not specified, the temporary directory
1278 will be created in tmpdir() and will also be removed at program exit.
1286 # Can not check for argument count since we can have any
1291 "CLEANUP" => 0, # Remove directory on exit
1292 "DIR" => '', # Root directory
1293 "TMPDIR" => 0, # Use tempdir with template
1296 # Check to see whether we have an odd or even number of arguments
1297 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1299 # Read the options and merge with defaults
1300 %options = (%options, @_) if @_;
1302 # Modify or generate the template
1304 # Deal with the DIR and TMPDIR options
1305 if (defined $template) {
1307 # Need to strip directory path if using DIR or TMPDIR
1308 if ($options{'TMPDIR'} || $options{'DIR'}) {
1310 # Strip parent directory from the filename
1312 # There is no filename at the end
1313 $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1314 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1316 # Last directory is then our template
1317 $template = (File::Spec->splitdir($directories))[-1];
1319 # Prepend the supplied directory or temp dir
1320 if ($options{"DIR"}) {
1322 $template = File::Spec->catdir($options{"DIR"}, $template);
1324 } elsif ($options{TMPDIR}) {
1327 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1335 if ($options{"DIR"}) {
1337 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1341 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1347 # Create the directory
1350 if ($^O eq 'VMS') { # dir names can end in delimiters
1351 $template =~ m/([\.\]:>]+)$/;
1352 $suffixlen = length($1);
1354 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1355 # dir name has a trailing ':'
1360 croak "Error in tempdir() using $template: $errstr"
1361 unless ((undef, $tempdir) = _gettemp($template,
1364 "suffixlen" => $suffixlen,
1365 "ErrStr" => \$errstr,
1368 # Install exit handler; must be dynamic to get lexical
1369 if ( $options{'CLEANUP'} && -d $tempdir) {
1370 _deferred_unlink(undef, $tempdir, 1);
1373 # Return the dir name
1380 =head1 MKTEMP FUNCTIONS
1382 The following functions are Perl implementations of the
1383 mktemp() family of temp file generation system calls.
1389 Given a template, returns a filehandle to the temporary file and the name
1392 ($fh, $name) = mkstemp( $template );
1394 In scalar context, just the filehandle is returned.
1396 The template may be any filename with some number of X's appended
1397 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1398 with unique alphanumeric combinations.
1406 croak "Usage: mkstemp(template)"
1409 my $template = shift;
1411 my ($fh, $path, $errstr);
1412 croak "Error in mkstemp using $template: $errstr"
1413 unless (($fh, $path) = _gettemp($template,
1417 "ErrStr" => \$errstr,
1421 return ($fh, $path);
1431 Similar to mkstemp(), except that an extra argument can be supplied
1432 with a suffix to be appended to the template.
1434 ($fh, $name) = mkstemps( $template, $suffix );
1436 For example a template of C<testXXXXXX> and suffix of C<.dat>
1437 would generate a file similar to F<testhGji_w.dat>.
1439 Returns just the filehandle alone when called in scalar context.
1445 croak "Usage: mkstemps(template, suffix)"
1449 my $template = shift;
1452 $template .= $suffix;
1454 my ($fh, $path, $errstr);
1455 croak "Error in mkstemps using $template: $errstr"
1456 unless (($fh, $path) = _gettemp($template,
1459 "suffixlen" => length($suffix),
1460 "ErrStr" => \$errstr,
1464 return ($fh, $path);
1473 Create a directory from a template. The template must end in
1474 X's that are replaced by the routine.
1476 $tmpdir_name = mkdtemp($template);
1478 Returns the name of the temporary directory created.
1479 Returns undef on failure.
1481 Directory must be removed by the caller.
1489 croak "Usage: mkdtemp(template)"
1492 my $template = shift;
1494 if ($^O eq 'VMS') { # dir names can end in delimiters
1495 $template =~ m/([\.\]:>]+)$/;
1496 $suffixlen = length($1);
1498 if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1499 # dir name has a trailing ':'
1502 my ($junk, $tmpdir, $errstr);
1503 croak "Error creating temp directory from template $template\: $errstr"
1504 unless (($junk, $tmpdir) = _gettemp($template,
1507 "suffixlen" => $suffixlen,
1508 "ErrStr" => \$errstr,
1517 Returns a valid temporary filename but does not guarantee
1518 that the file will not be opened by someone else.
1520 $unopened_file = mktemp($template);
1522 Template is the same as that required by mkstemp().
1528 croak "Usage: mktemp(template)"
1531 my $template = shift;
1533 my ($tmpname, $junk, $errstr);
1534 croak "Error getting name to temp file from template $template: $errstr"
1535 unless (($junk, $tmpname) = _gettemp($template,
1539 "ErrStr" => \$errstr,
1547 =head1 POSIX FUNCTIONS
1549 This section describes the re-implementation of the tmpnam()
1550 and tmpfile() functions described in L<POSIX>
1551 using the mkstemp() from this module.
1553 Unlike the L<POSIX|POSIX> implementations, the directory used
1554 for the temporary file is not specified in a system include
1555 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1556 returned by L<File::Spec|File::Spec>. On some implementations this
1557 location can be set using the C<TMPDIR> environment variable, which
1559 If this is a problem, simply use mkstemp() and specify a template.
1565 When called in scalar context, returns the full name (including path)
1566 of a temporary file (uses mktemp()). The only check is that the file does
1567 not already exist, but there is no guarantee that that condition will
1572 When called in list context, a filehandle to the open file and
1573 a filename are returned. This is achieved by calling mkstemp()
1574 after constructing a suitable template.
1576 ($fh, $file) = tmpnam();
1578 If possible, this form should be used to prevent possible
1581 See L<File::Spec/tmpdir> for information on the choice of temporary
1582 directory for a particular operating system.
1588 # Retrieve the temporary directory name
1589 my $tmpdir = File::Spec->tmpdir;
1591 croak "Error temporary directory is not writable"
1594 # Use a ten character template and append to tmpdir
1595 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1598 return mkstemp($template);
1600 return mktemp($template);
1607 Returns the filehandle of a temporary file.
1611 The file is removed when the filehandle is closed or when the program
1612 exits. No access to the filename is provided.
1614 If the temporary file can not be created undef is returned.
1615 Currently this command will probably not work when the temporary
1616 directory is on an NFS file system.
1622 # Simply call tmpnam() in a list context
1623 my ($fh, $file) = tmpnam();
1625 # Make sure file is removed when filehandle is closed
1626 # This will fail on NFS
1636 =head1 ADDITIONAL FUNCTIONS
1638 These functions are provided for backwards compatibility
1639 with common tempfile generation C library functions.
1641 They are not exported and must be addressed using the full package
1648 Return the name of a temporary file in the specified directory
1649 using a prefix. The file is guaranteed not to exist at the time
1650 the function was called, but such guarantees are good for one
1651 clock tick only. Always use the proper form of C<sysopen>
1652 with C<O_CREAT | O_EXCL> if you must open such a filename.
1654 $filename = File::Temp::tempnam( $dir, $prefix );
1656 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1657 (using unix file convention as an example)
1659 Because this function uses mktemp(), it can suffer from race conditions.
1665 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1667 my ($dir, $prefix) = @_;
1669 # Add a string to the prefix
1670 $prefix .= 'XXXXXXXX';
1672 # Concatenate the directory to the file
1673 my $template = File::Spec->catfile($dir, $prefix);
1675 return mktemp($template);
1681 =head1 UTILITY FUNCTIONS
1683 Useful functions for dealing with the filehandle and filename.
1689 Given an open filehandle and the associated filename, make a safe
1690 unlink. This is achieved by first checking that the filename and
1691 filehandle initially point to the same file and that the number of
1692 links to the file is 1 (all fields returned by stat() are compared).
1693 Then the filename is unlinked and the filehandle checked once again to
1694 verify that the number of links on that file is now 0. This is the
1695 closest you can come to making sure that the filename unlinked was the
1696 same as the file whose descriptor you hold.
1698 unlink0($fh, $path) or die "Error unlinking file $path safely";
1700 Returns false on error. The filehandle is not closed since on some
1701 occasions this is not required.
1703 On some platforms, for example Windows NT, it is not possible to
1704 unlink an open file (the file must be closed first). On those
1705 platforms, the actual unlinking is deferred until the program ends and
1706 good status is returned. A check is still performed to make sure that
1707 the filehandle and filename are pointing to the same thing (but not at
1708 the time the end block is executed since the deferred removal may not
1709 have access to the filehandle).
1711 Additionally, on Windows NT not all the fields returned by stat() can
1712 be compared. For example, the C<dev> and C<rdev> fields seem to be
1713 different. Also, it seems that the size of the file returned by stat()
1714 does not always agree, with C<stat(FH)> being more accurate than
1715 C<stat(filename)>, presumably because of caching issues even when
1716 using autoflush (this is usually overcome by waiting a while after
1717 writing to the tempfile before attempting to C<unlink0> it).
1719 Finally, on NFS file systems the link count of the file handle does
1720 not always go to zero immediately after unlinking. Currently, this
1721 command is expected to fail on NFS disks.
1727 croak 'Usage: unlink0(filehandle, filename)'
1728 unless scalar(@_) == 2;
1731 my ($fh, $path) = @_;
1733 cmpstat($fh, $path) or return 0;
1735 # attempt remove the file (does not work on some platforms)
1736 if (_can_unlink_opened_file()) {
1737 # XXX: do *not* call this on a directory; possible race
1738 # resulting in recursive removal
1739 croak "unlink0: $path has become a directory!" if -d $path;
1740 unlink($path) or return 0;
1742 # Stat the filehandle
1745 print "Link count = $fh[3] \n" if $DEBUG;
1747 # Make sure that the link count is zero
1748 # - Cygwin provides deferred unlinking, however,
1749 # on Win9x the link count remains 1
1750 # On NFS the link count may still be 1 but we cant know that
1752 return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
1755 _deferred_unlink($fh, $path, 0);
1763 Compare C<stat> of filehandle with C<stat> of provided filename. This
1764 can be used to check that the filename and filehandle initially point
1765 to the same file and that the number of links to the file is 1 (all
1766 fields returned by stat() are compared).
1768 cmpstat($fh, $path) or die "Error comparing handle with file";
1770 Returns false if the stat information differs or if the link count is
1773 On certain platofms, eg Windows, not all the fields returned by stat()
1774 can be compared. For example, the C<dev> and C<rdev> fields seem to be
1775 different in Windows. Also, it seems that the size of the file
1776 returned by stat() does not always agree, with C<stat(FH)> being more
1777 accurate than C<stat(filename)>, presumably because of caching issues
1778 even when using autoflush (this is usually overcome by waiting a while
1779 after writing to the tempfile before attempting to C<unlink0> it).
1781 Not exported by default.
1787 croak 'Usage: cmpstat(filehandle, filename)'
1788 unless scalar(@_) == 2;
1791 my ($fh, $path) = @_;
1793 warn "Comparing stat\n"
1796 # Stat the filehandle - which may be closed if someone has manually
1797 # closed the file. Can not turn off warnings without using $^W
1798 # unless we upgrade to 5.006 minimum requirement
1806 if ($fh[3] > 1 && $^W) {
1807 carp "unlink0: fstat found too many links; SB=@fh" if $^W;
1811 my @path = stat $path;
1814 carp "unlink0: $path is gone already" if $^W;
1818 # this is no longer a file, but may be a directory, or worse
1820 confess "panic: $path is no longer a file: SB=@fh";
1823 # Do comparison of each member of the array
1824 # On WinNT dev and rdev seem to be different
1825 # depending on whether it is a file or a handle.
1826 # Cannot simply compare all members of the stat return
1827 # Select the ones we can use
1828 my @okstat = (0..$#fh); # Use all by default
1829 if ($^O eq 'MSWin32') {
1830 @okstat = (1,2,3,4,5,7,8,9,10);
1831 } elsif ($^O eq 'os2') {
1832 @okstat = (0, 2..$#fh);
1833 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
1835 } elsif ($^O eq 'dos') {
1836 @okstat = (0,2..7,11..$#fh);
1837 } elsif ($^O eq 'mpeix') {
1838 @okstat = (0..4,8..10);
1841 # Now compare each entry explicitly by number
1843 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1844 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
1845 # and 12) will be '' on platforms that do not support them. This
1846 # is fine since we are only comparing integers.
1847 unless ($fh[$_] eq $path[$_]) {
1848 warn "Did not match $_ element of stat\n" if $DEBUG;
1858 Similar to C<unlink0> except after file comparison using cmpstat, the
1859 filehandle is closed prior to attempting to unlink the file. This
1860 allows the file to be removed without using an END block, but does
1861 mean that the post-unlink comparison of the filehandle state provided
1862 by C<unlink0> is not available.
1864 unlink1($fh, $path) or die "Error closing and unlinking file";
1866 Usually called from the object destructor when using the OO interface.
1868 Not exported by default.
1873 croak 'Usage: unlink1(filehandle, filename)'
1874 unless scalar(@_) == 2;
1877 my ($fh, $path) = @_;
1879 cmpstat($fh, $path) or return 0;
1882 close( $fh ) or return 0;
1885 return unlink($path);
1890 =head1 PACKAGE VARIABLES
1892 These functions control the global state of the package.
1898 Controls the lengths to which the module will go to check the safety of the
1899 temporary file or directory before proceeding.
1906 Do the basic security measures to ensure the directory exists and
1907 is writable, that the umask() is fixed before opening of the file,
1908 that temporary files are opened only if they do not already exist, and
1909 that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
1910 function is used to remove files safely.
1914 In addition to the STANDARD security, the output directory is checked
1915 to make sure that it is owned either by root or the user running the
1916 program. If the directory is writable by group or by other, it is then
1917 checked to make sure that the sticky bit is set.
1919 Will not work on platforms that do not support the C<-k> test
1924 In addition to the MEDIUM security checks, also check for the
1925 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
1926 sysconf() function. If this is a possibility, each directory in the
1927 path is checked in turn for safeness, recursively walking back to the
1930 For platforms that do not support the L<POSIX|POSIX>
1931 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
1932 assumed that ``chown() giveaway'' is possible and the recursive test
1937 The level can be changed as follows:
1939 File::Temp->safe_level( File::Temp::HIGH );
1941 The level constants are not exported by the module.
1943 Currently, you must be running at least perl v5.6.0 in order to
1944 run with MEDIUM or HIGH security. This is simply because the
1945 safety tests use functions from L<Fcntl|Fcntl> that are not
1946 available in older versions of perl. The problem is that the version
1947 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
1948 they are different versions.
1950 On systems that do not support the HIGH or MEDIUM safety levels
1951 (for example Win NT or OS/2) any attempt to change the level will
1952 be ignored. The decision to ignore rather than raise an exception
1953 allows portable programs to be written with high security in mind
1954 for the systems that can support this without those programs failing
1955 on systems where the extra tests are irrelevant.
1957 If you really need to see whether the change has been accepted
1958 simply examine the return value of C<safe_level>.
1960 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
1961 die "Could not change to high security"
1962 if $newlevel != File::Temp::HIGH;
1967 # protect from using the variable itself
1968 my $LEVEL = STANDARD;
1973 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
1974 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
1976 # Dont allow this on perl 5.005 or earlier
1977 if ($] < 5.006 && $level != STANDARD) {
1978 # Cant do MEDIUM or HIGH checks
1979 croak "Currently requires perl 5.006 or newer to do the safe checks";
1981 # Check that we are allowed to change level
1982 # Silently ignore if we can not.
1983 $LEVEL = $level if _can_do_level($level);
1992 This is the highest UID on the current system that refers to a root
1993 UID. This is used to make sure that the temporary directory is
1994 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
1997 This is required since on many unix systems C</tmp> is not owned
2000 Default is to assume that any UID less than or equal to 10 is a root
2003 File::Temp->top_system_uid(10);
2004 my $topid = File::Temp->top_system_uid;
2006 This value can be adjusted to reduce security checking if required.
2007 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2014 my $TopSystemUID = 10;
2015 sub top_system_uid {
2019 croak "top_system_uid: UIDs should be numeric"
2020 unless $newuid =~ /^\d+$/s;
2021 $TopSystemUID = $newuid;
2023 return $TopSystemUID;
2029 For maximum security, endeavour always to avoid ever looking at,
2030 touching, or even imputing the existence of the filename. You do not
2031 know that that filename is connected to the same file as the handle
2032 you have, and attempts to check this can only trigger more race
2033 conditions. It's far more secure to use the filehandle alone and
2034 dispense with the filename altogether.
2036 If you need to pass the handle to something that expects a filename
2037 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
2038 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
2039 programs. You will have to clear the close-on-exec bit on that file
2040 descriptor before passing it to another process.
2042 use Fcntl qw/F_SETFD F_GETFD/;
2043 fcntl($tmpfh, F_SETFD, 0)
2044 or die "Can't clear close-on-exec flag on temp fh: $!\n";
2046 =head2 Temporary files and NFS
2048 Some problems are associated with using temporary files that reside
2049 on NFS file systems and it is recommended that a local filesystem
2050 is used whenever possible. Some of the security tests will most probably
2051 fail when the temp file is not local. Additionally, be aware that
2052 the performance of I/O operations over NFS will not be as good as for
2057 Originally began life in May 1999 as an XS interface to the system
2058 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2059 translated to Perl for total control of the code's
2060 security checking, to ensure the presence of the function regardless of
2061 operating system and to help with portability.
2065 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2067 See L<IO::File> and L<File::MkTemp> for different implementations of
2068 temporary file handling.
2072 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
2074 Copyright (C) 1999-2003 Tim Jenness and the UK Particle Physics and
2075 Astronomy Research Council. All Rights Reserved. This program is free
2076 software; you can redistribute it and/or modify it under the same
2077 terms as Perl itself.
2079 Original Perl implementation loosely based on the OpenBSD C code for
2080 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
2081 should be written and providing ideas for code improvements and
2082 security enhancements.