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 );
95 # Need the Symbol package if we are running older perl
96 require Symbol if $] < 5.006;
100 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
104 # We are exporting functions
106 use base qw/Exporter/;
108 # Export list - to allow fine tuning of export table
122 # Groups of functions for export
125 'POSIX' => [qw/ tmpnam tmpfile /],
126 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
129 # add contents of these tags to @EXPORT
130 Exporter::export_tags('POSIX','mktemp');
136 # This is a list of characters that can be used in random filenames
138 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
139 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 0 1 2 3 4 5 6 7 8 9 _
143 # Maximum number of tries to make a temp file before failing
145 use constant MAX_TRIES => 10;
147 # Minimum number of X characters that should be in a template
148 use constant MINX => 4;
150 # Default template when no template supplied
152 use constant TEMPXXX => 'X' x 10;
154 # Constants for the security level
156 use constant STANDARD => 0;
157 use constant MEDIUM => 1;
158 use constant HIGH => 2;
160 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
161 # us an optimisation when many temporary files are requested
163 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
165 for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
166 my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
168 $OPENFLAGS |= $bit if eval { $bit = &$func(); 1 };
173 # INTERNAL ROUTINES - not to be used outside of package
175 # Generic routine for getting a temporary filename
176 # modelled on OpenBSD _gettemp() in mktemp.c
178 # The template must contain X's that are to be replaced
179 # with the random values
183 # TEMPLATE - string containing the XXXXX's that is converted
184 # to a random filename and opened if required
186 # Optionally, a hash can also be supplied containing specific options
187 # "open" => if true open the temp file, else just return the name
189 # "mkdir"=> if true, we are creating a temp directory rather than tempfile
191 # "suffixlen" => number of characters at end of PATH to be ignored.
193 # "open" and "mkdir" can not both be true
195 # The default options are equivalent to mktemp().
198 # filehandle - open file handle (if called with doopen=1, else undef)
199 # temp name - name of the temp file or directory
202 # ($fh, $name) = _gettemp($template, "open" => 1);
204 # for the current version, failures are associated with
205 # a carp to give the reason whilst debugging
209 croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
210 unless scalar(@_) >= 1;
220 my $template = shift;
221 if (ref($template)) {
222 carp "File::Temp::_gettemp: template must not be a reference";
226 # Check that the number of entries on stack are even
227 if (scalar(@_) % 2 != 0) {
228 carp "File::Temp::_gettemp: Must have even number of options";
232 # Read the options and merge with defaults
233 %options = (%options, @_) if @_;
235 # Can not open the file and make a directory in a single call
236 if ($options{"open"} && $options{"mkdir"}) {
237 carp "File::Temp::_gettemp: doopen and domkdir can not both be true\n";
241 # Find the start of the end of the Xs (position of last X)
242 # Substr starts from 0
243 my $start = length($template) - 1 - $options{"suffixlen"};
245 # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
246 # (taking suffixlen into account). Any fewer is insecure.
248 # Do it using substr - no reason to use a pattern match since
249 # we know where we are looking and what we are looking for
251 if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
252 carp "File::Temp::_gettemp: The template must contain at least ". MINX ." 'X' characters\n";
256 # Replace all the X at the end of the substring with a
257 # random character or just all the XX at the end of a full string.
258 # Do it as an if, since the suffix adjusts which section to replace
259 # and suffixlen=0 returns nothing if used in the substr directly
260 # and generate a full path from the template
262 my $path = _replace_XX($template, $options{"suffixlen"});
265 # Split the path into constituent parts - eventually we need to check
266 # whether the directory exists
267 # We need to know whether we are making a temp directory
270 my ($volume, $directories, $file);
271 my $parent; # parent directory
272 if ($options{"mkdir"}) {
273 # There is no filename at the end
274 ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
276 # The parent is then $directories without the last directory
277 # Split the directory and put it back together again
278 my @dirs = File::Spec->splitdir($directories);
280 # If @dirs only has one entry that means we are in the current
283 $parent = File::Spec->curdir;
286 # Put it back together without the last one
287 $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
289 # ...and attach the volume (no filename)
290 $parent = File::Spec->catpath($volume, $parent, '');
296 # Get rid of the last filename (use File::Basename for this?)
297 ($volume, $directories, $file) = File::Spec->splitpath( $path );
299 # Join up without the file part
300 $parent = File::Spec->catpath($volume,$directories,'');
302 # If $parent is empty replace with curdir
303 $parent = File::Spec->curdir
304 unless $directories ne '';
308 # Check that the parent directories exist
309 # Do this even for the case where we are simply returning a name
310 # not a file -- no point returning a name that includes a directory
311 # that does not exist or is not writable
313 unless (-d $parent && -w _) {
314 carp "File::Temp::_gettemp: Parent directory ($parent) is not a directory"
315 . " or is not writable\n";
319 # Check the stickiness of the directory and chown giveaway if required
320 # If the directory is world writable the sticky bit
323 if (File::Temp->safe_level == MEDIUM) {
324 unless (_is_safe($parent)) {
325 carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
328 } elsif (File::Temp->safe_level == HIGH) {
329 unless (_is_verysafe($parent)) {
330 carp "File::Temp::_gettemp: Parent directory ($parent) is not safe (sticky bit not set when world writable?)";
336 # Calculate the flags that we wish to use for the sysopen
337 # Some of these are not always available
339 # if ($options{"open"}) {
341 # $openflags = O_CREAT | O_EXCL | O_RDWR;
343 # for my $oflag (qw/FOLLOW BINARY LARGEFILE EXLOCK NOINHERIT TEMPORARY/) {
344 # my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
346 # $openflags |= $bit if eval { $bit = &$func(); 1 };
352 # Now try MAX_TRIES time to open the file
353 for (my $i = 0; $i < MAX_TRIES; $i++) {
355 # Try to open the file if requested
356 if ($options{"open"}) {
359 # If we are running before perl5.6.0 we can not auto-vivify
361 $fh = &Symbol::gensym;
364 # Try to make sure this will be marked close-on-exec
365 # XXX: Win32 doesn't respect this, nor the proper fcntl,
366 # but may have O_NOINHERIT. This may or may not be in Fcntl.
369 # Store callers umask
375 # Attempt to open the file
376 if ( sysopen($fh, $path, $OPENFLAGS, 0600) ) {
381 # Opened successfully - return file handle and name
388 # Error opening file - abort with error
389 # if the reason was anything but EEXIST
390 unless ($! == EEXIST) {
391 carp "File::Temp: Could not create temp file $path: $!";
395 # Loop round for another try
398 } elsif ($options{"mkdir"}) {
400 # Store callers umask
406 # Open the temp directory
407 if (mkdir( $path, 0700)) {
418 # Abort with error if the reason for failure was anything
420 unless ($! == EEXIST) {
421 carp "File::Temp: Could not create directory $path: $!";
425 # Loop round for another try
431 # Return true if the file can not be found
432 # Directory has been checked previously
434 return (undef, $path) unless -e $path;
436 # Try again until MAX_TRIES
440 # Did not successfully open the tempfile/dir
441 # so try again with a different set of random letters
442 # No point in trying to increment unless we have only
443 # 1 X say and the randomness could come up with the same
444 # file MAX_TRIES in a row.
446 # Store current attempt - in principal this implies that the
447 # 3rd time around the open attempt that the first temp file
448 # name could be generated again. Probably should store each
449 # attempt and make sure that none are repeated
451 my $original = $path;
452 my $counter = 0; # Stop infinite loop
457 # Generate new name from original template
458 $path = _replace_XX($template, $options{"suffixlen"});
462 } until ($path ne $original || $counter > $MAX_GUESS);
464 # Check for out of control looping
465 if ($counter > $MAX_GUESS) {
466 carp "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
472 # If we get here, we have run out of tries
473 carp "Have exceeded the maximum number of attempts (".MAX_TRIES .
474 ") to open temp file/dir";
480 # Internal routine to return a random character from the
481 # character list. Does not do an srand() since rand()
482 # will do one automatically
484 # No arguments. Return value is the random character
486 # No longer called since _replace_XX runs a few percent faster if
487 # I inline the code. This is important if we are creating thousands of
492 $CHARS[ int( rand( $#CHARS ) ) ];
496 # Internal routine to replace the XXXX... with random characters
497 # This has to be done by _gettemp() every time it fails to
498 # open a temp file/dir
500 # Arguments: $template (the template with XXX),
501 # $ignore (number of characters at end to ignore)
503 # Returns: modified template
507 croak 'Usage: _replace_XX($template, $ignore)'
508 unless scalar(@_) == 2;
510 my ($path, $ignore) = @_;
512 # Do it as an if, since the suffix adjusts which section to replace
513 # and suffixlen=0 returns nothing if used in the substr directly
514 # Alternatively, could simply set $ignore to length($path)-1
515 # Don't want to always use substr when not required though.
518 substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
520 $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
526 # internal routine to check to see if the directory is safe
527 # First checks to see if the directory is not owned by the
528 # current user or root. Then checks to see if anyone else
529 # can write to the directory and if so, checks to see if
530 # it has the sticky bit set
532 # Will not work on systems that do not support sticky bit
534 #Args: directory path to check
535 # Returns true if the path is safe and false otherwise.
536 # Returns undef if can not even run stat() on the path
538 # This routine based on version written by Tom Christiansen
540 # Presumably, by the time we actually attempt to create the
541 # file or directory in this directory, it may not be safe
542 # anymore... Have to run _is_safe directly after the open.
549 my @info = stat($path);
550 return 0 unless scalar(@info);
552 # Check to see whether owner is neither superuser (or a system uid) nor me
553 # Use the real uid from the $< variable
555 if ( $info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
556 carp "Directory owned neither by root nor the current user";
560 # check whether group or other can write file
561 # use 066 to detect either reading or writing
562 # use 022 to check writability
563 # Do it with S_IWOTH and S_IWGRP for portability (maybe)
565 if (($info[2] & &Fcntl::S_IWGRP) || # Is group writable?
566 ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
567 return 0 unless -d _; # Must be a directory
568 return 0 unless -k _; # Must be sticky
574 # Internal routine to check whether a directory is safe
575 # for temp files. Safer than _is_safe since it checks for
576 # the possibility of chown giveaway and if that is a possibility
577 # checks each directory in the path to see if it is safe (with _is_safe)
579 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
584 # Need POSIX - but only want to bother if really necessary due to overhead
589 # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
590 # and If it is not there do the extensive test
591 my $chown_restricted;
592 $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
593 if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
595 # If chown_resticted is set to some value we should test it
596 if (defined $chown_restricted) {
598 # Return if the current directory is safe
599 return _is_safe($path) if POSIX::sysconf( $chown_restricted );
603 # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
604 # was not avialable or the symbol was there but chown giveaway
605 # is allowed. Either way, we now have to test the entire tree for
608 # Convert path to an absolute directory if required
609 unless (File::Spec->file_name_is_absolute($path)) {
610 $path = File::Spec->rel2abs($path);
613 # Split directory into components - assume no file
614 my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
616 # Slightly less efficient than having a a function in File::Spec
617 # to chop off the end of a directory or even a function that
618 # can handle ../ in a directory tree
619 # Sometimes splitdir() returns a blank at the end
620 # so we will probably check the bottom directory twice in some cases
621 my @dirs = File::Spec->splitdir($directories);
623 # Concatenate one less directory each time around
624 foreach my $pos (0.. $#dirs) {
625 # Get a directory name
626 my $dir = File::Spec->catpath($volume,
627 File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
631 print "TESTING DIR $dir\n" if $DEBUG;
633 # Check the directory
634 return 0 unless _is_safe($dir);
643 # internal routine to determine whether unlink works on this
644 # platform for files that are currently open.
645 # Returns true if we can, false otherwise.
647 # Currently WinNT and OS/2 can not unlink an opened file
649 sub _can_unlink_opened_file {
651 if ($^O eq 'MSWin32' || $^O eq 'os2') {
659 # internal routine to decide which security levels are allowed
660 # see safe_level() for more information on this
662 # Controls whether the supplied security level is allowed
664 # $cando = _can_do_level( $level )
671 # Always have to be able to do STANDARD
672 return 1 if $level == STANDARD;
674 # Currently, the systems that can do HIGH or MEDIUM are identical
675 if ( $^O eq 'MSWin32' ) {
683 # This routine sets up a deferred unlinking of a specified
684 # filename and filehandle. It is used in the following cases:
685 # - Called by unlink0 if an opend file can not be unlinked
686 # - Called by tempfile() if files are to be removed on shutdown
687 # - Called by tempdir() if directories are to be removed on shutdown
690 # _deferred_unlink( $fh, $fname, $isdir );
692 # - filehandle (so that it can be expclicitly closed if open
693 # - filename (the thing we want to remove)
694 # - isdir (flag to indicate that we are being given a directory)
695 # [and hence no filehandle]
697 # Status is not referred to since all the magic is done with and END block
700 # Will set up two lexical variables to contain all the files to be
701 # removed. One array for files, another for directories
702 # They will only exist in this block
703 # This means we only have to set up a single END block to remove all files
704 # @files_to_unlink contains an array ref with the filehandle and filename
705 my (@files_to_unlink, @dirs_to_unlink);
707 # Set up an end block to use these arrays
710 foreach my $file (@files_to_unlink) {
711 # close the filehandle without checking its state
712 # in order to make real sure that this is closed
713 # if its already closed then I dont care about the answer
714 # probably a better way to do this
715 close($file->[0]); # file handle is [0]
717 if (-f $file->[1]) { # file name is [1]
718 unlink $file->[1] or warn "Error removing ".$file->[1];
722 foreach my $dir (@dirs_to_unlink) {
724 rmtree($dir, $DEBUG, 1);
731 # This is the sub called to register a file for deferred unlinking
732 # This could simply store the input parameters and defer everything
733 # until the END block. For now we do a bit of checking at this
734 # point in order to make sure that (1) we have a file/dir to delete
735 # and (2) we have been called with the correct arguments.
736 sub _deferred_unlink {
738 croak 'Usage: _deferred_unlink($fh, $fname, $isdir)'
739 unless scalar(@_) == 3;
741 my ($fh, $fname, $isdir) = @_;
743 warn "Setting up deferred removal of $fname\n"
746 # If we have a directory, check that it is a directory
751 # Directory exists so store it
752 push (@dirs_to_unlink, $fname);
755 carp "Request to remove directory $fname could not be completed since it does not exists!\n";
763 # file exists so store handle and name for later removal
764 push(@files_to_unlink, [$fh, $fname]);
767 carp "Request to remove file $fname could not be completed since it is not there!\n";
779 This section describes the recommended interface for generating
780 temporary files and directories.
786 This is the basic function to generate temporary files.
787 The behaviour of the file can be changed using various options:
789 ($fh, $filename) = tempfile();
791 Create a temporary file in the directory specified for temporary
792 files, as specified by the tmpdir() function in L<File::Spec>.
794 ($fh, $filename) = tempfile($template);
796 Create a temporary file in the current directory using the supplied
797 template. Trailing `X' characters are replaced with random letters to
798 generate the filename. At least four `X' characters must be present
801 ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
803 Same as previously, except that a suffix is added to the template
804 after the `X' translation. Useful for ensuring that a temporary
805 filename has a particular extension when needed by other applications.
806 But see the WARNING at the end.
808 ($fh, $filename) = tempfile($template, DIR => $dir);
810 Translates the template as before except that a directory name
813 If the template is not specified, a template is always
814 automatically generated. This temporary file is placed in tmpdir()
815 (L<File::Spec>) unless a directory is specified explicitly with the
818 $fh = tempfile( $template, DIR => $dir );
820 If called in scalar context, only the filehandle is returned
821 and the file will automatically be deleted when closed (see
822 the description of tmpfile() elsewhere in this document).
823 This is the preferred mode of operation, as if you only
824 have a filehandle, you can never create a race condition
825 by fumbling with the filename. On systems that can not unlink
826 an open file (for example, Windows NT) the file is marked for
827 deletion when the program ends (equivalent to setting UNLINK to 1).
829 (undef, $filename) = tempfile($template, OPEN => 0);
831 This will return the filename based on the template but
832 will not open this file. Cannot be used in conjunction with
833 UNLINK set to true. Default is to always open the file
834 to protect from possible race conditions. A warning is issued
835 if warnings are turned on. Consider using the tmpnam()
836 and mktemp() functions described elsewhere in this document
837 if opening the file is not required.
843 # Can not check for argument count since we can have any
848 "DIR" => undef, # Directory prefix
849 "SUFFIX" => '', # Template suffix
850 "UNLINK" => 0, # Unlink file on exit
851 "OPEN" => 1, # Do not open file
854 # Check to see whether we have an odd or even number of arguments
855 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
857 # Read the options and merge with defaults
858 %options = (%options, @_) if @_;
860 # First decision is whether or not to open the file
861 if (! $options{"OPEN"}) {
863 warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
868 # Construct the template
870 # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
871 # functions or simply constructing a template and using _gettemp()
872 # explicitly. Go for the latter
874 # First generate a template if not defined and prefix the directory
875 # If no template must prefix the temp directory
876 if (defined $template) {
877 if ($options{"DIR"}) {
879 $template = File::Spec->catfile($options{"DIR"}, $template);
885 if ($options{"DIR"}) {
887 $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
891 $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
898 $template .= $options{"SUFFIX"};
902 croak "Error in tempfile() using $template"
903 unless (($fh, $path) = _gettemp($template,
904 "open" => $options{'OPEN'},
906 "suffixlen" => length($options{'SUFFIX'}),
909 # Set up an exit handler that can do whatever is right for the
910 # system. Do not check return status since this is all done with
912 _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
917 if ($options{'OPEN'}) {
920 return (undef, $path);
925 # Unlink the file. It is up to unlink0 to decide what to do with
926 # this (whether to unlink now or to defer until later)
927 unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
929 # Return just the filehandle.
938 This is the recommended interface for creation of temporary directories.
939 The behaviour of the function depends on the arguments:
941 $tempdir = tempdir();
943 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
945 $tempdir = tempdir( $template );
947 Create a directory from the supplied template. This template is
948 similar to that described for tempfile(). `X' characters at the end
949 of the template are replaced with random letters to construct the
950 directory name. At least four `X' characters must be in the template.
952 $tempdir = tempdir ( DIR => $dir );
954 Specifies the directory to use for the temporary directory.
955 The temporary directory name is derived from an internal template.
957 $tempdir = tempdir ( $template, DIR => $dir );
959 Prepend the supplied directory name to the template. The template
960 should not include parent directory specifications itself. Any parent
961 directory specifications are removed from the template before
962 prepending the supplied directory.
964 $tempdir = tempdir ( $template, TMPDIR => 1 );
966 Using the supplied template, creat the temporary directory in
967 a standard location for temporary files. Equivalent to doing
969 $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
971 but shorter. Parent directory specifications are stripped from the
972 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
973 explicitly. Additionally, C<TMPDIR> is implied if neither a template
974 nor a directory are supplied.
976 $tempdir = tempdir( $template, CLEANUP => 1);
978 Create a temporary directory using the supplied template, but
979 attempt to remove it (and all files inside it) when the program
980 exits. Note that an attempt will be made to remove all files from
981 the directory even if they were not created by this module (otherwise
982 why ask to clean it up?). The directory removal is made with
983 the rmtree() function from the L<File::Path|File::Path> module.
984 Of course, if the template is not specified, the temporary directory
985 will be created in tmpdir() and will also be removed at program exit.
993 # Can not check for argument count since we can have any
998 "CLEANUP" => 0, # Remove directory on exit
999 "DIR" => '', # Root directory
1000 "TMPDIR" => 0, # Use tempdir with template
1003 # Check to see whether we have an odd or even number of arguments
1004 my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1006 # Read the options and merge with defaults
1007 %options = (%options, @_) if @_;
1009 # Modify or generate the template
1011 # Deal with the DIR and TMPDIR options
1012 if (defined $template) {
1014 # Need to strip directory path if using DIR or TMPDIR
1015 if ($options{'TMPDIR'} || $options{'DIR'}) {
1017 # Strip parent directory from the filename
1019 # There is no filename at the end
1020 my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1022 # Last directory is then our template
1023 $template = (File::Spec->splitdir($directories))[-1];
1025 # Prepend the supplied directory or temp dir
1026 if ($options{"DIR"}) {
1028 $template = File::Spec->catfile($options{"DIR"}, $template);
1030 } elsif ($options{TMPDIR}) {
1033 $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1041 if ($options{"DIR"}) {
1043 $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1047 $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1053 # Create the directory
1055 croak "Error in tempdir() using $template"
1056 unless ((undef, $tempdir) = _gettemp($template,
1062 # Install exit handler; must be dynamic to get lexical
1063 if ( $options{'CLEANUP'} && -d $tempdir) {
1064 _deferred_unlink(undef, $tempdir, 1);
1067 # Return the dir name
1074 =head1 MKTEMP FUNCTIONS
1076 The following functions are Perl implementations of the
1077 mktemp() family of temp file generation system calls.
1083 Given a template, returns a filehandle to the temporary file and the name
1086 ($fh, $name) = mkstemp( $template );
1088 In scalar context, just the filehandle is returned.
1090 The template may be any filename with some number of X's appended
1091 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1092 with unique alphanumeric combinations.
1100 croak "Usage: mkstemp(template)"
1103 my $template = shift;
1106 croak "Error in mkstemp using $template"
1107 unless (($fh, $path) = _gettemp($template,
1114 return ($fh, $path);
1124 Similar to mkstemp(), except that an extra argument can be supplied
1125 with a suffix to be appended to the template.
1127 ($fh, $name) = mkstemps( $template, $suffix );
1129 For example a template of C<testXXXXXX> and suffix of C<.dat>
1130 would generate a file similar to F<testhGji_w.dat>.
1132 Returns just the filehandle alone when called in scalar context.
1138 croak "Usage: mkstemps(template, suffix)"
1142 my $template = shift;
1145 $template .= $suffix;
1148 croak "Error in mkstemps using $template"
1149 unless (($fh, $path) = _gettemp($template,
1152 "suffixlen" => length($suffix),
1156 return ($fh, $path);
1165 Create a directory from a template. The template must end in
1166 X's that are replaced by the routine.
1168 $tmpdir_name = mkdtemp($template);
1170 Returns the name of the temporary directory created.
1171 Returns undef on failure.
1173 Directory must be removed by the caller.
1181 croak "Usage: mkdtemp(template)"
1184 my $template = shift;
1186 my ($junk, $tmpdir);
1187 croak "Error creating temp directory from template $template\n"
1188 unless (($junk, $tmpdir) = _gettemp($template,
1200 Returns a valid temporary filename but does not guarantee
1201 that the file will not be opened by someone else.
1203 $unopened_file = mktemp($template);
1205 Template is the same as that required by mkstemp().
1211 croak "Usage: mktemp(template)"
1214 my $template = shift;
1216 my ($tmpname, $junk);
1217 croak "Error getting name to temp file from template $template\n"
1218 unless (($junk, $tmpname) = _gettemp($template,
1229 =head1 POSIX FUNCTIONS
1231 This section describes the re-implementation of the tmpnam()
1232 and tmpfile() functions described in L<POSIX>
1233 using the mkstemp() from this module.
1235 Unlike the L<POSIX|POSIX> implementations, the directory used
1236 for the temporary file is not specified in a system include
1237 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1238 returned by L<File::Spec|File::Spec>. On some implementations this
1239 location can be set using the C<TMPDIR> environment variable, which
1241 If this is a problem, simply use mkstemp() and specify a template.
1247 When called in scalar context, returns the full name (including path)
1248 of a temporary file (uses mktemp()). The only check is that the file does
1249 not already exist, but there is no guarantee that that condition will
1254 When called in list context, a filehandle to the open file and
1255 a filename are returned. This is achieved by calling mkstemp()
1256 after constructing a suitable template.
1258 ($fh, $file) = tmpnam();
1260 If possible, this form should be used to prevent possible
1263 See L<File::Spec/tmpdir> for information on the choice of temporary
1264 directory for a particular operating system.
1270 # Retrieve the temporary directory name
1271 my $tmpdir = File::Spec->tmpdir;
1273 croak "Error temporary directory is not writable"
1276 # Use a ten character template and append to tmpdir
1277 my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1280 return mkstemp($template);
1282 return mktemp($template);
1289 In scalar context, returns the filehandle of a temporary file.
1293 The file is removed when the filehandle is closed or when the program
1294 exits. No access to the filename is provided.
1300 # Simply call tmpnam() in an array context
1301 my ($fh, $file) = tmpnam();
1303 # Make sure file is removed when filehandle is closed
1304 unlink0($fh, $file) or croak "Unable to unlink temporary file: $!";
1312 =head1 ADDITIONAL FUNCTIONS
1314 These functions are provided for backwards compatibility
1315 with common tempfile generation C library functions.
1317 They are not exported and must be addressed using the full package
1324 Return the name of a temporary file in the specified directory
1325 using a prefix. The file is guaranteed not to exist at the time
1326 the function was called, but such guarantees are good for one
1327 clock tick only. Always use the proper form of C<sysopen>
1328 with C<O_CREAT | O_EXCL> if you must open such a filename.
1330 $filename = File::Temp::tempnam( $dir, $prefix );
1332 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1333 (using unix file convention as an example)
1335 Because this function uses mktemp(), it can suffer from race conditions.
1341 croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1343 my ($dir, $prefix) = @_;
1345 # Add a string to the prefix
1346 $prefix .= 'XXXXXXXX';
1348 # Concatenate the directory to the file
1349 my $template = File::Spec->catfile($dir, $prefix);
1351 return mktemp($template);
1357 =head1 UTILITY FUNCTIONS
1359 Useful functions for dealing with the filehandle and filename.
1365 Given an open filehandle and the associated filename, make a safe
1366 unlink. This is achieved by first checking that the filename and
1367 filehandle initially point to the same file and that the number of
1368 links to the file is 1 (all fields returned by stat() are compared).
1369 Then the filename is unlinked and the filehandle checked once again to
1370 verify that the number of links on that file is now 0. This is the
1371 closest you can come to making sure that the filename unlinked was the
1372 same as the file whose descriptor you hold.
1374 unlink0($fh, $path) or die "Error unlinking file $path safely";
1376 Returns false on error. The filehandle is not closed since on some
1377 occasions this is not required.
1379 On some platforms, for example Windows NT, it is not possible to
1380 unlink an open file (the file must be closed first). On those
1381 platforms, the actual unlinking is deferred until the program ends and
1382 good status is returned. A check is still performed to make sure that
1383 the filehandle and filename are pointing to the same thing (but not at
1384 the time the end block is executed since the deferred removal may not
1385 have access to the filehandle).
1387 Additionally, on Windows NT not all the fields returned by stat() can
1388 be compared. For example, the C<dev> and C<rdev> fields seem to be different
1389 and also. Also, it seems that the size of the file returned by stat()
1390 does not always agree, with C<stat(FH)> being more accurate than
1391 C<stat(filename)>, presumably because of caching issues even when
1392 using autoflush (this is usually overcome by waiting a while after
1393 writing to the tempfile before attempting to C<unlink0> it).
1395 Finally, on NFS file systems the link count of the file handle does
1396 not always go to zero immediately after unlinking. Currently, this
1397 command is expected to fail on NFS disks.
1403 croak 'Usage: unlink0(filehandle, filename)'
1404 unless scalar(@_) == 2;
1407 my ($fh, $path) = @_;
1409 warn "Unlinking $path using unlink0\n"
1412 # Stat the filehandle
1415 if ($fh[3] > 1 && $^W) {
1416 carp "unlink0: fstat found too many links; SB=@fh";
1420 my @path = stat $path;
1423 carp "unlink0: $path is gone already" if $^W;
1427 # this is no longer a file, but may be a directory, or worse
1429 confess "panic: $path is no longer a file: SB=@fh";
1432 # Do comparison of each member of the array
1433 # On WinNT dev and rdev seem to be different
1434 # depending on whether it is a file or a handle.
1435 # Cannot simply compare all members of the stat return
1436 # Select the ones we can use
1437 my @okstat = (0..$#fh); # Use all by default
1438 if ($^O eq 'MSWin32') {
1439 @okstat = (1,2,3,4,5,7,8,9,10);
1442 # Now compare each entry explicitly by number
1444 print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1445 unless ($fh[$_] == $path[$_]) {
1446 warn "Did not match $_ element of stat\n" if $DEBUG;
1451 # attempt remove the file (does not work on some platforms)
1452 if (_can_unlink_opened_file()) {
1453 # XXX: do *not* call this on a directory; possible race
1454 # resulting in recursive removal
1455 croak "unlink0: $path has become a directory!" if -d $path;
1456 unlink($path) or return 0;
1458 # Stat the filehandle
1461 print "Link count = $fh[3] \n" if $DEBUG;
1463 # Make sure that the link count is zero
1464 return ( $fh[3] == 0 ? 1 : 0);
1467 _deferred_unlink($fh, $path, 0);
1475 =head1 PACKAGE VARIABLES
1477 These functions control the global state of the package.
1483 Controls the lengths to which the module will go to check the safety of the
1484 temporary file or directory before proceeding.
1491 Do the basic security measures to ensure the directory exists and
1492 is writable, that the umask() is fixed before opening of the file,
1493 that temporary files are opened only if they do not already exist, and
1494 that possible race conditions are avoided. Finally the L<unlink0|"unlink0">
1495 function is used to remove files safely.
1499 In addition to the STANDARD security, the output directory is checked
1500 to make sure that it is owned either by root or the user running the
1501 program. If the directory is writable by group or by other, it is then
1502 checked to make sure that the sticky bit is set.
1504 Will not work on platforms that do not support the C<-k> test
1509 In addition to the MEDIUM security checks, also check for the
1510 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
1511 sysconf() function. If this is a possibility, each directory in the
1512 path is checked in turn for safeness, recursively walking back to the
1515 For platforms that do not support the L<POSIX|POSIX>
1516 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
1517 assumed that ``chown() giveaway'' is possible and the recursive test
1522 The level can be changed as follows:
1524 File::Temp->safe_level( File::Temp::HIGH );
1526 The level constants are not exported by the module.
1528 Currently, you must be running at least perl v5.6.0 in order to
1529 run with MEDIUM or HIGH security. This is simply because the
1530 safety tests use functions from L<Fcntl|Fcntl> that are not
1531 available in older versions of perl. The problem is that the version
1532 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
1533 they are different versions.
1535 On systems that do not support the HIGH or MEDIUM safety levels
1536 (for example Win NT or OS/2) any attempt to change the level will
1537 be ignored. The decision to ignore rather than raise an exception
1538 allows portable programs to be written with high security in mind
1539 for the systems that can support this without those programs failing
1540 on systems where the extra tests are irrelevant.
1542 If you really need to see whether the change has been accepted
1543 simply examine the return value of C<safe_level>.
1545 $newlevel = File::Temp->safe_level( File::Temp::HIGH );
1546 die "Could not change to high security"
1547 if $newlevel != File::Temp::HIGH;
1552 # protect from using the variable itself
1553 my $LEVEL = STANDARD;
1558 if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
1559 carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n";
1561 # Dont allow this on perl 5.005 or earlier
1562 if ($] < 5.006 && $level != STANDARD) {
1563 # Cant do MEDIUM or HIGH checks
1564 croak "Currently requires perl 5.006 or newer to do the safe checks";
1566 # Check that we are allowed to change level
1567 # Silently ignore if we can not.
1568 $LEVEL = $level if _can_do_level($level);
1577 This is the highest UID on the current system that refers to a root
1578 UID. This is used to make sure that the temporary directory is
1579 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
1582 This is required since on many unix systems C</tmp> is not owned
1585 Default is to assume that any UID less than or equal to 10 is a root
1588 File::Temp->top_system_uid(10);
1589 my $topid = File::Temp->top_system_uid;
1591 This value can be adjusted to reduce security checking if required.
1592 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
1599 my $TopSystemUID = 10;
1600 sub top_system_uid {
1604 croak "top_system_uid: UIDs should be numeric"
1605 unless $newuid =~ /^\d+$/s;
1606 $TopSystemUID = $newuid;
1608 return $TopSystemUID;
1614 For maximum security, endeavour always to avoid ever looking at,
1615 touching, or even imputing the existence of the filename. You do not
1616 know that that filename is connected to the same file as the handle
1617 you have, and attempts to check this can only trigger more race
1618 conditions. It's far more secure to use the filehandle alone and
1619 dispense with the filename altogether.
1621 If you need to pass the handle to something that expects a filename
1622 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
1623 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
1624 programs. You will have to clear the close-on-exec bit on that file
1625 descriptor before passing it to another process.
1627 use Fcntl qw/F_SETFD F_GETFD/;
1628 fcntl($tmpfh, F_SETFD, 0)
1629 or die "Can't clear close-on-exec flag on temp fh: $!\n";
1633 Originally began life in May 1999 as an XS interface to the system
1634 mkstemp() function. In March 2000, the mkstemp() code was
1635 translated to Perl for total control of the code's
1636 security checking, to ensure the presence of the function regardless of
1637 operating system and to help with portability.
1641 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
1643 See L<File::MkTemp> for a different implementation of temporary
1648 Tim Jenness E<lt>t.jenness@jach.hawaii.eduE<gt>
1650 Copyright (C) 1999, 2000 Tim Jenness and the UK Particle Physics and
1651 Astronomy Research Council. All Rights Reserved. This program is free
1652 software; you can redistribute it and/or modify it under the same
1653 terms as Perl itself.
1655 Original Perl implementation loosely based on the OpenBSD C code for
1656 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
1657 should be written and providing ideas for code improvements and
1658 security enhancements.