5 File::Temp - return name and handle of a temporary file safely
9 use File::Temp qw/ tempfile tempdir /;
11 $dir = tempdir( CLEANUP => 1 );
12 ($fh, $filename) = tempfile( DIR => $dir );
14 ($fh, $filename) = tempfile( $template, DIR => $dir);
15 ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
21 use File::Temp qw/ :mktemp /;
23 ($fh, $file) = mkstemp( "tmpfileXXXXX" );
24 ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
26 $tmpdir = mkdtemp( $template );
28 $unopened_file = mktemp( $template );
32 use File::Temp qw/ :POSIX /;
37 ($fh, $file) = tmpnam();
38 ($fh, $file) = tmpfile();
41 Compatibility functions:
43 $unopened_file = File::Temp::tempnam( $dir, $pfx );
47 Objects (NOT YET IMPLEMENTED):
51 $fh = new File::Temp($template);
52 $fname = $fh->filename;
58 C<File::Temp> can be used to create and open temporary files in a safe way.
59 The tempfile() function can be used to return the name and the open
60 filehandle of a temporary file. The tempdir() function can
61 be used to create a temporary directory.
63 The security aspect of temporary file creation is emphasized such that
64 a filehandle and filename are returned together. This helps guarantee that
65 a race condition can not occur where the temporary file is created by another process
66 between checking for the existence of the file and its
67 opening. Additional security levels are provided to check, for
68 example, that the sticky bit is set on world writable directories.
69 See L<"safe_level"> for more information.
71 For compatibility with popular C library functions, Perl implementations of
72 the mkstemp() family of functions are provided. These are, mkstemp(),
73 mkstemps(), mkdtemp() and mktemp().
75 Additionally, implementations of the standard L<POSIX|POSIX>
76 tmpnam() and tmpfile() functions are provided if required.
78 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
79 but should be used with caution since they return only a filename
80 that was valid when function was called, so cannot guarantee
81 that the file will not exist by the time the caller opens the filename.
85 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
86 # People would like a version on 5.005 so give them what they want :-)
91 use File::Path qw/ rmtree /;
93 use Errno qw( EEXIST ENOENT ENOTDIR EINVAL );
94 require VMS::Stdio if $^O eq 'VMS';
96 # Need the Symbol package if we are running older perl
97 require Symbol if $] < 5.006;
100 # use 'our' on v5.6.0
101 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
105 # We are exporting functions
107 use base qw/Exporter/;
109 # Export list - to allow fine tuning of export table
123 # Groups of functions for export
126 'POSIX' => [qw/ tmpnam tmpfile /],
127 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
130 # add contents of these tags to @EXPORT
131 Exporter::export_tags('POSIX','mktemp');
137 # This is a list of characters that can be used in random filenames
139 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
140 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
141 0 1 2 3 4 5 6 7 8 9 _
144 # Maximum number of tries to make a temp file before failing
146 use constant MAX_TRIES => 10;
148 # Minimum number of X characters that should be in a template
149 use constant MINX => 4;
151 # Default template when no template supplied
153 use constant TEMPXXX => 'X' x 10;
155 # Constants for the security level
157 use constant STANDARD => 0;
158 use constant MEDIUM => 1;
159 use constant HIGH => 2;
161 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
162 # us an optimisation when many temporary files are requested
164 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
166 for my $oflag (qw/ FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
167 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
169 $OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
172 # On some systems the O_TEMPORARY flag can be used to tell the OS
173 # to automatically remove the file when it is closed. This is fine
174 # in most cases but not if tempfile is called with UNLINK=>0 and
175 # the filename is requested -- in the case where the filename is to
176 # be passed to another routine. This happens on windows. We overcome
177 # this by using a second open flags variable
179 my $OPENTEMPFLAGS = $OPENFLAGS;
180 for my $oflag (qw/ TEMPORARY /) {
181 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
183 $OPENTEMPFLAGS |= $bit if eval { $bit = &$func(); 1 };
187 # INTERNAL ROUTINES - not to be used outside of package
189 # Generic routine for getting a temporary filename
190 # modelled on OpenBSD _gettemp() in mktemp.c
192 # The template must contain X's that are to be replaced
193 # with the random values
197 # TEMPLATE - string containing the XXXXX's that is converted
198 # to a random filename and opened if required
200 # Optionally, a hash can also be supplied containing specific options
201 # "open" => if true open the temp file, else just return the name
203 # "mkdir"=> if true, we are creating a temp directory rather than tempfile
205 # "suffixlen" => number of characters at end of PATH to be ignored.
207 # "unlink_on_close" => indicates that, if possible, the OS should remove
208 # the file as soon as it is closed. Usually indicates
209 # use of the O_TEMPORARY flag to sysopen.
210 # Usually irrelevant on unix
212 # "open" and "mkdir" can not both be true
213 # "unlink_on_close" is not used when "mkdir" is true.
215 # The default options are equivalent to mktemp().
218 # filehandle - open file handle (if called with doopen=1, else undef)
219 # temp name - name of the temp file or directory
222 # ($fh, $name) = _gettemp($template, "open" => 1);
224 # for the current version, failures are associated with
225 # a carp to give the reason whilst debugging
229 croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
230 unless scalar(@_) >= 1;
237 "unlink_on_close" => 0,
241 my $template = shift;
242 if (ref($template)) {
243 carp "File::Temp::_gettemp: template must not be a reference";
247 # Check that the number of entries on stack are even
248 if (scalar(@_) % 2 != 0) {
249 carp "File::Temp::_gettemp: Must have even number of options";
253 # Read the options and merge with defaults
254 %options = (%options, @_) if @_;
256 # Can not open the file and make a directory in a single call
257 if ($options{"open"} && $options{"mkdir"}) {
258 carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n";
262 # Find the start of the end of the Xs (position of last X)
263 # Substr starts from 0
264 my $start = length($template) - 1 - $options{"suffixlen"};
266 # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
267 # (taking suffixlen into account). Any fewer is insecure.
269 # Do it using substr - no reason to use a pattern match since
270 # we know where we are looking and what we are looking for
272 if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
273 carp "File::Temp::_gettemp: The template must contain at least ". MINX ." 'X' characters\n";
277 # Replace all the X at the end of the substring with a
278 # random character or just all the XX at the end of a full string.
279 # Do it as an if, since the suffix adjusts which section to replace
280 # and suffixlen=0 returns nothing if used in the substr directly
281 # and generate a full path from the template
283 my $path = _replace_XX($template, $options{"suffixlen"});
286 # Split the path into constituent parts - eventually we need to check
287 # whether the directory exists
288 # We need to know whether we are making a temp directory
291 my ($volume, $directories, $file);
292 my $parent; # parent directory
293 if ($options{"mkdir"}) {
294 # There is no filename at the end
295 ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
297 # The parent is then $directories without the last directory
298 # Split the directory and put it back together again
299 my @dirs = File::Spec->splitdir($directories);
301 # If @dirs only has one entry that means we are in the current
304 $parent = File::Spec->curdir;
307 if ($^O eq 'VMS') { # need volume to avoid relative dir spec
308 $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
311 # Put it back together without the last one
312 $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
314 # ...and attach the volume (no filename)
315 $parent = File::Spec->catpath($volume, $parent, '');
322 # Get rid of the last filename (use File::Basename for this?)
323 ($volume, $directories, $file) = File::Spec->splitpath( $path );
325 # Join up without the file part
326 $parent = File::Spec->catpath($volume,$directories,'');
328 # If $parent is empty replace with curdir
329 $parent = File::Spec->curdir
330 unless $directories ne '';
334 # Check that the parent directories exist
335 # Do this even for the case where we are simply returning a name
336 # not a file -- no point returning a name that includes a directory
337 # that does not exist or is not writable
339 unless (-d $parent && -w _) {
340 carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory"
341 . " or is not writable\n";
345 # Check the stickiness of the directory and chown giveaway if required
346 # If the directory is world writable the sticky bit
349 if (File::Temp->safe_level == MEDIUM) {
350 unless (_is_safe($parent)) {
351 carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
354 } elsif (File::Temp->safe_level == HIGH) {
355 unless (_is_verysafe($parent)) {
356 carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
362 # Now try MAX_TRIES time to open the file
363 for (my $i = 0; $i < MAX_TRIES; $i++) {
365 # Try to open the file if requested
366 if ($options{"open"}) {
369 # If we are running before perl5.6.0 we can not auto-vivify
371 $fh = &Symbol::gensym;
374 # Try to make sure this will be marked close-on-exec
375 # XXX: Win32 doesn't respect this, nor the proper fcntl,
376 # but may have O_NOINHERIT. This may or may not be in Fcntl.
379 # Store callers umask
385 # Attempt to open the file
386 my $open_success = undef;
387 if ( $^O eq 'VMS' and $options{"unlink_on_close"} ) {
388 # make it auto delete on close by setting FAB$V_DLT bit
389 $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
392 my $flags = ( $options{"unlink_on_close"} ?
395 $open_success = sysopen($fh, $path, $flags, 0600);
397 if ( $open_success ) {
402 # Opened successfully - return file handle and name
409 # Error opening file - abort with error
410 # if the reason was anything but EEXIST
411 unless ($! == EEXIST) {
412 carp "File::Temp: Could not create temp file $path: $!";
416 # Loop round for another try
419 } elsif ($options{"mkdir"}) {
421 # Store callers umask
427 # Open the temp directory
428 if (mkdir( $path, 0700)) {
439 # Abort with error if the reason for failure was anything
441 unless ($! == EEXIST) {
442 carp "File::Temp: Could not create directory $path: $!";
446 # Loop round for another try
452 # Return true if the file can not be found
453 # Directory has been checked previously
455 return (undef, $path) unless -e $path;
457 # Try again until MAX_TRIES
461 # Did not successfully open the tempfile/dir
462 # so try again with a different set of random letters
463 # No point in trying to increment unless we have only
464 # 1 X say and the randomness could come up with the same
465 # file MAX_TRIES in a row.
467 # Store current attempt - in principal this implies that the
468 # 3rd time around the open attempt that the first temp file
469 # name could be generated again. Probably should store each
470 # attempt and make sure that none are repeated
472 my $original = $path;
473 my $counter = 0; # Stop infinite loop
478 # Generate new name from original template
479 $path = _replace_XX($template, $options{"suffixlen"});
483 } until ($path ne $original || $counter > $MAX_GUESS);
485 # Check for out of control looping
486 if ($counter > $MAX_GUESS) {
487 carp "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
493 # If we get here, we have run out of tries
494 carp "Have exceeded the maximum number of attempts (".MAX_TRIES .
495 ") to open temp file/dir";
501 # Internal routine to return a random character from the
502 # character list. Does not do an srand() since rand()
503 # will do one automatically
505 # No arguments. Return value is the random character
507 # No longer called since _replace_XX runs a few percent faster if
508 # I inline the code. This is important if we are creating thousands of
513 $CHARS[ int( rand( $#CHARS ) ) ];
517 # Internal routine to replace the XXXX... with random characters
518 # This has to be done by _gettemp() every time it fails to
519 # open a temp file/dir
521 # Arguments: $template (the template with XXX),
522 # $ignore (number of characters at end to ignore)
524 # Returns: modified template
528 croak 'Usage: _replace_XX($template, $ignore)'
529 unless scalar(@_) == 2;
531 my ($path, $ignore) = @_;
533 # Do it as an if, since the suffix adjusts which section to replace
534 # and suffixlen=0 returns nothing if used in the substr directly
535 # Alternatively, could simply set $ignore to length($path)-1
536 # Don't want to always use substr when not required though.
539 substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
541 $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
547 # internal routine to check to see if the directory is safe
548 # First checks to see if the directory is not owned by the
549 # current user or root. Then checks to see if anyone else
550 # can write to the directory and if so, checks to see if
551 # it has the sticky bit set
553 # Will not work on systems that do not support sticky bit
555 #Args: directory path to check
556 # Returns true if the path is safe and false otherwise.
557 # Returns undef if can not even run stat() on the path
559 # This routine based on version written by Tom Christiansen
561 # Presumably, by the time we actually attempt to create the
562 # file or directory in this directory, it may not be safe
563 # anymore... Have to run _is_safe directly after the open.
570 my @info = stat($path);
571 return 0 unless scalar(@info);
572 return 1 if $^O eq 'VMS'; # owner delete control at file level
574 # Check to see whether owner is neither superuser (or a system uid) nor me
575 # Use the real uid from the $< variable
577 if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
578 carp "Directory owned neither by root nor the current user";
582 # check whether group or other can write file
583 # use 066 to detect either reading or writing
584 # use 022 to check writability
585 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
587 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
588 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
589 return 0 unless -d _; # Must be a directory
590 return 0 unless -k _; # Must be sticky
596 # Internal routine to check whether a directory is safe
597 # for temp files. Safer than _is_safe since it checks for
598 # the possibility of chown giveaway and if that is a possibility
599 # checks each directory in the path to see if it is safe (with _is_safe)
601 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
606 # Need POSIX - but only want to bother if really necessary due to overhead
610 return 1 if $^O eq 'VMS'; # owner delete control at file level
612 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
613 # and If it is not there do the extensive test
614 my $chown_restricted;
615 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
616 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
618 # If chown_resticted is set to some value we should test it
619 if (defined $chown_restricted) {
621 # Return if the current directory is safe
622 return _is_safe($path) if POSIX::sysconf( $chown_restricted );
626 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
627 # was not avialable or the symbol was there but chown giveaway
628 # is allowed. Either way, we now have to test the entire tree for
631 # Convert path to an absolute directory if required
632 unless (File::Spec->file_name_is_absolute($path)) {
633 $path = File::Spec->rel2abs($path);
636 # Split directory into components - assume no file
637 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
639 # Slightly less efficient than having a a function in File::Spec
640 # to chop off the end of a directory or even a function that
641 # can handle ../ in a directory tree
642 # Sometimes splitdir() returns a blank at the end
643 # so we will probably check the bottom directory twice in some cases
644 my @dirs = File::Spec->splitdir($directories);
646 # Concatenate one less directory each time around
647 foreach my $pos (0.. $#dirs) {
648 # Get a directory name
649 my $dir = File::Spec->catpath($volume,
650 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
654 print "TESTING DIR $dir\n" if $DEBUG;
656 # Check the directory
657 return 0 unless _is_safe($dir);
666 # internal routine to determine whether unlink works on this
667 # platform for files that are currently open.
668 # Returns true if we can, false otherwise.
670 # Currently WinNT, OS/2 and VMS can not unlink an opened file
671 # On VMS this is because the O_EXCL flag is used to open the
672 # temporary file. Currently I do not know enough about the issues
673 # on VMS to decide whether O_EXCL is a requirement.
675 sub _can_unlink_opened_file {
677 if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS') {
685 # internal routine to decide which security levels are allowed
686 # see safe_level() for more information on this
688 # Controls whether the supplied security level is allowed
690 # $cando = _can_do_level( $level )
697 # Always have to be able to do STANDARD
698 return 1 if $level == STANDARD;
700 # Currently, the systems that can do HIGH or MEDIUM are identical
701 if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin') {
709 # This routine sets up a deferred unlinking of a specified
710 # filename and filehandle. It is used in the following cases:
711 # - Called by unlink0 if an opened file can not be unlinked
712 # - Called by tempfile() if files are to be removed on shutdown
713 # - Called by tempdir() if directories are to be removed on shutdown
716 # _deferred_unlink( $fh, $fname, $isdir );
718 # - filehandle (so that it can be expclicitly closed if open
719 # - filename (the thing we want to remove)
720 # - isdir (flag to indicate that we are being given a directory)
721 # [and hence no filehandle]
723 # Status is not referred to since all the magic is done with an END block
726 # Will set up two lexical variables to contain all the files to be
727 # removed. One array for files, another for directories
728 # They will only exist in this block
729 # This means we only have to set up a single END block to remove all files
730 # @files_to_unlink contains an array ref with the filehandle and filename
731 my (@files_to_unlink, @dirs_to_unlink);
733 # Set up an end block to use these arrays
736 foreach my $file (@files_to_unlink) {
737 # close the filehandle without checking its state
738 # in order to make real sure that this is closed
739 # if its already closed then I dont care about the answer
740 # probably a better way to do this
741 close($file->[0]); # file handle is [0]
743 if (-f $file->[1]) { # file name is [1]
744 unlink $file->[1] or warn "Error removing ".$file->[1];
748 foreach my $dir (@dirs_to_unlink) {
750 rmtree($dir, $DEBUG, 1);
757 # This is the sub called to register a file for deferred unlinking
758 # This could simply store the input parameters and defer everything
759 # until the END block. For now we do a bit of checking at this
760 # point in order to make sure that (1) we have a file/dir to delete
761 # and (2) we have been called with the correct arguments.
762 sub _deferred_unlink {
764 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
765 unless scalar(@_) == 3;
767 my ($fh, $fname, $isdir) = @_;
769 warn "Setting up deferred removal of $fname\n"
772 # If we have a directory, check that it is a directory
777 # Directory exists so store it
778 # first on VMS turn []foo into [.foo] for rmtree
779 $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
780 push (@dirs_to_unlink, $fname);
783 carp "Request to remove directory $fname could not be completed since it does not exist!\n";
790 # file exists so store handle and name for later removal
791 push(@files_to_unlink, [$fh, $fname]);
794 carp "Request to remove file $fname could not be completed since it is not there!\n";
806 This section describes the recommended interface for generating
807 temporary files and directories.
813 This is the basic function to generate temporary files.
814 The behaviour of the file can be changed using various options:
816 ($fh, $filename) = tempfile();
818 Create a temporary file in the directory specified for temporary
819 files, as specified by the tmpdir() function in L<File::Spec>.
821 ($fh, $filename) = tempfile($template);
823 Create a temporary file in the current directory using the supplied
824 template. Trailing `X' characters are replaced with random letters to
825 generate the filename. At least four `X' characters must be present
828 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
830 Same as previously, except that a suffix is added to the template
831 after the `X' translation. Useful for ensuring that a temporary
832 filename has a particular extension when needed by other applications.
833 But see the WARNING at the end.
835 ($fh, $filename) = tempfile($template, DIR => $dir);
837 Translates the template as before except that a directory name
840 ($fh, $filename) = tempfile($template, UNLINK => 1);
842 Return the filename and filehandle as before except that the file is
843 automatically removed when the program exits. Default is for the file
844 to be removed if a file handle is requested and to be kept if the
845 filename is requested.
847 If the template is not specified, a template is always
848 automatically generated. This temporary file is placed in tmpdir()
849 (L<File::Spec>) unless a directory is specified explicitly with the
852 $fh = tempfile( $template, DIR => $dir );
854 If called in scalar context, only the filehandle is returned
855 and the file will automatically be deleted when closed (see
856 the description of tmpfile() elsewhere in this document).
857 This is the preferred mode of operation, as if you only
858 have a filehandle, you can never create a race condition
859 by fumbling with the filename. On systems that can not unlink
860 an open file (for example, Windows NT) the file is marked for
861 deletion when the program ends (equivalent to setting UNLINK to 1).
863 (undef, $filename) = tempfile($template, OPEN => 0);
865 This will return the filename based on the template but
866 will not open this file. Cannot be used in conjunction with
867 UNLINK set to true. Default is to always open the file
868 to protect from possible race conditions. A warning is issued
869 if warnings are turned on. Consider using the tmpnam()
870 and mktemp() functions described elsewhere in this document
871 if opening the file is not required.
873 Options can be combined as required.
879 # Can not check for argument count since we can have any
884 "DIR" => undef, # Directory prefix
885 "SUFFIX" => '', # Template suffix
886 "UNLINK" => 0, # Do not unlink file on exit
887 "OPEN" => 1, # Open file
890 # Check to see whether we have an odd or even number of arguments
891 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
893 # Read the options and merge with defaults
894 %options = (%options, @_) if @_;
896 # First decision is whether or not to open the file
897 if (! $options{"OPEN"}) {
899 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
904 if ($options{"DIR"} and $^O eq 'VMS') {
906 # on VMS turn []foo into [.foo] for concatenation
907 $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
910 # Construct the template
912 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
913 # functions or simply constructing a template and using _gettemp()
914 # explicitly. Go for the latter
916 # First generate a template if not defined and prefix the directory
917 # If no template must prefix the temp directory
918 if (defined $template) {
919 if ($options{"DIR"}) {
921 $template = File::Spec->catfile($options{"DIR"}, $template);
927 if ($options{"DIR"}) {
929 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
933 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
940 $template .= $options{"SUFFIX"};
944 croak "Error in tempfile() using $template"
945 unless (($fh, $path) = _gettemp($template,
946 "open" => $options{'OPEN'},
948 "unlink_on_close" => $options{'UNLINK'},
949 "suffixlen" => length($options{'SUFFIX'}),
952 # Set up an exit handler that can do whatever is right for the
953 # system. Do not check return status since this is all done with
955 _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
960 if ($options{'OPEN'}) {
963 return (undef, $path);
968 # Unlink the file. It is up to unlink0 to decide what to do with
969 # this (whether to unlink now or to defer until later)
970 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
972 # Return just the filehandle.
981 This is the recommended interface for creation of temporary directories.
982 The behaviour of the function depends on the arguments:
984 $tempdir = tempdir();
986 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
988 $tempdir = tempdir( $template );
990 Create a directory from the supplied template. This template is
991 similar to that described for tempfile(). `X' characters at the end
992 of the template are replaced with random letters to construct the
993 directory name. At least four `X' characters must be in the template.
995 $tempdir = tempdir ( DIR => $dir );
997 Specifies the directory to use for the temporary directory.
998 The temporary directory name is derived from an internal template.
1000 $tempdir = tempdir ( $template, DIR => $dir );
1002 Prepend the supplied directory name to the template. The template
1003 should not include parent directory specifications itself. Any parent
1004 directory specifications are removed from the template before
1005 prepending the supplied directory.
1007 $tempdir = tempdir ( $template, TMPDIR => 1 );
1009 Using the supplied template, creat the temporary directory in
1010 a standard location for temporary files. Equivalent to doing
1012 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1014 but shorter. Parent directory specifications are stripped from the
1015 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1016 explicitly. Additionally, C<TMPDIR> is implied if neither a template
1017 nor a directory are supplied.
1019 $tempdir = tempdir( $template, CLEANUP => 1);
1021 Create a temporary directory using the supplied template, but
1022 attempt to remove it (and all files inside it) when the program
1023 exits. Note that an attempt will be made to remove all files from
1024 the directory even if they were not created by this module (otherwise
1025 why ask to clean it up?). The directory removal is made with
1026 the rmtree() function from the L<File::Path|File::Path> module.
1027 Of course, if the template is not specified, the temporary directory
1028 will be created in tmpdir() and will also be removed at program exit.
1036 # Can not check for argument count since we can have any
1041 "CLEANUP" => 0, # Remove directory on exit
1042 "DIR" => '', # Root directory
1043 "TMPDIR" => 0, # Use tempdir with template
1046 # Check to see whether we have an odd or even number of arguments
1047 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1049 # Read the options and merge with defaults
1050 %options = (%options, @_) if @_;
1052 # Modify or generate the template
1054 # Deal with the DIR and TMPDIR options
1055 if (defined $template) {
1057 # Need to strip directory path if using DIR or TMPDIR
1058 if ($options{'TMPDIR'} || $options{'DIR'}) {
1060 # Strip parent directory from the filename
1062 # There is no filename at the end
1063 $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1064 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1066 # Last directory is then our template
1067 $template = (File::Spec->splitdir($directories))[-1];
1069 # Prepend the supplied directory or temp dir
1070 if ($options{"DIR"}) {
1072 $template = File::Spec->catfile($options{"DIR"}, $template);
1074 } elsif ($options{TMPDIR}) {
1077 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1085 if ($options{"DIR"}) {
1087 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1091 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1097 # Create the directory
1100 if ($^O eq 'VMS') { # dir names can end in delimiters
1101 $template =~ m/([\.\]:>]+)$/;
1102 $suffixlen = length($1);
1104 croak "Error in tempdir() using $template"
1105 unless ((undef, $tempdir) = _gettemp($template,
1108 "suffixlen" => $suffixlen,
1111 # Install exit handler; must be dynamic to get lexical
1112 if ( $options{'CLEANUP'} && -d $tempdir) {
1113 _deferred_unlink(undef, $tempdir, 1);
1116 # Return the dir name
1123 =head1 MKTEMP FUNCTIONS
1125 The following functions are Perl implementations of the
1126 mktemp() family of temp file generation system calls.
1132 Given a template, returns a filehandle to the temporary file and the name
1135 ($fh, $name) = mkstemp( $template );
1137 In scalar context, just the filehandle is returned.
1139 The template may be any filename with some number of X's appended
1140 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1141 with unique alphanumeric combinations.
1149 croak "Usage: mkstemp(template)"
1152 my $template = shift;
1155 croak "Error in mkstemp using $template"
1156 unless (($fh, $path) = _gettemp($template,
1163 return ($fh, $path);
1173 Similar to mkstemp(), except that an extra argument can be supplied
1174 with a suffix to be appended to the template.
1176 ($fh, $name) = mkstemps( $template, $suffix );
1178 For example a template of C<testXXXXXX> and suffix of C<.dat>
1179 would generate a file similar to F<testhGji_w.dat>.
1181 Returns just the filehandle alone when called in scalar context.
1187 croak "Usage: mkstemps(template, suffix)"
1191 my $template = shift;
1194 $template .= $suffix;
1197 croak "Error in mkstemps using $template"
1198 unless (($fh, $path) = _gettemp($template,
1201 "suffixlen" => length($suffix),
1205 return ($fh, $path);
1214 Create a directory from a template. The template must end in
1215 X's that are replaced by the routine.
1217 $tmpdir_name = mkdtemp($template);
1219 Returns the name of the temporary directory created.
1220 Returns undef on failure.
1222 Directory must be removed by the caller.
1230 croak "Usage: mkdtemp(template)"
1233 my $template = shift;
1235 if ($^O eq 'VMS') { # dir names can end in delimiters
1236 $template =~ m/([\.\]:>]+)$/;
1237 $suffixlen = length($1);
1239 my ($junk, $tmpdir);
1240 croak "Error creating temp directory from template $template\n"
1241 unless (($junk, $tmpdir) = _gettemp($template,
1244 "suffixlen" => $suffixlen,
1253 Returns a valid temporary filename but does not guarantee
1254 that the file will not be opened by someone else.
1256 $unopened_file = mktemp($template);
1258 Template is the same as that required by mkstemp().
1264 croak "Usage: mktemp(template)"
1267 my $template = shift;
1269 my ($tmpname, $junk);
1270 croak "Error getting name to temp file from template $template\n"
1271 unless (($junk, $tmpname) = _gettemp($template,
1282 =head1 POSIX FUNCTIONS
1284 This section describes the re-implementation of the tmpnam()
1285 and tmpfile() functions described in L<POSIX>
1286 using the mkstemp() from this module.
1288 Unlike the L<POSIX|POSIX> implementations, the directory used
1289 for the temporary file is not specified in a system include
1290 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1291 returned by L<File::Spec|File::Spec>. On some implementations this
1292 location can be set using the C<TMPDIR> environment variable, which
1294 If this is a problem, simply use mkstemp() and specify a template.
1300 When called in scalar context, returns the full name (including path)
1301 of a temporary file (uses mktemp()). The only check is that the file does
1302 not already exist, but there is no guarantee that that condition will
1307 When called in list context, a filehandle to the open file and
1308 a filename are returned. This is achieved by calling mkstemp()
1309 after constructing a suitable template.
1311 ($fh, $file) = tmpnam();
1313 If possible, this form should be used to prevent possible
1316 See L<File::Spec/tmpdir> for information on the choice of temporary
1317 directory for a particular operating system.
1323 # Retrieve the temporary directory name
1324 my $tmpdir = File::Spec->tmpdir;
1326 croak "Error temporary directory is not writable"
1329 # Use a ten character template and append to tmpdir
1330 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1333 return mkstemp($template);
1335 return mktemp($template);
1342 In scalar context, returns the filehandle of a temporary file.
1346 The file is removed when the filehandle is closed or when the program
1347 exits. No access to the filename is provided.
1353 # Simply call tmpnam() in a list context
1354 my ($fh, $file) = tmpnam();
1356 # Make sure file is removed when filehandle is closed
1357 unlink0($fh, $file) or croak "Unable to unlink temporary file: $!";
1365 =head1 ADDITIONAL FUNCTIONS
1367 These functions are provided for backwards compatibility
1368 with common tempfile generation C library functions.
1370 They are not exported and must be addressed using the full package
1377 Return the name of a temporary file in the specified directory
1378 using a prefix. The file is guaranteed not to exist at the time
1379 the function was called, but such guarantees are good for one
1380 clock tick only. Always use the proper form of C<sysopen>
1381 with C<O_CREAT | O_EXCL> if you must open such a filename.
1383 $filename = File::Temp::tempnam( $dir, $prefix );
1385 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1386 (using unix file convention as an example)
1388 Because this function uses mktemp(), it can suffer from race conditions.
1394 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1396 my ($dir, $prefix) = @_;
1398 # Add a string to the prefix
1399 $prefix .= 'XXXXXXXX';
1401 # Concatenate the directory to the file
1402 my $template = File::Spec->catfile($dir, $prefix);
1404 return mktemp($template);
1410 =head1 UTILITY FUNCTIONS
1412 Useful functions for dealing with the filehandle and filename.
1418 Given an open filehandle and the associated filename, make a safe
1419 unlink. This is achieved by first checking that the filename and
1420 filehandle initially point to the same file and that the number of
1421 links to the file is 1 (all fields returned by stat() are compared).
1422 Then the filename is unlinked and the filehandle checked once again to
1423 verify that the number of links on that file is now 0. This is the
1424 closest you can come to making sure that the filename unlinked was the
1425 same as the file whose descriptor you hold.
1427 unlink0($fh, $path) or die "Error unlinking file $path safely";
1429 Returns false on error. The filehandle is not closed since on some
1430 occasions this is not required.
1432 On some platforms, for example Windows NT, it is not possible to
1433 unlink an open file (the file must be closed first). On those
1434 platforms, the actual unlinking is deferred until the program ends and
1435 good status is returned. A check is still performed to make sure that
1436 the filehandle and filename are pointing to the same thing (but not at
1437 the time the end block is executed since the deferred removal may not
1438 have access to the filehandle).
1440 Additionally, on Windows NT not all the fields returned by stat() can
1441 be compared. For example, the C<dev> and C<rdev> fields seem to be
1442 different. Also, it seems that the size of the file returned by stat()
1443 does not always agree, with C<stat(FH)> being more accurate than
1444 C<stat(filename)>, presumably because of caching issues even when
1445 using autoflush (this is usually overcome by waiting a while after
1446 writing to the tempfile before attempting to C<unlink0> it).
1448 Finally, on NFS file systems the link count of the file handle does
1449 not always go to zero immediately after unlinking. Currently, this
1450 command is expected to fail on NFS disks.
1456 croak 'Usage: unlink0(filehandle, filename)'
1457 unless scalar(@_) == 2;
1460 my ($fh, $path) = @_;
1462 warn "Unlinking $path using unlink0\n"
1465 # Stat the filehandle
1468 if ($fh[3] > 1 && $^W) {
1469 carp "unlink0: fstat found too many links; SB=@fh";
1473 my @path = stat $path;
1476 carp "unlink0: $path is gone already" if $^W;
1480 # this is no longer a file, but may be a directory, or worse
1482 confess "panic: $path is no longer a file: SB=@fh";
1485 # Do comparison of each member of the array
1486 # On WinNT dev and rdev seem to be different
1487 # depending on whether it is a file or a handle.
1488 # Cannot simply compare all members of the stat return
1489 # Select the ones we can use
1490 my @okstat = (0..$#fh); # Use all by default
1491 if ($^O eq 'MSWin32') {
1492 @okstat = (1,2,3,4,5,7,8,9,10);
1493 } elsif ($^O eq 'os2') {
1494 @okstat = (0, 2..$#fh);
1495 } elsif ($^O eq 'VMS') { # device and file ID are sufficient
1499 # Now compare each entry explicitly by number
1501 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1502 # Use eq rather than == since rdev, blksize, and blocks (6, 11,
1503 # and 12) will be '' on platforms that do not support them. This
1504 # is fine since we are only comparing integers.
1505 unless ($fh[$_] eq $path[$_]) {
1506 warn "Did not match $_ element of stat\n" if $DEBUG;
1511 # attempt remove the file (does not work on some platforms)
1512 if (_can_unlink_opened_file()) {
1513 # XXX: do *not* call this on a directory; possible race
1514 # resulting in recursive removal
1515 croak "unlink0: $path has become a directory!" if -d $path;
1516 unlink($path) or return 0;
1518 # Stat the filehandle
1521 print "Link count = $fh[3] \n" if $DEBUG;
1523 # Make sure that the link count is zero
1524 # - Cygwin provides deferred unlinking, however,
1525 # on Win9x the link count remains 1
1526 return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
1529 _deferred_unlink($fh, $path, 0);
1537 =head1 PACKAGE VARIABLES
1539 These functions control the global state of the package.
1545 Controls the lengths to which the module will go to check the safety of the
1546 temporary file or directory before proceeding.
1553 Do the basic security measures to ensure the directory exists and
1554 is writable, that the umask() is fixed before opening of the file,
1555 that temporary files are opened only if they do not already exist, and
1556 that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
1557 function is used to remove files safely.
1561 In addition to the STANDARD security, the output directory is checked
1562 to make sure that it is owned either by root or the user running the
1563 program. If the directory is writable by group or by other, it is then
1564 checked to make sure that the sticky bit is set.
1566 Will not work on platforms that do not support the C<-k> test
1571 In addition to the MEDIUM security checks, also check for the
1572 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
1573 sysconf() function. If this is a possibility, each directory in the
1574 path is checked in turn for safeness, recursively walking back to the
1577 For platforms that do not support the L<POSIX|POSIX>
1578 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
1579 assumed that ``chown() giveaway'' is possible and the recursive test
1584 The level can be changed as follows:
1586 File::Temp->safe_level( File::Temp::HIGH );
1588 The level constants are not exported by the module.
1590 Currently, you must be running at least perl v5.6.0 in order to
1591 run with MEDIUM or HIGH security. This is simply because the
1592 safety tests use functions from L<Fcntl|Fcntl> that are not
1593 available in older versions of perl. The problem is that the version
1594 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
1595 they are different versions.
1597 On systems that do not support the HIGH or MEDIUM safety levels
1598 (for example Win NT or OS/2) any attempt to change the level will
1599 be ignored. The decision to ignore rather than raise an exception
1600 allows portable programs to be written with high security in mind
1601 for the systems that can support this without those programs failing
1602 on systems where the extra tests are irrelevant.
1604 If you really need to see whether the change has been accepted
1605 simply examine the return value of C<safe_level>.
1607 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
1608 die "Could not change to high security"
1609 if $newlevel != File::Temp::HIGH;
1614 # protect from using the variable itself
1615 my $LEVEL = STANDARD;
1620 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
1621 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n";
1623 # Dont allow this on perl 5.005 or earlier
1624 if ($] < 5.006 && $level != STANDARD) {
1625 # Cant do MEDIUM or HIGH checks
1626 croak "Currently requires perl 5.006 or newer to do the safe checks";
1628 # Check that we are allowed to change level
1629 # Silently ignore if we can not.
1630 $LEVEL = $level if _can_do_level($level);
1639 This is the highest UID on the current system that refers to a root
1640 UID. This is used to make sure that the temporary directory is
1641 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
1644 This is required since on many unix systems C</tmp> is not owned
1647 Default is to assume that any UID less than or equal to 10 is a root
1650 File::Temp->top_system_uid(10);
1651 my $topid = File::Temp->top_system_uid;
1653 This value can be adjusted to reduce security checking if required.
1654 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
1661 my $TopSystemUID = 10;
1662 sub top_system_uid {
1666 croak "top_system_uid: UIDs should be numeric"
1667 unless $newuid =~ /^\d+$/s;
1668 $TopSystemUID = $newuid;
1670 return $TopSystemUID;
1676 For maximum security, endeavour always to avoid ever looking at,
1677 touching, or even imputing the existence of the filename. You do not
1678 know that that filename is connected to the same file as the handle
1679 you have, and attempts to check this can only trigger more race
1680 conditions. It's far more secure to use the filehandle alone and
1681 dispense with the filename altogether.
1683 If you need to pass the handle to something that expects a filename
1684 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
1685 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
1686 programs. You will have to clear the close-on-exec bit on that file
1687 descriptor before passing it to another process.
1689 use Fcntl qw/F_SETFD F_GETFD/;
1690 fcntl($tmpfh, F_SETFD, 0)
1691 or die "Can't clear close-on-exec flag on temp fh: $!\n";
1695 Originally began life in May 1999 as an XS interface to the system
1696 mkstemp() function. In March 2000, the mkstemp() code was
1697 translated to Perl for total control of the code's
1698 security checking, to ensure the presence of the function regardless of
1699 operating system and to help with portability.
1703 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
1705 See L<File::MkTemp> for a different implementation of temporary
1710 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
1712 Copyright (C) 1999, 2000 Tim Jenness and the UK Particle Physics and
1713 Astronomy Research Council. All Rights Reserved. This program is free
1714 software; you can redistribute it and/or modify it under the same
1715 terms as Perl itself.
1717 Original Perl implementation loosely based on the OpenBSD C code for
1718 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
1719 should be written and providing ideas for code improvements and
1720 security enhancements.