This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade File::Temp from version 2.034 to 2.036
[perl5.git] / cpan / File-Temp / lib / File / Temp.pm
1 package File::Temp; # git description: v0.2305-8-g4787a5d
2 # ABSTRACT: return name and handle of a temporary file safely
3
4 our $VERSION = '0.2306';
5
6 #pod =begin __INTERNALS
7 #pod
8 #pod =head1 PORTABILITY
9 #pod
10 #pod This section is at the top in order to provide easier access to
11 #pod porters.  It is not expected to be rendered by a standard pod
12 #pod formatting tool. Please skip straight to the SYNOPSIS section if you
13 #pod are not trying to port this module to a new platform.
14 #pod
15 #pod This module is designed to be portable across operating systems and it
16 #pod currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
17 #pod (Classic). When porting to a new OS there are generally three main
18 #pod issues that have to be solved:
19 #pod
20 #pod =over 4
21 #pod
22 #pod =item *
23 #pod
24 #pod Can the OS unlink an open file? If it can not then the
25 #pod C<_can_unlink_opened_file> method should be modified.
26 #pod
27 #pod =item *
28 #pod
29 #pod Are the return values from C<stat> reliable? By default all the
30 #pod return values from C<stat> are compared when unlinking a temporary
31 #pod file using the filename and the handle. Operating systems other than
32 #pod unix do not always have valid entries in all fields. If utility function
33 #pod C<File::Temp::unlink0> fails then the C<stat> comparison should be
34 #pod modified accordingly.
35 #pod
36 #pod =item *
37 #pod
38 #pod Security. Systems that can not support a test for the sticky bit
39 #pod on a directory can not use the MEDIUM and HIGH security tests.
40 #pod The C<_can_do_level> method should be modified accordingly.
41 #pod
42 #pod =back
43 #pod
44 #pod =end __INTERNALS
45 #pod
46 #pod =head1 SYNOPSIS
47 #pod
48 #pod   use File::Temp qw/ tempfile tempdir /;
49 #pod
50 #pod   $fh = tempfile();
51 #pod   ($fh, $filename) = tempfile();
52 #pod
53 #pod   ($fh, $filename) = tempfile( $template, DIR => $dir);
54 #pod   ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
55 #pod   ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
56 #pod
57 #pod   binmode( $fh, ":utf8" );
58 #pod
59 #pod   $dir = tempdir( CLEANUP => 1 );
60 #pod   ($fh, $filename) = tempfile( DIR => $dir );
61 #pod
62 #pod Object interface:
63 #pod
64 #pod   require File::Temp;
65 #pod   use File::Temp ();
66 #pod   use File::Temp qw/ :seekable /;
67 #pod
68 #pod   $fh = File::Temp->new();
69 #pod   $fname = $fh->filename;
70 #pod
71 #pod   $fh = File::Temp->new(TEMPLATE => $template);
72 #pod   $fname = $fh->filename;
73 #pod
74 #pod   $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
75 #pod   print $tmp "Some data\n";
76 #pod   print "Filename is $tmp\n";
77 #pod   $tmp->seek( 0, SEEK_END );
78 #pod
79 #pod   $dir = File::Temp->newdir(); # CLEANUP => 1 by default
80 #pod
81 #pod The following interfaces are provided for compatibility with
82 #pod existing APIs. They should not be used in new code.
83 #pod
84 #pod MkTemp family:
85 #pod
86 #pod   use File::Temp qw/ :mktemp  /;
87 #pod
88 #pod   ($fh, $file) = mkstemp( "tmpfileXXXXX" );
89 #pod   ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
90 #pod
91 #pod   $tmpdir = mkdtemp( $template );
92 #pod
93 #pod   $unopened_file = mktemp( $template );
94 #pod
95 #pod POSIX functions:
96 #pod
97 #pod   use File::Temp qw/ :POSIX /;
98 #pod
99 #pod   $file = tmpnam();
100 #pod   $fh = tmpfile();
101 #pod
102 #pod   ($fh, $file) = tmpnam();
103 #pod
104 #pod Compatibility functions:
105 #pod
106 #pod   $unopened_file = File::Temp::tempnam( $dir, $pfx );
107 #pod
108 #pod =head1 DESCRIPTION
109 #pod
110 #pod C<File::Temp> can be used to create and open temporary files in a safe
111 #pod way.  There is both a function interface and an object-oriented
112 #pod interface.  The File::Temp constructor or the tempfile() function can
113 #pod be used to return the name and the open filehandle of a temporary
114 #pod file.  The tempdir() function can be used to create a temporary
115 #pod directory.
116 #pod
117 #pod The security aspect of temporary file creation is emphasized such that
118 #pod a filehandle and filename are returned together.  This helps guarantee
119 #pod that a race condition can not occur where the temporary file is
120 #pod created by another process between checking for the existence of the
121 #pod file and its opening.  Additional security levels are provided to
122 #pod check, for example, that the sticky bit is set on world writable
123 #pod directories.  See L<"safe_level"> for more information.
124 #pod
125 #pod For compatibility with popular C library functions, Perl implementations of
126 #pod the mkstemp() family of functions are provided. These are, mkstemp(),
127 #pod mkstemps(), mkdtemp() and mktemp().
128 #pod
129 #pod Additionally, implementations of the standard L<POSIX|POSIX>
130 #pod tmpnam() and tmpfile() functions are provided if required.
131 #pod
132 #pod Implementations of mktemp(), tmpnam(), and tempnam() are provided,
133 #pod but should be used with caution since they return only a filename
134 #pod that was valid when function was called, so cannot guarantee
135 #pod that the file will not exist by the time the caller opens the filename.
136 #pod
137 #pod Filehandles returned by these functions support the seekable methods.
138 #pod
139 #pod =cut
140
141 # Toolchain targets v5.8.1, but we'll try to support back to v5.6 anyway.
142 # It might be possible to make this v5.5, but many v5.6isms are creeping
143 # into the code and tests.
144 use 5.006;
145 use strict;
146 use Carp;
147 use File::Spec 0.8;
148 use Cwd ();
149 use File::Path 2.06 qw/ rmtree /;
150 use Fcntl 1.03;
151 use IO::Seekable;               # For SEEK_*
152 use Errno;
153 use Scalar::Util 'refaddr';
154 require VMS::Stdio if $^O eq 'VMS';
155
156 # pre-emptively load Carp::Heavy. If we don't when we run out of file
157 # handles and attempt to call croak() we get an error message telling
158 # us that Carp::Heavy won't load rather than an error telling us we
159 # have run out of file handles. We either preload croak() or we
160 # switch the calls to croak from _gettemp() to use die.
161 eval { require Carp::Heavy; };
162
163 # Need the Symbol package if we are running older perl
164 require Symbol if $] < 5.006;
165
166 ### For the OO interface
167 use parent 0.221 qw/ IO::Handle IO::Seekable /;
168 use overload '""' => "STRINGIFY", '0+' => "NUMIFY",
169   fallback => 1;
170
171 our $DEBUG = 0;
172 our $KEEP_ALL = 0;
173
174 # We are exporting functions
175
176 use Exporter 5.57 'import';   # 5.57 lets us import 'import'
177
178 # Export list - to allow fine tuning of export table
179
180 our @EXPORT_OK = qw{
181                  tempfile
182                  tempdir
183                  tmpnam
184                  tmpfile
185                  mktemp
186                  mkstemp
187                  mkstemps
188                  mkdtemp
189                  unlink0
190                  cleanup
191                  SEEK_SET
192                  SEEK_CUR
193                  SEEK_END
194              };
195
196 # Groups of functions for export
197
198 our %EXPORT_TAGS = (
199                 'POSIX' => [qw/ tmpnam tmpfile /],
200                 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
201                 'seekable' => [qw/ SEEK_SET SEEK_CUR SEEK_END /],
202                );
203
204 # add contents of these tags to @EXPORT
205 Exporter::export_tags('POSIX','mktemp','seekable');
206
207 # This is a list of characters that can be used in random filenames
208
209 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
210                  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
211                  0 1 2 3 4 5 6 7 8 9 _
212                /);
213
214 # Maximum number of tries to make a temp file before failing
215
216 use constant MAX_TRIES => 1000;
217
218 # Minimum number of X characters that should be in a template
219 use constant MINX => 4;
220
221 # Default template when no template supplied
222
223 use constant TEMPXXX => 'X' x 10;
224
225 # Constants for the security level
226
227 use constant STANDARD => 0;
228 use constant MEDIUM   => 1;
229 use constant HIGH     => 2;
230
231 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
232 # us an optimisation when many temporary files are requested
233
234 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
235 my $LOCKFLAG;
236
237 unless ($^O eq 'MacOS') {
238   for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE NOINHERIT /) {
239     my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
240     no strict 'refs';
241     $OPENFLAGS |= $bit if eval {
242       # Make sure that redefined die handlers do not cause problems
243       # e.g. CGI::Carp
244       local $SIG{__DIE__} = sub {};
245       local $SIG{__WARN__} = sub {};
246       $bit = &$func();
247       1;
248     };
249   }
250   # Special case O_EXLOCK
251   $LOCKFLAG = eval {
252     local $SIG{__DIE__} = sub {};
253     local $SIG{__WARN__} = sub {};
254     &Fcntl::O_EXLOCK();
255   };
256 }
257
258 # On some systems the O_TEMPORARY flag can be used to tell the OS
259 # to automatically remove the file when it is closed. This is fine
260 # in most cases but not if tempfile is called with UNLINK=>0 and
261 # the filename is requested -- in the case where the filename is to
262 # be passed to another routine. This happens on windows. We overcome
263 # this by using a second open flags variable
264
265 my $OPENTEMPFLAGS = $OPENFLAGS;
266 unless ($^O eq 'MacOS') {
267   for my $oflag (qw/ TEMPORARY /) {
268     my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
269     local($@);
270     no strict 'refs';
271     $OPENTEMPFLAGS |= $bit if eval {
272       # Make sure that redefined die handlers do not cause problems
273       # e.g. CGI::Carp
274       local $SIG{__DIE__} = sub {};
275       local $SIG{__WARN__} = sub {};
276       $bit = &$func();
277       1;
278     };
279   }
280 }
281
282 # Private hash tracking which files have been created by each process id via the OO interface
283 my %FILES_CREATED_BY_OBJECT;
284
285 # INTERNAL ROUTINES - not to be used outside of package
286
287 # Generic routine for getting a temporary filename
288 # modelled on OpenBSD _gettemp() in mktemp.c
289
290 # The template must contain X's that are to be replaced
291 # with the random values
292
293 #  Arguments:
294
295 #  TEMPLATE   - string containing the XXXXX's that is converted
296 #           to a random filename and opened if required
297
298 # Optionally, a hash can also be supplied containing specific options
299 #   "open" => if true open the temp file, else just return the name
300 #             default is 0
301 #   "mkdir"=> if true, we are creating a temp directory rather than tempfile
302 #             default is 0
303 #   "suffixlen" => number of characters at end of PATH to be ignored.
304 #                  default is 0.
305 #   "unlink_on_close" => indicates that, if possible,  the OS should remove
306 #                        the file as soon as it is closed. Usually indicates
307 #                        use of the O_TEMPORARY flag to sysopen.
308 #                        Usually irrelevant on unix
309 #   "use_exlock" => Indicates that O_EXLOCK should be used. Default is true.
310
311 # Optionally a reference to a scalar can be passed into the function
312 # On error this will be used to store the reason for the error
313 #   "ErrStr"  => \$errstr
314
315 # "open" and "mkdir" can not both be true
316 # "unlink_on_close" is not used when "mkdir" is true.
317
318 # The default options are equivalent to mktemp().
319
320 # Returns:
321 #   filehandle - open file handle (if called with doopen=1, else undef)
322 #   temp name  - name of the temp file or directory
323
324 # For example:
325 #   ($fh, $name) = _gettemp($template, "open" => 1);
326
327 # for the current version, failures are associated with
328 # stored in an error string and returned to give the reason whilst debugging
329 # This routine is not called by any external function
330 sub _gettemp {
331
332   croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
333     unless scalar(@_) >= 1;
334
335   # the internal error string - expect it to be overridden
336   # Need this in case the caller decides not to supply us a value
337   # need an anonymous scalar
338   my $tempErrStr;
339
340   # Default options
341   my %options = (
342                  "open" => 0,
343                  "mkdir" => 0,
344                  "suffixlen" => 0,
345                  "unlink_on_close" => 0,
346                  "use_exlock" => 1,
347                  "ErrStr" => \$tempErrStr,
348                 );
349
350   # Read the template
351   my $template = shift;
352   if (ref($template)) {
353     # Use a warning here since we have not yet merged ErrStr
354     carp "File::Temp::_gettemp: template must not be a reference";
355     return ();
356   }
357
358   # Check that the number of entries on stack are even
359   if (scalar(@_) % 2 != 0) {
360     # Use a warning here since we have not yet merged ErrStr
361     carp "File::Temp::_gettemp: Must have even number of options";
362     return ();
363   }
364
365   # Read the options and merge with defaults
366   %options = (%options, @_)  if @_;
367
368   # Make sure the error string is set to undef
369   ${$options{ErrStr}} = undef;
370
371   # Can not open the file and make a directory in a single call
372   if ($options{"open"} && $options{"mkdir"}) {
373     ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
374     return ();
375   }
376
377   # Find the start of the end of the  Xs (position of last X)
378   # Substr starts from 0
379   my $start = length($template) - 1 - $options{"suffixlen"};
380
381   # Check that we have at least MINX x X (e.g. 'XXXX") at the end of the string
382   # (taking suffixlen into account). Any fewer is insecure.
383
384   # Do it using substr - no reason to use a pattern match since
385   # we know where we are looking and what we are looking for
386
387   if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
388     ${$options{ErrStr}} = "The template must end with at least ".
389       MINX . " 'X' characters\n";
390     return ();
391   }
392
393   # Replace all the X at the end of the substring with a
394   # random character or just all the XX at the end of a full string.
395   # Do it as an if, since the suffix adjusts which section to replace
396   # and suffixlen=0 returns nothing if used in the substr directly
397   # and generate a full path from the template
398
399   my $path = _replace_XX($template, $options{"suffixlen"});
400
401
402   # Split the path into constituent parts - eventually we need to check
403   # whether the directory exists
404   # We need to know whether we are making a temp directory
405   # or a tempfile
406
407   my ($volume, $directories, $file);
408   my $parent;                   # parent directory
409   if ($options{"mkdir"}) {
410     # There is no filename at the end
411     ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
412
413     # The parent is then $directories without the last directory
414     # Split the directory and put it back together again
415     my @dirs = File::Spec->splitdir($directories);
416
417     # If @dirs only has one entry (i.e. the directory template) that means
418     # we are in the current directory
419     if ($#dirs == 0) {
420       $parent = File::Spec->curdir;
421     } else {
422
423       if ($^O eq 'VMS') {     # need volume to avoid relative dir spec
424         $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
425         $parent = 'sys$disk:[]' if $parent eq '';
426       } else {
427
428         # Put it back together without the last one
429         $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
430
431         # ...and attach the volume (no filename)
432         $parent = File::Spec->catpath($volume, $parent, '');
433       }
434
435     }
436
437   } else {
438
439     # Get rid of the last filename (use File::Basename for this?)
440     ($volume, $directories, $file) = File::Spec->splitpath( $path );
441
442     # Join up without the file part
443     $parent = File::Spec->catpath($volume,$directories,'');
444
445     # If $parent is empty replace with curdir
446     $parent = File::Spec->curdir
447       unless $directories ne '';
448
449   }
450
451   # Check that the parent directories exist
452   # Do this even for the case where we are simply returning a name
453   # not a file -- no point returning a name that includes a directory
454   # that does not exist or is not writable
455
456   unless (-e $parent) {
457     ${$options{ErrStr}} = "Parent directory ($parent) does not exist";
458     return ();
459   }
460   unless (-d $parent) {
461     ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
462     return ();
463   }
464
465   # Check the stickiness of the directory and chown giveaway if required
466   # If the directory is world writable the sticky bit
467   # must be set
468
469   if (File::Temp->safe_level == MEDIUM) {
470     my $safeerr;
471     unless (_is_safe($parent,\$safeerr)) {
472       ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
473       return ();
474     }
475   } elsif (File::Temp->safe_level == HIGH) {
476     my $safeerr;
477     unless (_is_verysafe($parent, \$safeerr)) {
478       ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
479       return ();
480     }
481   }
482
483
484   # Now try MAX_TRIES time to open the file
485   for (my $i = 0; $i < MAX_TRIES; $i++) {
486
487     # Try to open the file if requested
488     if ($options{"open"}) {
489       my $fh;
490
491       # If we are running before perl5.6.0 we can not auto-vivify
492       if ($] < 5.006) {
493         $fh = &Symbol::gensym;
494       }
495
496       # Try to make sure this will be marked close-on-exec
497       # XXX: Win32 doesn't respect this, nor the proper fcntl,
498       #      but may have O_NOINHERIT. This may or may not be in Fcntl.
499       local $^F = 2;
500
501       # Attempt to open the file
502       my $open_success = undef;
503       if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
504         # make it auto delete on close by setting FAB$V_DLT bit
505         $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
506         $open_success = $fh;
507       } else {
508         my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
509                       $OPENTEMPFLAGS :
510                       $OPENFLAGS );
511         $flags |= $LOCKFLAG if (defined $LOCKFLAG && $options{use_exlock});
512         $open_success = sysopen($fh, $path, $flags, 0600);
513       }
514       if ( $open_success ) {
515
516         # in case of odd umask force rw
517         chmod(0600, $path);
518
519         # Opened successfully - return file handle and name
520         return ($fh, $path);
521
522       } else {
523
524         # Error opening file - abort with error
525         # if the reason was anything but EEXIST
526         unless ($!{EEXIST}) {
527           ${$options{ErrStr}} = "Could not create temp file $path: $!";
528           return ();
529         }
530
531         # Loop round for another try
532
533       }
534     } elsif ($options{"mkdir"}) {
535
536       # Open the temp directory
537       if (mkdir( $path, 0700)) {
538         # in case of odd umask
539         chmod(0700, $path);
540
541         return undef, $path;
542       } else {
543
544         # Abort with error if the reason for failure was anything
545         # except EEXIST
546         unless ($!{EEXIST}) {
547           ${$options{ErrStr}} = "Could not create directory $path: $!";
548           return ();
549         }
550
551         # Loop round for another try
552
553       }
554
555     } else {
556
557       # Return true if the file can not be found
558       # Directory has been checked previously
559
560       return (undef, $path) unless -e $path;
561
562       # Try again until MAX_TRIES
563
564     }
565
566     # Did not successfully open the tempfile/dir
567     # so try again with a different set of random letters
568     # No point in trying to increment unless we have only
569     # 1 X say and the randomness could come up with the same
570     # file MAX_TRIES in a row.
571
572     # Store current attempt - in principle this implies that the
573     # 3rd time around the open attempt that the first temp file
574     # name could be generated again. Probably should store each
575     # attempt and make sure that none are repeated
576
577     my $original = $path;
578     my $counter = 0;            # Stop infinite loop
579     my $MAX_GUESS = 50;
580
581     do {
582
583       # Generate new name from original template
584       $path = _replace_XX($template, $options{"suffixlen"});
585
586       $counter++;
587
588     } until ($path ne $original || $counter > $MAX_GUESS);
589
590     # Check for out of control looping
591     if ($counter > $MAX_GUESS) {
592       ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
593       return ();
594     }
595
596   }
597
598   # If we get here, we have run out of tries
599   ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
600     . MAX_TRIES . ") to open temp file/dir";
601
602   return ();
603
604 }
605
606 # Internal routine to replace the XXXX... with random characters
607 # This has to be done by _gettemp() every time it fails to
608 # open a temp file/dir
609
610 # Arguments:  $template (the template with XXX),
611 #             $ignore   (number of characters at end to ignore)
612
613 # Returns:    modified template
614
615 sub _replace_XX {
616
617   croak 'Usage: _replace_XX($template, $ignore)'
618     unless scalar(@_) == 2;
619
620   my ($path, $ignore) = @_;
621
622   # Do it as an if, since the suffix adjusts which section to replace
623   # and suffixlen=0 returns nothing if used in the substr directly
624   # Alternatively, could simply set $ignore to length($path)-1
625   # Don't want to always use substr when not required though.
626   my $end = ( $] >= 5.006 ? "\\z" : "\\Z" );
627
628   if ($ignore) {
629     substr($path, 0, - $ignore) =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
630   } else {
631     $path =~ s/X(?=X*$end)/$CHARS[ int( rand( @CHARS ) ) ]/ge;
632   }
633   return $path;
634 }
635
636 # Internal routine to force a temp file to be writable after
637 # it is created so that we can unlink it. Windows seems to occasionally
638 # force a file to be readonly when written to certain temp locations
639 sub _force_writable {
640   my $file = shift;
641   chmod 0600, $file;
642 }
643
644
645 # internal routine to check to see if the directory is safe
646 # First checks to see if the directory is not owned by the
647 # current user or root. Then checks to see if anyone else
648 # can write to the directory and if so, checks to see if
649 # it has the sticky bit set
650
651 # Will not work on systems that do not support sticky bit
652
653 #Args:  directory path to check
654 #       Optionally: reference to scalar to contain error message
655 # Returns true if the path is safe and false otherwise.
656 # Returns undef if can not even run stat() on the path
657
658 # This routine based on version written by Tom Christiansen
659
660 # Presumably, by the time we actually attempt to create the
661 # file or directory in this directory, it may not be safe
662 # anymore... Have to run _is_safe directly after the open.
663
664 sub _is_safe {
665
666   my $path = shift;
667   my $err_ref = shift;
668
669   # Stat path
670   my @info = stat($path);
671   unless (scalar(@info)) {
672     $$err_ref = "stat(path) returned no values";
673     return 0;
674   }
675   ;
676   return 1 if $^O eq 'VMS';     # owner delete control at file level
677
678   # Check to see whether owner is neither superuser (or a system uid) nor me
679   # Use the effective uid from the $> variable
680   # UID is in [4]
681   if ($info[4] > File::Temp->top_system_uid() && $info[4] != $>) {
682
683     Carp::cluck(sprintf "uid=$info[4] topuid=%s euid=$> path='$path'",
684                 File::Temp->top_system_uid());
685
686     $$err_ref = "Directory owned neither by root nor the current user"
687       if ref($err_ref);
688     return 0;
689   }
690
691   # check whether group or other can write file
692   # use 066 to detect either reading or writing
693   # use 022 to check writability
694   # Do it with S_IWOTH and S_IWGRP for portability (maybe)
695   # mode is in info[2]
696   if (($info[2] & &Fcntl::S_IWGRP) ||  # Is group writable?
697       ($info[2] & &Fcntl::S_IWOTH) ) { # Is world writable?
698     # Must be a directory
699     unless (-d $path) {
700       $$err_ref = "Path ($path) is not a directory"
701         if ref($err_ref);
702       return 0;
703     }
704     # Must have sticky bit set
705     unless (-k $path) {
706       $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
707         if ref($err_ref);
708       return 0;
709     }
710   }
711
712   return 1;
713 }
714
715 # Internal routine to check whether a directory is safe
716 # for temp files. Safer than _is_safe since it checks for
717 # the possibility of chown giveaway and if that is a possibility
718 # checks each directory in the path to see if it is safe (with _is_safe)
719
720 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
721 # directory anyway.
722
723 # Takes optional second arg as scalar ref to error reason
724
725 sub _is_verysafe {
726
727   # Need POSIX - but only want to bother if really necessary due to overhead
728   require POSIX;
729
730   my $path = shift;
731   print "_is_verysafe testing $path\n" if $DEBUG;
732   return 1 if $^O eq 'VMS';     # owner delete control at file level
733
734   my $err_ref = shift;
735
736   # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
737   # and If it is not there do the extensive test
738   local($@);
739   my $chown_restricted;
740   $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
741     if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
742
743   # If chown_resticted is set to some value we should test it
744   if (defined $chown_restricted) {
745
746     # Return if the current directory is safe
747     return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
748
749   }
750
751   # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
752   # was not available or the symbol was there but chown giveaway
753   # is allowed. Either way, we now have to test the entire tree for
754   # safety.
755
756   # Convert path to an absolute directory if required
757   unless (File::Spec->file_name_is_absolute($path)) {
758     $path = File::Spec->rel2abs($path);
759   }
760
761   # Split directory into components - assume no file
762   my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
763
764   # Slightly less efficient than having a function in File::Spec
765   # to chop off the end of a directory or even a function that
766   # can handle ../ in a directory tree
767   # Sometimes splitdir() returns a blank at the end
768   # so we will probably check the bottom directory twice in some cases
769   my @dirs = File::Spec->splitdir($directories);
770
771   # Concatenate one less directory each time around
772   foreach my $pos (0.. $#dirs) {
773     # Get a directory name
774     my $dir = File::Spec->catpath($volume,
775                                   File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
776                                   ''
777                                  );
778
779     print "TESTING DIR $dir\n" if $DEBUG;
780
781     # Check the directory
782     return 0 unless _is_safe($dir,$err_ref);
783
784   }
785
786   return 1;
787 }
788
789
790
791 # internal routine to determine whether unlink works on this
792 # platform for files that are currently open.
793 # Returns true if we can, false otherwise.
794
795 # Currently WinNT, OS/2 and VMS can not unlink an opened file
796 # On VMS this is because the O_EXCL flag is used to open the
797 # temporary file. Currently I do not know enough about the issues
798 # on VMS to decide whether O_EXCL is a requirement.
799
800 sub _can_unlink_opened_file {
801
802   if (grep { $^O eq $_ } qw/MSWin32 os2 VMS dos MacOS haiku/) {
803     return 0;
804   } else {
805     return 1;
806   }
807
808 }
809
810 # internal routine to decide which security levels are allowed
811 # see safe_level() for more information on this
812
813 # Controls whether the supplied security level is allowed
814
815 #   $cando = _can_do_level( $level )
816
817 sub _can_do_level {
818
819   # Get security level
820   my $level = shift;
821
822   # Always have to be able to do STANDARD
823   return 1 if $level == STANDARD;
824
825   # Currently, the systems that can do HIGH or MEDIUM are identical
826   if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
827     return 0;
828   } else {
829     return 1;
830   }
831
832 }
833
834 # This routine sets up a deferred unlinking of a specified
835 # filename and filehandle. It is used in the following cases:
836 #  - Called by unlink0 if an opened file can not be unlinked
837 #  - Called by tempfile() if files are to be removed on shutdown
838 #  - Called by tempdir() if directories are to be removed on shutdown
839
840 # Arguments:
841 #   _deferred_unlink( $fh, $fname, $isdir );
842 #
843 #   - filehandle (so that it can be explicitly closed if open
844 #   - filename   (the thing we want to remove)
845 #   - isdir      (flag to indicate that we are being given a directory)
846 #                 [and hence no filehandle]
847
848 # Status is not referred to since all the magic is done with an END block
849
850 {
851   # Will set up two lexical variables to contain all the files to be
852   # removed. One array for files, another for directories They will
853   # only exist in this block.
854
855   #  This means we only have to set up a single END block to remove
856   #  all files. 
857
858   # in order to prevent child processes inadvertently deleting the parent
859   # temp files we use a hash to store the temp files and directories
860   # created by a particular process id.
861
862   # %files_to_unlink contains values that are references to an array of
863   # array references containing the filehandle and filename associated with
864   # the temp file.
865   my (%files_to_unlink, %dirs_to_unlink);
866
867   # Set up an end block to use these arrays
868   END {
869     local($., $@, $!, $^E, $?);
870     cleanup(at_exit => 1);
871   }
872
873   # Cleanup function. Always triggered on END (with at_exit => 1) but
874   # can be invoked manually.
875   sub cleanup {
876     my %h = @_;
877     my $at_exit = delete $h{at_exit};
878     $at_exit = 0 if not defined $at_exit;
879     { my @k = sort keys %h; die "unrecognized parameters: @k" if @k }
880
881     if (!$KEEP_ALL) {
882       # Files
883       my @files = (exists $files_to_unlink{$$} ?
884                    @{ $files_to_unlink{$$} } : () );
885       foreach my $file (@files) {
886         # close the filehandle without checking its state
887         # in order to make real sure that this is closed
888         # if its already closed then I don't care about the answer
889         # probably a better way to do this
890         close($file->[0]);      # file handle is [0]
891
892         if (-f $file->[1]) {       # file name is [1]
893           _force_writable( $file->[1] ); # for windows
894           unlink $file->[1] or warn "Error removing ".$file->[1];
895         }
896       }
897       # Dirs
898       my @dirs = (exists $dirs_to_unlink{$$} ?
899                   @{ $dirs_to_unlink{$$} } : () );
900       my ($cwd, $cwd_to_remove);
901       foreach my $dir (@dirs) {
902         if (-d $dir) {
903           # Some versions of rmtree will abort if you attempt to remove
904           # the directory you are sitting in. For automatic cleanup
905           # at program exit, we avoid this by chdir()ing out of the way
906           # first. If not at program exit, it's best not to mess with the
907           # current directory, so just let it fail with a warning.
908           if ($at_exit) {
909             $cwd = Cwd::abs_path(File::Spec->curdir) if not defined $cwd;
910             my $abs = Cwd::abs_path($dir);
911             if ($abs eq $cwd) {
912               $cwd_to_remove = $dir;
913               next;
914             }
915           }
916           eval { rmtree($dir, $DEBUG, 0); };
917           warn $@ if ($@ && $^W);
918         }
919       }
920
921       if (defined $cwd_to_remove) {
922         # We do need to clean up the current directory, and everything
923         # else is done, so get out of there and remove it.
924         chdir $cwd_to_remove or die "cannot chdir to $cwd_to_remove: $!";
925         my $updir = File::Spec->updir;
926         chdir $updir or die "cannot chdir to $updir: $!";
927         eval { rmtree($cwd_to_remove, $DEBUG, 0); };
928         warn $@ if ($@ && $^W);
929       }
930
931       # clear the arrays
932       @{ $files_to_unlink{$$} } = ()
933         if exists $files_to_unlink{$$};
934       @{ $dirs_to_unlink{$$} } = ()
935         if exists $dirs_to_unlink{$$};
936     }
937   }
938
939
940   # This is the sub called to register a file for deferred unlinking
941   # This could simply store the input parameters and defer everything
942   # until the END block. For now we do a bit of checking at this
943   # point in order to make sure that (1) we have a file/dir to delete
944   # and (2) we have been called with the correct arguments.
945   sub _deferred_unlink {
946
947     croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
948       unless scalar(@_) == 3;
949
950     my ($fh, $fname, $isdir) = @_;
951
952     warn "Setting up deferred removal of $fname\n"
953       if $DEBUG;
954
955     # make sure we save the absolute path for later cleanup
956     # OK to untaint because we only ever use this internally
957     # as a file path, never interpolating into the shell
958     $fname = Cwd::abs_path($fname);
959     ($fname) = $fname =~ /^(.*)$/;
960
961     # If we have a directory, check that it is a directory
962     if ($isdir) {
963
964       if (-d $fname) {
965
966         # Directory exists so store it
967         # first on VMS turn []foo into [.foo] for rmtree
968         $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
969         $dirs_to_unlink{$$} = [] 
970           unless exists $dirs_to_unlink{$$};
971         push (@{ $dirs_to_unlink{$$} }, $fname);
972
973       } else {
974         carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
975       }
976
977     } else {
978
979       if (-f $fname) {
980
981         # file exists so store handle and name for later removal
982         $files_to_unlink{$$} = []
983           unless exists $files_to_unlink{$$};
984         push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
985
986       } else {
987         carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
988       }
989
990     }
991
992   }
993
994
995 }
996
997 # normalize argument keys to upper case and do consistent handling
998 # of leading template vs TEMPLATE
999 sub _parse_args {
1000   my $leading_template = (scalar(@_) % 2 == 1 ? shift(@_) : '' );
1001   my %args = @_;
1002   %args = map { uc($_), $args{$_} } keys %args;
1003
1004   # template (store it in an array so that it will
1005   # disappear from the arg list of tempfile)
1006   my @template = (
1007     exists $args{TEMPLATE}  ? $args{TEMPLATE} :
1008     $leading_template       ? $leading_template : ()
1009   );
1010   delete $args{TEMPLATE};
1011
1012   return( \@template, \%args );
1013 }
1014
1015 #pod =head1 OBJECT-ORIENTED INTERFACE
1016 #pod
1017 #pod This is the primary interface for interacting with
1018 #pod C<File::Temp>. Using the OO interface a temporary file can be created
1019 #pod when the object is constructed and the file can be removed when the
1020 #pod object is no longer required.
1021 #pod
1022 #pod Note that there is no method to obtain the filehandle from the
1023 #pod C<File::Temp> object. The object itself acts as a filehandle.  The object
1024 #pod isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
1025 #pod available.
1026 #pod
1027 #pod Also, the object is configured such that it stringifies to the name of the
1028 #pod temporary file and so can be compared to a filename directly.  It numifies
1029 #pod to the C<refaddr> the same as other handles and so can be compared to other
1030 #pod handles with C<==>.
1031 #pod
1032 #pod     $fh eq $filename       # as a string
1033 #pod     $fh != \*STDOUT        # as a number
1034 #pod
1035 #pod Available since 0.14.
1036 #pod
1037 #pod =over 4
1038 #pod
1039 #pod =item B<new>
1040 #pod
1041 #pod Create a temporary file object.
1042 #pod
1043 #pod   my $tmp = File::Temp->new();
1044 #pod
1045 #pod by default the object is constructed as if C<tempfile>
1046 #pod was called without options, but with the additional behaviour
1047 #pod that the temporary file is removed by the object destructor
1048 #pod if UNLINK is set to true (the default).
1049 #pod
1050 #pod Supported arguments are the same as for C<tempfile>: UNLINK
1051 #pod (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
1052 #pod template is specified using the TEMPLATE option. The OPEN option
1053 #pod is not supported (the file is always opened).
1054 #pod
1055 #pod  $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
1056 #pod                         DIR => 'mydir',
1057 #pod                         SUFFIX => '.dat');
1058 #pod
1059 #pod Arguments are case insensitive.
1060 #pod
1061 #pod Can call croak() if an error occurs.
1062 #pod
1063 #pod Available since 0.14.
1064 #pod
1065 #pod TEMPLATE available since 0.23
1066 #pod
1067 #pod =cut
1068
1069 sub new {
1070   my $proto = shift;
1071   my $class = ref($proto) || $proto;
1072
1073   my ($maybe_template, $args) = _parse_args(@_);
1074
1075   # see if they are unlinking (defaulting to yes)
1076   my $unlink = (exists $args->{UNLINK} ? $args->{UNLINK} : 1 );
1077   delete $args->{UNLINK};
1078
1079   # Protect OPEN
1080   delete $args->{OPEN};
1081
1082   # Open the file and retain file handle and file name
1083   my ($fh, $path) = tempfile( @$maybe_template, %$args );
1084
1085   print "Tmp: $fh - $path\n" if $DEBUG;
1086
1087   # Store the filename in the scalar slot
1088   ${*$fh} = $path;
1089
1090   # Cache the filename by pid so that the destructor can decide whether to remove it
1091   $FILES_CREATED_BY_OBJECT{$$}{$path} = 1;
1092
1093   # Store unlink information in hash slot (plus other constructor info)
1094   %{*$fh} = %$args;
1095
1096   # create the object
1097   bless $fh, $class;
1098
1099   # final method-based configuration
1100   $fh->unlink_on_destroy( $unlink );
1101
1102   return $fh;
1103 }
1104
1105 #pod =item B<newdir>
1106 #pod
1107 #pod Create a temporary directory using an object oriented interface.
1108 #pod
1109 #pod   $dir = File::Temp->newdir();
1110 #pod
1111 #pod By default the directory is deleted when the object goes out of scope.
1112 #pod
1113 #pod Supports the same options as the C<tempdir> function. Note that directories
1114 #pod created with this method default to CLEANUP => 1.
1115 #pod
1116 #pod   $dir = File::Temp->newdir( $template, %options );
1117 #pod
1118 #pod A template may be specified either with a leading template or
1119 #pod with a TEMPLATE argument.
1120 #pod
1121 #pod Available since 0.19.
1122 #pod
1123 #pod TEMPLATE available since 0.23.
1124 #pod
1125 #pod =cut
1126
1127 sub newdir {
1128   my $self = shift;
1129
1130   my ($maybe_template, $args) = _parse_args(@_);
1131
1132   # handle CLEANUP without passing CLEANUP to tempdir
1133   my $cleanup = (exists $args->{CLEANUP} ? $args->{CLEANUP} : 1 );
1134   delete $args->{CLEANUP};
1135
1136   my $tempdir = tempdir( @$maybe_template, %$args);
1137
1138   # get a safe absolute path for cleanup, just like
1139   # happens in _deferred_unlink
1140   my $real_dir = Cwd::abs_path( $tempdir );
1141   ($real_dir) = $real_dir =~ /^(.*)$/;
1142
1143   return bless { DIRNAME => $tempdir,
1144                  REALNAME => $real_dir,
1145                  CLEANUP => $cleanup,
1146                  LAUNCHPID => $$,
1147                }, "File::Temp::Dir";
1148 }
1149
1150 #pod =item B<filename>
1151 #pod
1152 #pod Return the name of the temporary file associated with this object
1153 #pod (if the object was created using the "new" constructor).
1154 #pod
1155 #pod   $filename = $tmp->filename;
1156 #pod
1157 #pod This method is called automatically when the object is used as
1158 #pod a string.
1159 #pod
1160 #pod Current API available since 0.14
1161 #pod
1162 #pod =cut
1163
1164 sub filename {
1165   my $self = shift;
1166   return ${*$self};
1167 }
1168
1169 sub STRINGIFY {
1170   my $self = shift;
1171   return $self->filename;
1172 }
1173
1174 # For reference, can't use '0+'=>\&Scalar::Util::refaddr directly because
1175 # refaddr() demands one parameter only, whereas overload.pm calls with three
1176 # even for unary operations like '0+'.
1177 sub NUMIFY {
1178   return refaddr($_[0]);
1179 }
1180
1181 #pod =item B<dirname>
1182 #pod
1183 #pod Return the name of the temporary directory associated with this
1184 #pod object (if the object was created using the "newdir" constructor).
1185 #pod
1186 #pod   $dirname = $tmpdir->dirname;
1187 #pod
1188 #pod This method is called automatically when the object is used in string context.
1189 #pod
1190 #pod =item B<unlink_on_destroy>
1191 #pod
1192 #pod Control whether the file is unlinked when the object goes out of scope.
1193 #pod The file is removed if this value is true and $KEEP_ALL is not.
1194 #pod
1195 #pod  $fh->unlink_on_destroy( 1 );
1196 #pod
1197 #pod Default is for the file to be removed.
1198 #pod
1199 #pod Current API available since 0.15
1200 #pod
1201 #pod =cut
1202
1203 sub unlink_on_destroy {
1204   my $self = shift;
1205   if (@_) {
1206     ${*$self}{UNLINK} = shift;
1207   }
1208   return ${*$self}{UNLINK};
1209 }
1210
1211 #pod =item B<DESTROY>
1212 #pod
1213 #pod When the object goes out of scope, the destructor is called. This
1214 #pod destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
1215 #pod if the constructor was called with UNLINK set to 1 (the default state
1216 #pod if UNLINK is not specified).
1217 #pod
1218 #pod No error is given if the unlink fails.
1219 #pod
1220 #pod If the object has been passed to a child process during a fork, the
1221 #pod file will be deleted when the object goes out of scope in the parent.
1222 #pod
1223 #pod For a temporary directory object the directory will be removed unless
1224 #pod the CLEANUP argument was used in the constructor (and set to false) or
1225 #pod C<unlink_on_destroy> was modified after creation.  Note that if a temp
1226 #pod directory is your current directory, it cannot be removed - a warning
1227 #pod will be given in this case.  C<chdir()> out of the directory before
1228 #pod letting the object go out of scope.
1229 #pod
1230 #pod If the global variable $KEEP_ALL is true, the file or directory
1231 #pod will not be removed.
1232 #pod
1233 #pod =cut
1234
1235 sub DESTROY {
1236   local($., $@, $!, $^E, $?);
1237   my $self = shift;
1238
1239   # Make sure we always remove the file from the global hash
1240   # on destruction. This prevents the hash from growing uncontrollably
1241   # and post-destruction there is no reason to know about the file.
1242   my $file = $self->filename;
1243   my $was_created_by_proc;
1244   if (exists $FILES_CREATED_BY_OBJECT{$$}{$file}) {
1245     $was_created_by_proc = 1;
1246     delete $FILES_CREATED_BY_OBJECT{$$}{$file};
1247   }
1248
1249   if (${*$self}{UNLINK} && !$KEEP_ALL) {
1250     print "# --------->   Unlinking $self\n" if $DEBUG;
1251
1252     # only delete if this process created it
1253     return unless $was_created_by_proc;
1254
1255     # The unlink1 may fail if the file has been closed
1256     # by the caller. This leaves us with the decision
1257     # of whether to refuse to remove the file or simply
1258     # do an unlink without test. Seems to be silly
1259     # to do this when we are trying to be careful
1260     # about security
1261     _force_writable( $file ); # for windows
1262     unlink1( $self, $file )
1263       or unlink($file);
1264   }
1265 }
1266
1267 #pod =back
1268 #pod
1269 #pod =head1 FUNCTIONS
1270 #pod
1271 #pod This section describes the recommended interface for generating
1272 #pod temporary files and directories.
1273 #pod
1274 #pod =over 4
1275 #pod
1276 #pod =item B<tempfile>
1277 #pod
1278 #pod This is the basic function to generate temporary files.
1279 #pod The behaviour of the file can be changed using various options:
1280 #pod
1281 #pod   $fh = tempfile();
1282 #pod   ($fh, $filename) = tempfile();
1283 #pod
1284 #pod Create a temporary file in  the directory specified for temporary
1285 #pod files, as specified by the tmpdir() function in L<File::Spec>.
1286 #pod
1287 #pod   ($fh, $filename) = tempfile($template);
1288 #pod
1289 #pod Create a temporary file in the current directory using the supplied
1290 #pod template.  Trailing `X' characters are replaced with random letters to
1291 #pod generate the filename.  At least four `X' characters must be present
1292 #pod at the end of the template.
1293 #pod
1294 #pod   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1295 #pod
1296 #pod Same as previously, except that a suffix is added to the template
1297 #pod after the `X' translation.  Useful for ensuring that a temporary
1298 #pod filename has a particular extension when needed by other applications.
1299 #pod But see the WARNING at the end.
1300 #pod
1301 #pod   ($fh, $filename) = tempfile($template, DIR => $dir);
1302 #pod
1303 #pod Translates the template as before except that a directory name
1304 #pod is specified.
1305 #pod
1306 #pod   ($fh, $filename) = tempfile($template, TMPDIR => 1);
1307 #pod
1308 #pod Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
1309 #pod into the same temporary directory as would be used if no template was
1310 #pod specified at all.
1311 #pod
1312 #pod   ($fh, $filename) = tempfile($template, UNLINK => 1);
1313 #pod
1314 #pod Return the filename and filehandle as before except that the file is
1315 #pod automatically removed when the program exits (dependent on
1316 #pod $KEEP_ALL). Default is for the file to be removed if a file handle is
1317 #pod requested and to be kept if the filename is requested. In a scalar
1318 #pod context (where no filename is returned) the file is always deleted
1319 #pod either (depending on the operating system) on exit or when it is
1320 #pod closed (unless $KEEP_ALL is true when the temp file is created).
1321 #pod
1322 #pod Use the object-oriented interface if fine-grained control of when
1323 #pod a file is removed is required.
1324 #pod
1325 #pod If the template is not specified, a template is always
1326 #pod automatically generated. This temporary file is placed in tmpdir()
1327 #pod (L<File::Spec>) unless a directory is specified explicitly with the
1328 #pod DIR option.
1329 #pod
1330 #pod   $fh = tempfile( DIR => $dir );
1331 #pod
1332 #pod If called in scalar context, only the filehandle is returned and the
1333 #pod file will automatically be deleted when closed on operating systems
1334 #pod that support this (see the description of tmpfile() elsewhere in this
1335 #pod document).  This is the preferred mode of operation, as if you only
1336 #pod have a filehandle, you can never create a race condition by fumbling
1337 #pod with the filename. On systems that can not unlink an open file or can
1338 #pod not mark a file as temporary when it is opened (for example, Windows
1339 #pod NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
1340 #pod the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
1341 #pod flag is ignored if present.
1342 #pod
1343 #pod   (undef, $filename) = tempfile($template, OPEN => 0);
1344 #pod
1345 #pod This will return the filename based on the template but
1346 #pod will not open this file.  Cannot be used in conjunction with
1347 #pod UNLINK set to true. Default is to always open the file
1348 #pod to protect from possible race conditions. A warning is issued
1349 #pod if warnings are turned on. Consider using the tmpnam()
1350 #pod and mktemp() functions described elsewhere in this document
1351 #pod if opening the file is not required.
1352 #pod
1353 #pod If the operating system supports it (for example BSD derived systems), the 
1354 #pod filehandle will be opened with O_EXLOCK (open with exclusive file lock). 
1355 #pod This can sometimes cause problems if the intention is to pass the filename 
1356 #pod to another system that expects to take an exclusive lock itself (such as 
1357 #pod DBD::SQLite) whilst ensuring that the tempfile is not reused. In this 
1358 #pod situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK 
1359 #pod will be true (this retains compatibility with earlier releases).
1360 #pod
1361 #pod   ($fh, $filename) = tempfile($template, EXLOCK => 0);
1362 #pod
1363 #pod Options can be combined as required.
1364 #pod
1365 #pod Will croak() if there is an error.
1366 #pod
1367 #pod Available since 0.05.
1368 #pod
1369 #pod UNLINK flag available since 0.10.
1370 #pod
1371 #pod TMPDIR flag available since 0.19.
1372 #pod
1373 #pod EXLOCK flag available since 0.19.
1374 #pod
1375 #pod =cut
1376
1377 sub tempfile {
1378   if ( @_ && $_[0] eq 'File::Temp' ) {
1379       croak "'tempfile' can't be called as a method";
1380   }
1381   # Can not check for argument count since we can have any
1382   # number of args
1383
1384   # Default options
1385   my %options = (
1386                  "DIR"    => undef, # Directory prefix
1387                  "SUFFIX" => '',    # Template suffix
1388                  "UNLINK" => 0,     # Do not unlink file on exit
1389                  "OPEN"   => 1,     # Open file
1390                  "TMPDIR" => 0, # Place tempfile in tempdir if template specified
1391                  "EXLOCK" => 1, # Open file with O_EXLOCK
1392                 );
1393
1394   # Check to see whether we have an odd or even number of arguments
1395   my ($maybe_template, $args) = _parse_args(@_);
1396   my $template = @$maybe_template ? $maybe_template->[0] : undef;
1397
1398   # Read the options and merge with defaults
1399   %options = (%options, %$args);
1400
1401   # First decision is whether or not to open the file
1402   if (! $options{"OPEN"}) {
1403
1404     warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1405       if $^W;
1406
1407   }
1408
1409   if ($options{"DIR"} and $^O eq 'VMS') {
1410
1411     # on VMS turn []foo into [.foo] for concatenation
1412     $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1413   }
1414
1415   # Construct the template
1416
1417   # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1418   # functions or simply constructing a template and using _gettemp()
1419   # explicitly. Go for the latter
1420
1421   # First generate a template if not defined and prefix the directory
1422   # If no template must prefix the temp directory
1423   if (defined $template) {
1424     # End up with current directory if neither DIR not TMPDIR are set
1425     if ($options{"DIR"}) {
1426
1427       $template = File::Spec->catfile($options{"DIR"}, $template);
1428
1429     } elsif ($options{TMPDIR}) {
1430
1431       $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), $template );
1432
1433     }
1434
1435   } else {
1436
1437     if ($options{"DIR"}) {
1438
1439       $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1440
1441     } else {
1442
1443       $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), TEMPXXX);
1444
1445     }
1446
1447   }
1448
1449   # Now add a suffix
1450   $template .= $options{"SUFFIX"};
1451
1452   # Determine whether we should tell _gettemp to unlink the file
1453   # On unix this is irrelevant and can be worked out after the file is
1454   # opened (simply by unlinking the open filehandle). On Windows or VMS
1455   # we have to indicate temporary-ness when we open the file. In general
1456   # we only want a true temporary file if we are returning just the
1457   # filehandle - if the user wants the filename they probably do not
1458   # want the file to disappear as soon as they close it (which may be
1459   # important if they want a child process to use the file)
1460   # For this reason, tie unlink_on_close to the return context regardless
1461   # of OS.
1462   my $unlink_on_close = ( wantarray ? 0 : 1);
1463
1464   # Create the file
1465   my ($fh, $path, $errstr);
1466   croak "Error in tempfile() using template $template: $errstr"
1467     unless (($fh, $path) = _gettemp($template,
1468                                     "open" => $options{'OPEN'},
1469                                     "mkdir"=> 0 ,
1470                                     "unlink_on_close" => $unlink_on_close,
1471                                     "suffixlen" => length($options{'SUFFIX'}),
1472                                     "ErrStr" => \$errstr,
1473                                     "use_exlock" => $options{EXLOCK},
1474                                    ) );
1475
1476   # Set up an exit handler that can do whatever is right for the
1477   # system. This removes files at exit when requested explicitly or when
1478   # system is asked to unlink_on_close but is unable to do so because
1479   # of OS limitations.
1480   # The latter should be achieved by using a tied filehandle.
1481   # Do not check return status since this is all done with END blocks.
1482   _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1483
1484   # Return
1485   if (wantarray()) {
1486
1487     if ($options{'OPEN'}) {
1488       return ($fh, $path);
1489     } else {
1490       return (undef, $path);
1491     }
1492
1493   } else {
1494
1495     # Unlink the file. It is up to unlink0 to decide what to do with
1496     # this (whether to unlink now or to defer until later)
1497     unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1498
1499     # Return just the filehandle.
1500     return $fh;
1501   }
1502
1503
1504 }
1505
1506 # On Windows under taint mode, File::Spec could suggest "C:\" as a tempdir
1507 # which might not be writable.  If that is the case, we fallback to a
1508 # user directory.  See https://rt.cpan.org/Ticket/Display.html?id=60340
1509
1510 {
1511   my ($alt_tmpdir, $checked);
1512
1513   sub _wrap_file_spec_tmpdir {
1514     return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};
1515
1516     if ( $checked ) {
1517       return $alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir;
1518     }
1519
1520     # probe what File::Spec gives and find a fallback
1521     my $xxpath = _replace_XX( "X" x 10, 0 );
1522
1523     # First, see if File::Spec->tmpdir is writable
1524     my $tmpdir = File::Spec->tmpdir;
1525     my $testpath = File::Spec->catdir( $tmpdir, $xxpath );
1526     if (mkdir( $testpath, 0700) ) {
1527       $checked = 1;
1528       rmdir $testpath;
1529       return $tmpdir;
1530     }
1531
1532     # Next, see if CSIDL_LOCAL_APPDATA is writable
1533     require Win32;
1534     my $local_app = File::Spec->catdir(
1535       Win32::GetFolderPath( Win32::CSIDL_LOCAL_APPDATA() ), 'Temp'
1536     );
1537     $testpath = File::Spec->catdir( $local_app, $xxpath );
1538     if ( -e $local_app or mkdir( $local_app, 0700 ) ) {
1539       if (mkdir( $testpath, 0700) ) {
1540         $checked = 1;
1541         rmdir $testpath;
1542         return $alt_tmpdir = $local_app;
1543       }
1544     }
1545
1546     # Can't find something writable
1547     croak << "HERE";
1548 Couldn't find a writable temp directory in taint mode. Tried:
1549   $tmpdir
1550   $local_app
1551
1552 Try setting and untainting the TMPDIR environment variable.
1553 HERE
1554
1555   }
1556 }
1557
1558 #pod =item B<tempdir>
1559 #pod
1560 #pod This is the recommended interface for creation of temporary
1561 #pod directories.  By default the directory will not be removed on exit
1562 #pod (that is, it won't be temporary; this behaviour can not be changed
1563 #pod because of issues with backwards compatibility). To enable removal
1564 #pod either use the CLEANUP option which will trigger removal on program
1565 #pod exit, or consider using the "newdir" method in the object interface which
1566 #pod will allow the directory to be cleaned up when the object goes out of
1567 #pod scope.
1568 #pod
1569 #pod The behaviour of the function depends on the arguments:
1570 #pod
1571 #pod   $tempdir = tempdir();
1572 #pod
1573 #pod Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1574 #pod
1575 #pod   $tempdir = tempdir( $template );
1576 #pod
1577 #pod Create a directory from the supplied template. This template is
1578 #pod similar to that described for tempfile(). `X' characters at the end
1579 #pod of the template are replaced with random letters to construct the
1580 #pod directory name. At least four `X' characters must be in the template.
1581 #pod
1582 #pod   $tempdir = tempdir ( DIR => $dir );
1583 #pod
1584 #pod Specifies the directory to use for the temporary directory.
1585 #pod The temporary directory name is derived from an internal template.
1586 #pod
1587 #pod   $tempdir = tempdir ( $template, DIR => $dir );
1588 #pod
1589 #pod Prepend the supplied directory name to the template. The template
1590 #pod should not include parent directory specifications itself. Any parent
1591 #pod directory specifications are removed from the template before
1592 #pod prepending the supplied directory.
1593 #pod
1594 #pod   $tempdir = tempdir ( $template, TMPDIR => 1 );
1595 #pod
1596 #pod Using the supplied template, create the temporary directory in
1597 #pod a standard location for temporary files. Equivalent to doing
1598 #pod
1599 #pod   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1600 #pod
1601 #pod but shorter. Parent directory specifications are stripped from the
1602 #pod template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1603 #pod explicitly.  Additionally, C<TMPDIR> is implied if neither a template
1604 #pod nor a directory are supplied.
1605 #pod
1606 #pod   $tempdir = tempdir( $template, CLEANUP => 1);
1607 #pod
1608 #pod Create a temporary directory using the supplied template, but
1609 #pod attempt to remove it (and all files inside it) when the program
1610 #pod exits. Note that an attempt will be made to remove all files from
1611 #pod the directory even if they were not created by this module (otherwise
1612 #pod why ask to clean it up?). The directory removal is made with
1613 #pod the rmtree() function from the L<File::Path|File::Path> module.
1614 #pod Of course, if the template is not specified, the temporary directory
1615 #pod will be created in tmpdir() and will also be removed at program exit.
1616 #pod
1617 #pod Will croak() if there is an error.
1618 #pod
1619 #pod Current API available since 0.05.
1620 #pod
1621 #pod =cut
1622
1623 # '
1624
1625 sub tempdir  {
1626   if ( @_ && $_[0] eq 'File::Temp' ) {
1627       croak "'tempdir' can't be called as a method";
1628   }
1629
1630   # Can not check for argument count since we can have any
1631   # number of args
1632
1633   # Default options
1634   my %options = (
1635                  "CLEANUP"    => 0, # Remove directory on exit
1636                  "DIR"        => '', # Root directory
1637                  "TMPDIR"     => 0,  # Use tempdir with template
1638                 );
1639
1640   # Check to see whether we have an odd or even number of arguments
1641   my ($maybe_template, $args) = _parse_args(@_);
1642   my $template = @$maybe_template ? $maybe_template->[0] : undef;
1643
1644   # Read the options and merge with defaults
1645   %options = (%options, %$args);
1646
1647   # Modify or generate the template
1648
1649   # Deal with the DIR and TMPDIR options
1650   if (defined $template) {
1651
1652     # Need to strip directory path if using DIR or TMPDIR
1653     if ($options{'TMPDIR'} || $options{'DIR'}) {
1654
1655       # Strip parent directory from the filename
1656       #
1657       # There is no filename at the end
1658       $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1659       my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1660
1661       # Last directory is then our template
1662       $template = (File::Spec->splitdir($directories))[-1];
1663
1664       # Prepend the supplied directory or temp dir
1665       if ($options{"DIR"}) {
1666
1667         $template = File::Spec->catdir($options{"DIR"}, $template);
1668
1669       } elsif ($options{TMPDIR}) {
1670
1671         # Prepend tmpdir
1672         $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), $template);
1673
1674       }
1675
1676     }
1677
1678   } else {
1679
1680     if ($options{"DIR"}) {
1681
1682       $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1683
1684     } else {
1685
1686       $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), TEMPXXX);
1687
1688     }
1689
1690   }
1691
1692   # Create the directory
1693   my $tempdir;
1694   my $suffixlen = 0;
1695   if ($^O eq 'VMS') {           # dir names can end in delimiters
1696     $template =~ m/([\.\]:>]+)$/;
1697     $suffixlen = length($1);
1698   }
1699   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1700     # dir name has a trailing ':'
1701     ++$suffixlen;
1702   }
1703
1704   my $errstr;
1705   croak "Error in tempdir() using $template: $errstr"
1706     unless ((undef, $tempdir) = _gettemp($template,
1707                                          "open" => 0,
1708                                          "mkdir"=> 1 ,
1709                                          "suffixlen" => $suffixlen,
1710                                          "ErrStr" => \$errstr,
1711                                         ) );
1712
1713   # Install exit handler; must be dynamic to get lexical
1714   if ( $options{'CLEANUP'} && -d $tempdir) {
1715     _deferred_unlink(undef, $tempdir, 1);
1716   }
1717
1718   # Return the dir name
1719   return $tempdir;
1720
1721 }
1722
1723 #pod =back
1724 #pod
1725 #pod =head1 MKTEMP FUNCTIONS
1726 #pod
1727 #pod The following functions are Perl implementations of the
1728 #pod mktemp() family of temp file generation system calls.
1729 #pod
1730 #pod =over 4
1731 #pod
1732 #pod =item B<mkstemp>
1733 #pod
1734 #pod Given a template, returns a filehandle to the temporary file and the name
1735 #pod of the file.
1736 #pod
1737 #pod   ($fh, $name) = mkstemp( $template );
1738 #pod
1739 #pod In scalar context, just the filehandle is returned.
1740 #pod
1741 #pod The template may be any filename with some number of X's appended
1742 #pod to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1743 #pod with unique alphanumeric combinations.
1744 #pod
1745 #pod Will croak() if there is an error.
1746 #pod
1747 #pod Current API available since 0.05.
1748 #pod
1749 #pod =cut
1750
1751
1752
1753 sub mkstemp {
1754
1755   croak "Usage: mkstemp(template)"
1756     if scalar(@_) != 1;
1757
1758   my $template = shift;
1759
1760   my ($fh, $path, $errstr);
1761   croak "Error in mkstemp using $template: $errstr"
1762     unless (($fh, $path) = _gettemp($template,
1763                                     "open" => 1,
1764                                     "mkdir"=> 0 ,
1765                                     "suffixlen" => 0,
1766                                     "ErrStr" => \$errstr,
1767                                    ) );
1768
1769   if (wantarray()) {
1770     return ($fh, $path);
1771   } else {
1772     return $fh;
1773   }
1774
1775 }
1776
1777
1778 #pod =item B<mkstemps>
1779 #pod
1780 #pod Similar to mkstemp(), except that an extra argument can be supplied
1781 #pod with a suffix to be appended to the template.
1782 #pod
1783 #pod   ($fh, $name) = mkstemps( $template, $suffix );
1784 #pod
1785 #pod For example a template of C<testXXXXXX> and suffix of C<.dat>
1786 #pod would generate a file similar to F<testhGji_w.dat>.
1787 #pod
1788 #pod Returns just the filehandle alone when called in scalar context.
1789 #pod
1790 #pod Will croak() if there is an error.
1791 #pod
1792 #pod Current API available since 0.05.
1793 #pod
1794 #pod =cut
1795
1796 sub mkstemps {
1797
1798   croak "Usage: mkstemps(template, suffix)"
1799     if scalar(@_) != 2;
1800
1801
1802   my $template = shift;
1803   my $suffix   = shift;
1804
1805   $template .= $suffix;
1806
1807   my ($fh, $path, $errstr);
1808   croak "Error in mkstemps using $template: $errstr"
1809     unless (($fh, $path) = _gettemp($template,
1810                                     "open" => 1,
1811                                     "mkdir"=> 0 ,
1812                                     "suffixlen" => length($suffix),
1813                                     "ErrStr" => \$errstr,
1814                                    ) );
1815
1816   if (wantarray()) {
1817     return ($fh, $path);
1818   } else {
1819     return $fh;
1820   }
1821
1822 }
1823
1824 #pod =item B<mkdtemp>
1825 #pod
1826 #pod Create a directory from a template. The template must end in
1827 #pod X's that are replaced by the routine.
1828 #pod
1829 #pod   $tmpdir_name = mkdtemp($template);
1830 #pod
1831 #pod Returns the name of the temporary directory created.
1832 #pod
1833 #pod Directory must be removed by the caller.
1834 #pod
1835 #pod Will croak() if there is an error.
1836 #pod
1837 #pod Current API available since 0.05.
1838 #pod
1839 #pod =cut
1840
1841 #' # for emacs
1842
1843 sub mkdtemp {
1844
1845   croak "Usage: mkdtemp(template)"
1846     if scalar(@_) != 1;
1847
1848   my $template = shift;
1849   my $suffixlen = 0;
1850   if ($^O eq 'VMS') {           # dir names can end in delimiters
1851     $template =~ m/([\.\]:>]+)$/;
1852     $suffixlen = length($1);
1853   }
1854   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1855     # dir name has a trailing ':'
1856     ++$suffixlen;
1857   }
1858   my ($junk, $tmpdir, $errstr);
1859   croak "Error creating temp directory from template $template\: $errstr"
1860     unless (($junk, $tmpdir) = _gettemp($template,
1861                                         "open" => 0,
1862                                         "mkdir"=> 1 ,
1863                                         "suffixlen" => $suffixlen,
1864                                         "ErrStr" => \$errstr,
1865                                        ) );
1866
1867   return $tmpdir;
1868
1869 }
1870
1871 #pod =item B<mktemp>
1872 #pod
1873 #pod Returns a valid temporary filename but does not guarantee
1874 #pod that the file will not be opened by someone else.
1875 #pod
1876 #pod   $unopened_file = mktemp($template);
1877 #pod
1878 #pod Template is the same as that required by mkstemp().
1879 #pod
1880 #pod Will croak() if there is an error.
1881 #pod
1882 #pod Current API available since 0.05.
1883 #pod
1884 #pod =cut
1885
1886 sub mktemp {
1887
1888   croak "Usage: mktemp(template)"
1889     if scalar(@_) != 1;
1890
1891   my $template = shift;
1892
1893   my ($tmpname, $junk, $errstr);
1894   croak "Error getting name to temp file from template $template: $errstr"
1895     unless (($junk, $tmpname) = _gettemp($template,
1896                                          "open" => 0,
1897                                          "mkdir"=> 0 ,
1898                                          "suffixlen" => 0,
1899                                          "ErrStr" => \$errstr,
1900                                         ) );
1901
1902   return $tmpname;
1903 }
1904
1905 #pod =back
1906 #pod
1907 #pod =head1 POSIX FUNCTIONS
1908 #pod
1909 #pod This section describes the re-implementation of the tmpnam()
1910 #pod and tmpfile() functions described in L<POSIX>
1911 #pod using the mkstemp() from this module.
1912 #pod
1913 #pod Unlike the L<POSIX|POSIX> implementations, the directory used
1914 #pod for the temporary file is not specified in a system include
1915 #pod file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1916 #pod returned by L<File::Spec|File::Spec>. On some implementations this
1917 #pod location can be set using the C<TMPDIR> environment variable, which
1918 #pod may not be secure.
1919 #pod If this is a problem, simply use mkstemp() and specify a template.
1920 #pod
1921 #pod =over 4
1922 #pod
1923 #pod =item B<tmpnam>
1924 #pod
1925 #pod When called in scalar context, returns the full name (including path)
1926 #pod of a temporary file (uses mktemp()). The only check is that the file does
1927 #pod not already exist, but there is no guarantee that that condition will
1928 #pod continue to apply.
1929 #pod
1930 #pod   $file = tmpnam();
1931 #pod
1932 #pod When called in list context, a filehandle to the open file and
1933 #pod a filename are returned. This is achieved by calling mkstemp()
1934 #pod after constructing a suitable template.
1935 #pod
1936 #pod   ($fh, $file) = tmpnam();
1937 #pod
1938 #pod If possible, this form should be used to prevent possible
1939 #pod race conditions.
1940 #pod
1941 #pod See L<File::Spec/tmpdir> for information on the choice of temporary
1942 #pod directory for a particular operating system.
1943 #pod
1944 #pod Will croak() if there is an error.
1945 #pod
1946 #pod Current API available since 0.05.
1947 #pod
1948 #pod =cut
1949
1950 sub tmpnam {
1951
1952   # Retrieve the temporary directory name
1953   my $tmpdir = _wrap_file_spec_tmpdir();
1954
1955   # XXX I don't know under what circumstances this occurs, -- xdg 2016-04-02
1956   croak "Error temporary directory is not writable"
1957     if $tmpdir eq '';
1958
1959   # Use a ten character template and append to tmpdir
1960   my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1961
1962   if (wantarray() ) {
1963     return mkstemp($template);
1964   } else {
1965     return mktemp($template);
1966   }
1967
1968 }
1969
1970 #pod =item B<tmpfile>
1971 #pod
1972 #pod Returns the filehandle of a temporary file.
1973 #pod
1974 #pod   $fh = tmpfile();
1975 #pod
1976 #pod The file is removed when the filehandle is closed or when the program
1977 #pod exits. No access to the filename is provided.
1978 #pod
1979 #pod If the temporary file can not be created undef is returned.
1980 #pod Currently this command will probably not work when the temporary
1981 #pod directory is on an NFS file system.
1982 #pod
1983 #pod Will croak() if there is an error.
1984 #pod
1985 #pod Available since 0.05.
1986 #pod
1987 #pod Returning undef if unable to create file added in 0.12.
1988 #pod
1989 #pod =cut
1990
1991 sub tmpfile {
1992
1993   # Simply call tmpnam() in a list context
1994   my ($fh, $file) = tmpnam();
1995
1996   # Make sure file is removed when filehandle is closed
1997   # This will fail on NFS
1998   unlink0($fh, $file)
1999     or return undef;
2000
2001   return $fh;
2002
2003 }
2004
2005 #pod =back
2006 #pod
2007 #pod =head1 ADDITIONAL FUNCTIONS
2008 #pod
2009 #pod These functions are provided for backwards compatibility
2010 #pod with common tempfile generation C library functions.
2011 #pod
2012 #pod They are not exported and must be addressed using the full package
2013 #pod name.
2014 #pod
2015 #pod =over 4
2016 #pod
2017 #pod =item B<tempnam>
2018 #pod
2019 #pod Return the name of a temporary file in the specified directory
2020 #pod using a prefix. The file is guaranteed not to exist at the time
2021 #pod the function was called, but such guarantees are good for one
2022 #pod clock tick only.  Always use the proper form of C<sysopen>
2023 #pod with C<O_CREAT | O_EXCL> if you must open such a filename.
2024 #pod
2025 #pod   $filename = File::Temp::tempnam( $dir, $prefix );
2026 #pod
2027 #pod Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
2028 #pod (using unix file convention as an example)
2029 #pod
2030 #pod Because this function uses mktemp(), it can suffer from race conditions.
2031 #pod
2032 #pod Will croak() if there is an error.
2033 #pod
2034 #pod Current API available since 0.05.
2035 #pod
2036 #pod =cut
2037
2038 sub tempnam {
2039
2040   croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
2041
2042   my ($dir, $prefix) = @_;
2043
2044   # Add a string to the prefix
2045   $prefix .= 'XXXXXXXX';
2046
2047   # Concatenate the directory to the file
2048   my $template = File::Spec->catfile($dir, $prefix);
2049
2050   return mktemp($template);
2051
2052 }
2053
2054 #pod =back
2055 #pod
2056 #pod =head1 UTILITY FUNCTIONS
2057 #pod
2058 #pod Useful functions for dealing with the filehandle and filename.
2059 #pod
2060 #pod =over 4
2061 #pod
2062 #pod =item B<unlink0>
2063 #pod
2064 #pod Given an open filehandle and the associated filename, make a safe
2065 #pod unlink. This is achieved by first checking that the filename and
2066 #pod filehandle initially point to the same file and that the number of
2067 #pod links to the file is 1 (all fields returned by stat() are compared).
2068 #pod Then the filename is unlinked and the filehandle checked once again to
2069 #pod verify that the number of links on that file is now 0.  This is the
2070 #pod closest you can come to making sure that the filename unlinked was the
2071 #pod same as the file whose descriptor you hold.
2072 #pod
2073 #pod   unlink0($fh, $path)
2074 #pod      or die "Error unlinking file $path safely";
2075 #pod
2076 #pod Returns false on error but croaks() if there is a security
2077 #pod anomaly. The filehandle is not closed since on some occasions this is
2078 #pod not required.
2079 #pod
2080 #pod On some platforms, for example Windows NT, it is not possible to
2081 #pod unlink an open file (the file must be closed first). On those
2082 #pod platforms, the actual unlinking is deferred until the program ends and
2083 #pod good status is returned. A check is still performed to make sure that
2084 #pod the filehandle and filename are pointing to the same thing (but not at
2085 #pod the time the end block is executed since the deferred removal may not
2086 #pod have access to the filehandle).
2087 #pod
2088 #pod Additionally, on Windows NT not all the fields returned by stat() can
2089 #pod be compared. For example, the C<dev> and C<rdev> fields seem to be
2090 #pod different.  Also, it seems that the size of the file returned by stat()
2091 #pod does not always agree, with C<stat(FH)> being more accurate than
2092 #pod C<stat(filename)>, presumably because of caching issues even when
2093 #pod using autoflush (this is usually overcome by waiting a while after
2094 #pod writing to the tempfile before attempting to C<unlink0> it).
2095 #pod
2096 #pod Finally, on NFS file systems the link count of the file handle does
2097 #pod not always go to zero immediately after unlinking. Currently, this
2098 #pod command is expected to fail on NFS disks.
2099 #pod
2100 #pod This function is disabled if the global variable $KEEP_ALL is true
2101 #pod and an unlink on open file is supported. If the unlink is to be deferred
2102 #pod to the END block, the file is still registered for removal.
2103 #pod
2104 #pod This function should not be called if you are using the object oriented
2105 #pod interface since the it will interfere with the object destructor deleting
2106 #pod the file.
2107 #pod
2108 #pod Available Since 0.05.
2109 #pod
2110 #pod If can not unlink open file, defer removal until later available since 0.06.
2111 #pod
2112 #pod =cut
2113
2114 sub unlink0 {
2115
2116   croak 'Usage: unlink0(filehandle, filename)'
2117     unless scalar(@_) == 2;
2118
2119   # Read args
2120   my ($fh, $path) = @_;
2121
2122   cmpstat($fh, $path) or return 0;
2123
2124   # attempt remove the file (does not work on some platforms)
2125   if (_can_unlink_opened_file()) {
2126
2127     # return early (Without unlink) if we have been instructed to retain files.
2128     return 1 if $KEEP_ALL;
2129
2130     # XXX: do *not* call this on a directory; possible race
2131     #      resulting in recursive removal
2132     croak "unlink0: $path has become a directory!" if -d $path;
2133     unlink($path) or return 0;
2134
2135     # Stat the filehandle
2136     my @fh = stat $fh;
2137
2138     print "Link count = $fh[3] \n" if $DEBUG;
2139
2140     # Make sure that the link count is zero
2141     # - Cygwin provides deferred unlinking, however,
2142     #   on Win9x the link count remains 1
2143     # On NFS the link count may still be 1 but we can't know that
2144     # we are on NFS.  Since we can't be sure, we'll defer it
2145
2146     return 1 if $fh[3] == 0 || $^O eq 'cygwin';
2147   }
2148   # fall-through if we can't unlink now
2149   _deferred_unlink($fh, $path, 0);
2150   return 1;
2151 }
2152
2153 #pod =item B<cmpstat>
2154 #pod
2155 #pod Compare C<stat> of filehandle with C<stat> of provided filename.  This
2156 #pod can be used to check that the filename and filehandle initially point
2157 #pod to the same file and that the number of links to the file is 1 (all
2158 #pod fields returned by stat() are compared).
2159 #pod
2160 #pod   cmpstat($fh, $path)
2161 #pod      or die "Error comparing handle with file";
2162 #pod
2163 #pod Returns false if the stat information differs or if the link count is
2164 #pod greater than 1. Calls croak if there is a security anomaly.
2165 #pod
2166 #pod On certain platforms, for example Windows, not all the fields returned by stat()
2167 #pod can be compared. For example, the C<dev> and C<rdev> fields seem to be
2168 #pod different in Windows.  Also, it seems that the size of the file
2169 #pod returned by stat() does not always agree, with C<stat(FH)> being more
2170 #pod accurate than C<stat(filename)>, presumably because of caching issues
2171 #pod even when using autoflush (this is usually overcome by waiting a while
2172 #pod after writing to the tempfile before attempting to C<unlink0> it).
2173 #pod
2174 #pod Not exported by default.
2175 #pod
2176 #pod Current API available since 0.14.
2177 #pod
2178 #pod =cut
2179
2180 sub cmpstat {
2181
2182   croak 'Usage: cmpstat(filehandle, filename)'
2183     unless scalar(@_) == 2;
2184
2185   # Read args
2186   my ($fh, $path) = @_;
2187
2188   warn "Comparing stat\n"
2189     if $DEBUG;
2190
2191   # Stat the filehandle - which may be closed if someone has manually
2192   # closed the file. Can not turn off warnings without using $^W
2193   # unless we upgrade to 5.006 minimum requirement
2194   my @fh;
2195   {
2196     local ($^W) = 0;
2197     @fh = stat $fh;
2198   }
2199   return unless @fh;
2200
2201   if ($fh[3] > 1 && $^W) {
2202     carp "unlink0: fstat found too many links; SB=@fh" if $^W;
2203   }
2204
2205   # Stat the path
2206   my @path = stat $path;
2207
2208   unless (@path) {
2209     carp "unlink0: $path is gone already" if $^W;
2210     return;
2211   }
2212
2213   # this is no longer a file, but may be a directory, or worse
2214   unless (-f $path) {
2215     confess "panic: $path is no longer a file: SB=@fh";
2216   }
2217
2218   # Do comparison of each member of the array
2219   # On WinNT dev and rdev seem to be different
2220   # depending on whether it is a file or a handle.
2221   # Cannot simply compare all members of the stat return
2222   # Select the ones we can use
2223   my @okstat = (0..$#fh);       # Use all by default
2224   if ($^O eq 'MSWin32') {
2225     @okstat = (1,2,3,4,5,7,8,9,10);
2226   } elsif ($^O eq 'os2') {
2227     @okstat = (0, 2..$#fh);
2228   } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
2229     @okstat = (0, 1);
2230   } elsif ($^O eq 'dos') {
2231     @okstat = (0,2..7,11..$#fh);
2232   } elsif ($^O eq 'mpeix') {
2233     @okstat = (0..4,8..10);
2234   }
2235
2236   # Now compare each entry explicitly by number
2237   for (@okstat) {
2238     print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
2239     # Use eq rather than == since rdev, blksize, and blocks (6, 11,
2240     # and 12) will be '' on platforms that do not support them.  This
2241     # is fine since we are only comparing integers.
2242     unless ($fh[$_] eq $path[$_]) {
2243       warn "Did not match $_ element of stat\n" if $DEBUG;
2244       return 0;
2245     }
2246   }
2247
2248   return 1;
2249 }
2250
2251 #pod =item B<unlink1>
2252 #pod
2253 #pod Similar to C<unlink0> except after file comparison using cmpstat, the
2254 #pod filehandle is closed prior to attempting to unlink the file. This
2255 #pod allows the file to be removed without using an END block, but does
2256 #pod mean that the post-unlink comparison of the filehandle state provided
2257 #pod by C<unlink0> is not available.
2258 #pod
2259 #pod   unlink1($fh, $path)
2260 #pod      or die "Error closing and unlinking file";
2261 #pod
2262 #pod Usually called from the object destructor when using the OO interface.
2263 #pod
2264 #pod Not exported by default.
2265 #pod
2266 #pod This function is disabled if the global variable $KEEP_ALL is true.
2267 #pod
2268 #pod Can call croak() if there is a security anomaly during the stat()
2269 #pod comparison.
2270 #pod
2271 #pod Current API available since 0.14.
2272 #pod
2273 #pod =cut
2274
2275 sub unlink1 {
2276   croak 'Usage: unlink1(filehandle, filename)'
2277     unless scalar(@_) == 2;
2278
2279   # Read args
2280   my ($fh, $path) = @_;
2281
2282   cmpstat($fh, $path) or return 0;
2283
2284   # Close the file
2285   close( $fh ) or return 0;
2286
2287   # Make sure the file is writable (for windows)
2288   _force_writable( $path );
2289
2290   # return early (without unlink) if we have been instructed to retain files.
2291   return 1 if $KEEP_ALL;
2292
2293   # remove the file
2294   return unlink($path);
2295 }
2296
2297 #pod =item B<cleanup>
2298 #pod
2299 #pod Calling this function will cause any temp files or temp directories
2300 #pod that are registered for removal to be removed. This happens automatically
2301 #pod when the process exits but can be triggered manually if the caller is sure
2302 #pod that none of the temp files are required. This method can be registered as
2303 #pod an Apache callback.
2304 #pod
2305 #pod Note that if a temp directory is your current directory, it cannot be
2306 #pod removed.  C<chdir()> out of the directory first before calling
2307 #pod C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
2308 #pod is set, this happens automatically.)
2309 #pod
2310 #pod On OSes where temp files are automatically removed when the temp file
2311 #pod is closed, calling this function will have no effect other than to remove
2312 #pod temporary directories (which may include temporary files).
2313 #pod
2314 #pod   File::Temp::cleanup();
2315 #pod
2316 #pod Not exported by default.
2317 #pod
2318 #pod Current API available since 0.15.
2319 #pod
2320 #pod =back
2321 #pod
2322 #pod =head1 PACKAGE VARIABLES
2323 #pod
2324 #pod These functions control the global state of the package.
2325 #pod
2326 #pod =over 4
2327 #pod
2328 #pod =item B<safe_level>
2329 #pod
2330 #pod Controls the lengths to which the module will go to check the safety of the
2331 #pod temporary file or directory before proceeding.
2332 #pod Options are:
2333 #pod
2334 #pod =over 8
2335 #pod
2336 #pod =item STANDARD
2337 #pod
2338 #pod Do the basic security measures to ensure the directory exists and is
2339 #pod writable, that temporary files are opened only if they do not already
2340 #pod exist, and that possible race conditions are avoided.  Finally the
2341 #pod L<unlink0|"unlink0"> function is used to remove files safely.
2342 #pod
2343 #pod =item MEDIUM
2344 #pod
2345 #pod In addition to the STANDARD security, the output directory is checked
2346 #pod to make sure that it is owned either by root or the user running the
2347 #pod program. If the directory is writable by group or by other, it is then
2348 #pod checked to make sure that the sticky bit is set.
2349 #pod
2350 #pod Will not work on platforms that do not support the C<-k> test
2351 #pod for sticky bit.
2352 #pod
2353 #pod =item HIGH
2354 #pod
2355 #pod In addition to the MEDIUM security checks, also check for the
2356 #pod possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2357 #pod sysconf() function. If this is a possibility, each directory in the
2358 #pod path is checked in turn for safeness, recursively walking back to the
2359 #pod root directory.
2360 #pod
2361 #pod For platforms that do not support the L<POSIX|POSIX>
2362 #pod C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2363 #pod assumed that ``chown() giveaway'' is possible and the recursive test
2364 #pod is performed.
2365 #pod
2366 #pod =back
2367 #pod
2368 #pod The level can be changed as follows:
2369 #pod
2370 #pod   File::Temp->safe_level( File::Temp::HIGH );
2371 #pod
2372 #pod The level constants are not exported by the module.
2373 #pod
2374 #pod Currently, you must be running at least perl v5.6.0 in order to
2375 #pod run with MEDIUM or HIGH security. This is simply because the
2376 #pod safety tests use functions from L<Fcntl|Fcntl> that are not
2377 #pod available in older versions of perl. The problem is that the version
2378 #pod number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2379 #pod they are different versions.
2380 #pod
2381 #pod On systems that do not support the HIGH or MEDIUM safety levels
2382 #pod (for example Win NT or OS/2) any attempt to change the level will
2383 #pod be ignored. The decision to ignore rather than raise an exception
2384 #pod allows portable programs to be written with high security in mind
2385 #pod for the systems that can support this without those programs failing
2386 #pod on systems where the extra tests are irrelevant.
2387 #pod
2388 #pod If you really need to see whether the change has been accepted
2389 #pod simply examine the return value of C<safe_level>.
2390 #pod
2391 #pod   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2392 #pod   die "Could not change to high security"
2393 #pod       if $newlevel != File::Temp::HIGH;
2394 #pod
2395 #pod Available since 0.05.
2396 #pod
2397 #pod =cut
2398
2399 {
2400   # protect from using the variable itself
2401   my $LEVEL = STANDARD;
2402   sub safe_level {
2403     my $self = shift;
2404     if (@_) {
2405       my $level = shift;
2406       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2407         carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2408       } else {
2409         # Don't allow this on perl 5.005 or earlier
2410         if ($] < 5.006 && $level != STANDARD) {
2411           # Cant do MEDIUM or HIGH checks
2412           croak "Currently requires perl 5.006 or newer to do the safe checks";
2413         }
2414         # Check that we are allowed to change level
2415         # Silently ignore if we can not.
2416         $LEVEL = $level if _can_do_level($level);
2417       }
2418     }
2419     return $LEVEL;
2420   }
2421 }
2422
2423 #pod =item TopSystemUID
2424 #pod
2425 #pod This is the highest UID on the current system that refers to a root
2426 #pod UID. This is used to make sure that the temporary directory is
2427 #pod owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2428 #pod simply by root.
2429 #pod
2430 #pod This is required since on many unix systems C</tmp> is not owned
2431 #pod by root.
2432 #pod
2433 #pod Default is to assume that any UID less than or equal to 10 is a root
2434 #pod UID.
2435 #pod
2436 #pod   File::Temp->top_system_uid(10);
2437 #pod   my $topid = File::Temp->top_system_uid;
2438 #pod
2439 #pod This value can be adjusted to reduce security checking if required.
2440 #pod The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2441 #pod
2442 #pod Available since 0.05.
2443 #pod
2444 #pod =cut
2445
2446 {
2447   my $TopSystemUID = 10;
2448   $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2449   sub top_system_uid {
2450     my $self = shift;
2451     if (@_) {
2452       my $newuid = shift;
2453       croak "top_system_uid: UIDs should be numeric"
2454         unless $newuid =~ /^\d+$/s;
2455       $TopSystemUID = $newuid;
2456     }
2457     return $TopSystemUID;
2458   }
2459 }
2460
2461 #pod =item B<$KEEP_ALL>
2462 #pod
2463 #pod Controls whether temporary files and directories should be retained
2464 #pod regardless of any instructions in the program to remove them
2465 #pod automatically.  This is useful for debugging but should not be used in
2466 #pod production code.
2467 #pod
2468 #pod   $File::Temp::KEEP_ALL = 1;
2469 #pod
2470 #pod Default is for files to be removed as requested by the caller.
2471 #pod
2472 #pod In some cases, files will only be retained if this variable is true
2473 #pod when the file is created. This means that you can not create a temporary
2474 #pod file, set this variable and expect the temp file to still be around
2475 #pod when the program exits.
2476 #pod
2477 #pod =item B<$DEBUG>
2478 #pod
2479 #pod Controls whether debugging messages should be enabled.
2480 #pod
2481 #pod   $File::Temp::DEBUG = 1;
2482 #pod
2483 #pod Default is for debugging mode to be disabled.
2484 #pod
2485 #pod Available since 0.15.
2486 #pod
2487 #pod =back
2488 #pod
2489 #pod =head1 WARNING
2490 #pod
2491 #pod For maximum security, endeavour always to avoid ever looking at,
2492 #pod touching, or even imputing the existence of the filename.  You do not
2493 #pod know that that filename is connected to the same file as the handle
2494 #pod you have, and attempts to check this can only trigger more race
2495 #pod conditions.  It's far more secure to use the filehandle alone and
2496 #pod dispense with the filename altogether.
2497 #pod
2498 #pod If you need to pass the handle to something that expects a filename
2499 #pod then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
2500 #pod arbitrary programs. Perl code that uses the 2-argument version of
2501 #pod C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
2502 #pod will need to pass the filename. You will have to clear the
2503 #pod close-on-exec bit on that file descriptor before passing it to another
2504 #pod process.
2505 #pod
2506 #pod     use Fcntl qw/F_SETFD F_GETFD/;
2507 #pod     fcntl($tmpfh, F_SETFD, 0)
2508 #pod         or die "Can't clear close-on-exec flag on temp fh: $!\n";
2509 #pod
2510 #pod =head2 Temporary files and NFS
2511 #pod
2512 #pod Some problems are associated with using temporary files that reside
2513 #pod on NFS file systems and it is recommended that a local filesystem
2514 #pod is used whenever possible. Some of the security tests will most probably
2515 #pod fail when the temp file is not local. Additionally, be aware that
2516 #pod the performance of I/O operations over NFS will not be as good as for
2517 #pod a local disk.
2518 #pod
2519 #pod =head2 Forking
2520 #pod
2521 #pod In some cases files created by File::Temp are removed from within an
2522 #pod END block. Since END blocks are triggered when a child process exits
2523 #pod (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2524 #pod to only remove those temp files created by a particular process ID. This
2525 #pod means that a child will not attempt to remove temp files created by the
2526 #pod parent process.
2527 #pod
2528 #pod If you are forking many processes in parallel that are all creating
2529 #pod temporary files, you may need to reset the random number seed using
2530 #pod srand(EXPR) in each child else all the children will attempt to walk
2531 #pod through the same set of random file names and may well cause
2532 #pod themselves to give up if they exceed the number of retry attempts.
2533 #pod
2534 #pod =head2 Directory removal
2535 #pod
2536 #pod Note that if you have chdir'ed into the temporary directory and it is
2537 #pod subsequently cleaned up (either in the END block or as part of object
2538 #pod destruction), then you will get a warning from File::Path::rmtree().
2539 #pod
2540 #pod =head2 Taint mode
2541 #pod
2542 #pod If you need to run code under taint mode, updating to the latest
2543 #pod L<File::Spec> is highly recommended.  On Windows, if the directory
2544 #pod given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
2545 #pod to fallback to the user's local application data directory or croak
2546 #pod with an error.
2547 #pod
2548 #pod =head2 BINMODE
2549 #pod
2550 #pod The file returned by File::Temp will have been opened in binary mode
2551 #pod if such a mode is available. If that is not correct, use the C<binmode()>
2552 #pod function to change the mode of the filehandle.
2553 #pod
2554 #pod Note that you can modify the encoding of a file opened by File::Temp
2555 #pod also by using C<binmode()>.
2556 #pod
2557 #pod =head1 HISTORY
2558 #pod
2559 #pod Originally began life in May 1999 as an XS interface to the system
2560 #pod mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2561 #pod translated to Perl for total control of the code's
2562 #pod security checking, to ensure the presence of the function regardless of
2563 #pod operating system and to help with portability. The module was shipped
2564 #pod as a standard part of perl from v5.6.1.
2565 #pod
2566 #pod Thanks to Tom Christiansen for suggesting that this module
2567 #pod should be written and providing ideas for code improvements and
2568 #pod security enhancements.
2569 #pod
2570 #pod =head1 SEE ALSO
2571 #pod
2572 #pod L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2573 #pod
2574 #pod See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
2575 #pod different implementations of temporary file handling.
2576 #pod
2577 #pod See L<File::Tempdir> for an alternative object-oriented wrapper for
2578 #pod the C<tempdir> function.
2579 #pod
2580 #pod =cut
2581
2582 package File::Temp::Dir; # git description: v0.2305-8-g4787a5d
2583
2584 our $VERSION = '0.2306';
2585
2586 use File::Path qw/ rmtree /;
2587 use strict;
2588 use overload '""' => "STRINGIFY",
2589   '0+' => \&File::Temp::NUMIFY,
2590   fallback => 1;
2591
2592 # private class specifically to support tempdir objects
2593 # created by File::Temp->newdir
2594
2595 # ostensibly the same method interface as File::Temp but without
2596 # inheriting all the IO::Seekable methods and other cruft
2597
2598 # Read-only - returns the name of the temp directory
2599
2600 sub dirname {
2601   my $self = shift;
2602   return $self->{DIRNAME};
2603 }
2604
2605 sub STRINGIFY {
2606   my $self = shift;
2607   return $self->dirname;
2608 }
2609
2610 sub unlink_on_destroy {
2611   my $self = shift;
2612   if (@_) {
2613     $self->{CLEANUP} = shift;
2614   }
2615   return $self->{CLEANUP};
2616 }
2617
2618 sub DESTROY {
2619   my $self = shift;
2620   local($., $@, $!, $^E, $?);
2621   if ($self->unlink_on_destroy && 
2622       $$ == $self->{LAUNCHPID} && !$File::Temp::KEEP_ALL) {
2623     if (-d $self->{REALNAME}) {
2624       # Some versions of rmtree will abort if you attempt to remove
2625       # the directory you are sitting in. We protect that and turn it
2626       # into a warning. We do this because this occurs during object
2627       # destruction and so can not be caught by the user.
2628       eval { rmtree($self->{REALNAME}, $File::Temp::DEBUG, 0); };
2629       warn $@ if ($@ && $^W);
2630     }
2631   }
2632 }
2633
2634 1;
2635
2636
2637 # vim: ts=2 sts=2 sw=2 et:
2638
2639 __END__
2640
2641 =pod
2642
2643 =encoding UTF-8
2644
2645 =head1 NAME
2646
2647 File::Temp - return name and handle of a temporary file safely
2648
2649 =head1 VERSION
2650
2651 version 0.2306
2652
2653 =head1 SYNOPSIS
2654
2655   use File::Temp qw/ tempfile tempdir /;
2656
2657   $fh = tempfile();
2658   ($fh, $filename) = tempfile();
2659
2660   ($fh, $filename) = tempfile( $template, DIR => $dir);
2661   ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
2662   ($fh, $filename) = tempfile( $template, TMPDIR => 1 );
2663
2664   binmode( $fh, ":utf8" );
2665
2666   $dir = tempdir( CLEANUP => 1 );
2667   ($fh, $filename) = tempfile( DIR => $dir );
2668
2669 Object interface:
2670
2671   require File::Temp;
2672   use File::Temp ();
2673   use File::Temp qw/ :seekable /;
2674
2675   $fh = File::Temp->new();
2676   $fname = $fh->filename;
2677
2678   $fh = File::Temp->new(TEMPLATE => $template);
2679   $fname = $fh->filename;
2680
2681   $tmp = File::Temp->new( UNLINK => 0, SUFFIX => '.dat' );
2682   print $tmp "Some data\n";
2683   print "Filename is $tmp\n";
2684   $tmp->seek( 0, SEEK_END );
2685
2686   $dir = File::Temp->newdir(); # CLEANUP => 1 by default
2687
2688 The following interfaces are provided for compatibility with
2689 existing APIs. They should not be used in new code.
2690
2691 MkTemp family:
2692
2693   use File::Temp qw/ :mktemp  /;
2694
2695   ($fh, $file) = mkstemp( "tmpfileXXXXX" );
2696   ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
2697
2698   $tmpdir = mkdtemp( $template );
2699
2700   $unopened_file = mktemp( $template );
2701
2702 POSIX functions:
2703
2704   use File::Temp qw/ :POSIX /;
2705
2706   $file = tmpnam();
2707   $fh = tmpfile();
2708
2709   ($fh, $file) = tmpnam();
2710
2711 Compatibility functions:
2712
2713   $unopened_file = File::Temp::tempnam( $dir, $pfx );
2714
2715 =head1 DESCRIPTION
2716
2717 C<File::Temp> can be used to create and open temporary files in a safe
2718 way.  There is both a function interface and an object-oriented
2719 interface.  The File::Temp constructor or the tempfile() function can
2720 be used to return the name and the open filehandle of a temporary
2721 file.  The tempdir() function can be used to create a temporary
2722 directory.
2723
2724 The security aspect of temporary file creation is emphasized such that
2725 a filehandle and filename are returned together.  This helps guarantee
2726 that a race condition can not occur where the temporary file is
2727 created by another process between checking for the existence of the
2728 file and its opening.  Additional security levels are provided to
2729 check, for example, that the sticky bit is set on world writable
2730 directories.  See L<"safe_level"> for more information.
2731
2732 For compatibility with popular C library functions, Perl implementations of
2733 the mkstemp() family of functions are provided. These are, mkstemp(),
2734 mkstemps(), mkdtemp() and mktemp().
2735
2736 Additionally, implementations of the standard L<POSIX|POSIX>
2737 tmpnam() and tmpfile() functions are provided if required.
2738
2739 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
2740 but should be used with caution since they return only a filename
2741 that was valid when function was called, so cannot guarantee
2742 that the file will not exist by the time the caller opens the filename.
2743
2744 Filehandles returned by these functions support the seekable methods.
2745
2746 =begin __INTERNALS
2747
2748 =head1 PORTABILITY
2749
2750 This section is at the top in order to provide easier access to
2751 porters.  It is not expected to be rendered by a standard pod
2752 formatting tool. Please skip straight to the SYNOPSIS section if you
2753 are not trying to port this module to a new platform.
2754
2755 This module is designed to be portable across operating systems and it
2756 currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
2757 (Classic). When porting to a new OS there are generally three main
2758 issues that have to be solved:
2759 =over 4
2760
2761 =item *
2762
2763 Can the OS unlink an open file? If it can not then the
2764 C<_can_unlink_opened_file> method should be modified.
2765
2766 =item *
2767
2768 Are the return values from C<stat> reliable? By default all the
2769 return values from C<stat> are compared when unlinking a temporary
2770 file using the filename and the handle. Operating systems other than
2771 unix do not always have valid entries in all fields. If utility function
2772 C<File::Temp::unlink0> fails then the C<stat> comparison should be
2773 modified accordingly.
2774
2775 =item *
2776
2777 Security. Systems that can not support a test for the sticky bit
2778 on a directory can not use the MEDIUM and HIGH security tests.
2779 The C<_can_do_level> method should be modified accordingly.
2780
2781 =back
2782
2783 =end __INTERNALS
2784
2785 =head1 OBJECT-ORIENTED INTERFACE
2786
2787 This is the primary interface for interacting with
2788 C<File::Temp>. Using the OO interface a temporary file can be created
2789 when the object is constructed and the file can be removed when the
2790 object is no longer required.
2791
2792 Note that there is no method to obtain the filehandle from the
2793 C<File::Temp> object. The object itself acts as a filehandle.  The object
2794 isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
2795 available.
2796
2797 Also, the object is configured such that it stringifies to the name of the
2798 temporary file and so can be compared to a filename directly.  It numifies
2799 to the C<refaddr> the same as other handles and so can be compared to other
2800 handles with C<==>.
2801
2802     $fh eq $filename       # as a string
2803     $fh != \*STDOUT        # as a number
2804
2805 Available since 0.14.
2806
2807 =over 4
2808
2809 =item B<new>
2810
2811 Create a temporary file object.
2812
2813   my $tmp = File::Temp->new();
2814
2815 by default the object is constructed as if C<tempfile>
2816 was called without options, but with the additional behaviour
2817 that the temporary file is removed by the object destructor
2818 if UNLINK is set to true (the default).
2819
2820 Supported arguments are the same as for C<tempfile>: UNLINK
2821 (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
2822 template is specified using the TEMPLATE option. The OPEN option
2823 is not supported (the file is always opened).
2824
2825  $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
2826                         DIR => 'mydir',
2827                         SUFFIX => '.dat');
2828
2829 Arguments are case insensitive.
2830
2831 Can call croak() if an error occurs.
2832
2833 Available since 0.14.
2834
2835 TEMPLATE available since 0.23
2836
2837 =item B<newdir>
2838
2839 Create a temporary directory using an object oriented interface.
2840
2841   $dir = File::Temp->newdir();
2842
2843 By default the directory is deleted when the object goes out of scope.
2844
2845 Supports the same options as the C<tempdir> function. Note that directories
2846 created with this method default to CLEANUP => 1.
2847
2848   $dir = File::Temp->newdir( $template, %options );
2849
2850 A template may be specified either with a leading template or
2851 with a TEMPLATE argument.
2852
2853 Available since 0.19.
2854
2855 TEMPLATE available since 0.23.
2856
2857 =item B<filename>
2858
2859 Return the name of the temporary file associated with this object
2860 (if the object was created using the "new" constructor).
2861
2862   $filename = $tmp->filename;
2863
2864 This method is called automatically when the object is used as
2865 a string.
2866
2867 Current API available since 0.14
2868
2869 =item B<dirname>
2870
2871 Return the name of the temporary directory associated with this
2872 object (if the object was created using the "newdir" constructor).
2873
2874   $dirname = $tmpdir->dirname;
2875
2876 This method is called automatically when the object is used in string context.
2877
2878 =item B<unlink_on_destroy>
2879
2880 Control whether the file is unlinked when the object goes out of scope.
2881 The file is removed if this value is true and $KEEP_ALL is not.
2882
2883  $fh->unlink_on_destroy( 1 );
2884
2885 Default is for the file to be removed.
2886
2887 Current API available since 0.15
2888
2889 =item B<DESTROY>
2890
2891 When the object goes out of scope, the destructor is called. This
2892 destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
2893 if the constructor was called with UNLINK set to 1 (the default state
2894 if UNLINK is not specified).
2895
2896 No error is given if the unlink fails.
2897
2898 If the object has been passed to a child process during a fork, the
2899 file will be deleted when the object goes out of scope in the parent.
2900
2901 For a temporary directory object the directory will be removed unless
2902 the CLEANUP argument was used in the constructor (and set to false) or
2903 C<unlink_on_destroy> was modified after creation.  Note that if a temp
2904 directory is your current directory, it cannot be removed - a warning
2905 will be given in this case.  C<chdir()> out of the directory before
2906 letting the object go out of scope.
2907
2908 If the global variable $KEEP_ALL is true, the file or directory
2909 will not be removed.
2910
2911 =back
2912
2913 =head1 FUNCTIONS
2914
2915 This section describes the recommended interface for generating
2916 temporary files and directories.
2917
2918 =over 4
2919
2920 =item B<tempfile>
2921
2922 This is the basic function to generate temporary files.
2923 The behaviour of the file can be changed using various options:
2924
2925   $fh = tempfile();
2926   ($fh, $filename) = tempfile();
2927
2928 Create a temporary file in  the directory specified for temporary
2929 files, as specified by the tmpdir() function in L<File::Spec>.
2930
2931   ($fh, $filename) = tempfile($template);
2932
2933 Create a temporary file in the current directory using the supplied
2934 template.  Trailing `X' characters are replaced with random letters to
2935 generate the filename.  At least four `X' characters must be present
2936 at the end of the template.
2937
2938   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
2939
2940 Same as previously, except that a suffix is added to the template
2941 after the `X' translation.  Useful for ensuring that a temporary
2942 filename has a particular extension when needed by other applications.
2943 But see the WARNING at the end.
2944
2945   ($fh, $filename) = tempfile($template, DIR => $dir);
2946
2947 Translates the template as before except that a directory name
2948 is specified.
2949
2950   ($fh, $filename) = tempfile($template, TMPDIR => 1);
2951
2952 Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
2953 into the same temporary directory as would be used if no template was
2954 specified at all.
2955
2956   ($fh, $filename) = tempfile($template, UNLINK => 1);
2957
2958 Return the filename and filehandle as before except that the file is
2959 automatically removed when the program exits (dependent on
2960 $KEEP_ALL). Default is for the file to be removed if a file handle is
2961 requested and to be kept if the filename is requested. In a scalar
2962 context (where no filename is returned) the file is always deleted
2963 either (depending on the operating system) on exit or when it is
2964 closed (unless $KEEP_ALL is true when the temp file is created).
2965
2966 Use the object-oriented interface if fine-grained control of when
2967 a file is removed is required.
2968
2969 If the template is not specified, a template is always
2970 automatically generated. This temporary file is placed in tmpdir()
2971 (L<File::Spec>) unless a directory is specified explicitly with the
2972 DIR option.
2973
2974   $fh = tempfile( DIR => $dir );
2975
2976 If called in scalar context, only the filehandle is returned and the
2977 file will automatically be deleted when closed on operating systems
2978 that support this (see the description of tmpfile() elsewhere in this
2979 document).  This is the preferred mode of operation, as if you only
2980 have a filehandle, you can never create a race condition by fumbling
2981 with the filename. On systems that can not unlink an open file or can
2982 not mark a file as temporary when it is opened (for example, Windows
2983 NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
2984 the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
2985 flag is ignored if present.
2986
2987   (undef, $filename) = tempfile($template, OPEN => 0);
2988
2989 This will return the filename based on the template but
2990 will not open this file.  Cannot be used in conjunction with
2991 UNLINK set to true. Default is to always open the file
2992 to protect from possible race conditions. A warning is issued
2993 if warnings are turned on. Consider using the tmpnam()
2994 and mktemp() functions described elsewhere in this document
2995 if opening the file is not required.
2996
2997 If the operating system supports it (for example BSD derived systems), the 
2998 filehandle will be opened with O_EXLOCK (open with exclusive file lock). 
2999 This can sometimes cause problems if the intention is to pass the filename 
3000 to another system that expects to take an exclusive lock itself (such as 
3001 DBD::SQLite) whilst ensuring that the tempfile is not reused. In this 
3002 situation the "EXLOCK" option can be passed to tempfile. By default EXLOCK 
3003 will be true (this retains compatibility with earlier releases).
3004
3005   ($fh, $filename) = tempfile($template, EXLOCK => 0);
3006
3007 Options can be combined as required.
3008
3009 Will croak() if there is an error.
3010
3011 Available since 0.05.
3012
3013 UNLINK flag available since 0.10.
3014
3015 TMPDIR flag available since 0.19.
3016
3017 EXLOCK flag available since 0.19.
3018
3019 =item B<tempdir>
3020
3021 This is the recommended interface for creation of temporary
3022 directories.  By default the directory will not be removed on exit
3023 (that is, it won't be temporary; this behaviour can not be changed
3024 because of issues with backwards compatibility). To enable removal
3025 either use the CLEANUP option which will trigger removal on program
3026 exit, or consider using the "newdir" method in the object interface which
3027 will allow the directory to be cleaned up when the object goes out of
3028 scope.
3029
3030 The behaviour of the function depends on the arguments:
3031
3032   $tempdir = tempdir();
3033
3034 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
3035
3036   $tempdir = tempdir( $template );
3037
3038 Create a directory from the supplied template. This template is
3039 similar to that described for tempfile(). `X' characters at the end
3040 of the template are replaced with random letters to construct the
3041 directory name. At least four `X' characters must be in the template.
3042
3043   $tempdir = tempdir ( DIR => $dir );
3044
3045 Specifies the directory to use for the temporary directory.
3046 The temporary directory name is derived from an internal template.
3047
3048   $tempdir = tempdir ( $template, DIR => $dir );
3049
3050 Prepend the supplied directory name to the template. The template
3051 should not include parent directory specifications itself. Any parent
3052 directory specifications are removed from the template before
3053 prepending the supplied directory.
3054
3055   $tempdir = tempdir ( $template, TMPDIR => 1 );
3056
3057 Using the supplied template, create the temporary directory in
3058 a standard location for temporary files. Equivalent to doing
3059
3060   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
3061
3062 but shorter. Parent directory specifications are stripped from the
3063 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
3064 explicitly.  Additionally, C<TMPDIR> is implied if neither a template
3065 nor a directory are supplied.
3066
3067   $tempdir = tempdir( $template, CLEANUP => 1);
3068
3069 Create a temporary directory using the supplied template, but
3070 attempt to remove it (and all files inside it) when the program
3071 exits. Note that an attempt will be made to remove all files from
3072 the directory even if they were not created by this module (otherwise
3073 why ask to clean it up?). The directory removal is made with
3074 the rmtree() function from the L<File::Path|File::Path> module.
3075 Of course, if the template is not specified, the temporary directory
3076 will be created in tmpdir() and will also be removed at program exit.
3077
3078 Will croak() if there is an error.
3079
3080 Current API available since 0.05.
3081
3082 =back
3083
3084 =head1 MKTEMP FUNCTIONS
3085
3086 The following functions are Perl implementations of the
3087 mktemp() family of temp file generation system calls.
3088
3089 =over 4
3090
3091 =item B<mkstemp>
3092
3093 Given a template, returns a filehandle to the temporary file and the name
3094 of the file.
3095
3096   ($fh, $name) = mkstemp( $template );
3097
3098 In scalar context, just the filehandle is returned.
3099
3100 The template may be any filename with some number of X's appended
3101 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
3102 with unique alphanumeric combinations.
3103
3104 Will croak() if there is an error.
3105
3106 Current API available since 0.05.
3107
3108 =item B<mkstemps>
3109
3110 Similar to mkstemp(), except that an extra argument can be supplied
3111 with a suffix to be appended to the template.
3112
3113   ($fh, $name) = mkstemps( $template, $suffix );
3114
3115 For example a template of C<testXXXXXX> and suffix of C<.dat>
3116 would generate a file similar to F<testhGji_w.dat>.
3117
3118 Returns just the filehandle alone when called in scalar context.
3119
3120 Will croak() if there is an error.
3121
3122 Current API available since 0.05.
3123
3124 =item B<mkdtemp>
3125
3126 Create a directory from a template. The template must end in
3127 X's that are replaced by the routine.
3128
3129   $tmpdir_name = mkdtemp($template);
3130
3131 Returns the name of the temporary directory created.
3132
3133 Directory must be removed by the caller.
3134
3135 Will croak() if there is an error.
3136
3137 Current API available since 0.05.
3138
3139 =item B<mktemp>
3140
3141 Returns a valid temporary filename but does not guarantee
3142 that the file will not be opened by someone else.
3143
3144   $unopened_file = mktemp($template);
3145
3146 Template is the same as that required by mkstemp().
3147
3148 Will croak() if there is an error.
3149
3150 Current API available since 0.05.
3151
3152 =back
3153
3154 =head1 POSIX FUNCTIONS
3155
3156 This section describes the re-implementation of the tmpnam()
3157 and tmpfile() functions described in L<POSIX>
3158 using the mkstemp() from this module.
3159
3160 Unlike the L<POSIX|POSIX> implementations, the directory used
3161 for the temporary file is not specified in a system include
3162 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
3163 returned by L<File::Spec|File::Spec>. On some implementations this
3164 location can be set using the C<TMPDIR> environment variable, which
3165 may not be secure.
3166 If this is a problem, simply use mkstemp() and specify a template.
3167
3168 =over 4
3169
3170 =item B<tmpnam>
3171
3172 When called in scalar context, returns the full name (including path)
3173 of a temporary file (uses mktemp()). The only check is that the file does
3174 not already exist, but there is no guarantee that that condition will
3175 continue to apply.
3176
3177   $file = tmpnam();
3178
3179 When called in list context, a filehandle to the open file and
3180 a filename are returned. This is achieved by calling mkstemp()
3181 after constructing a suitable template.
3182
3183   ($fh, $file) = tmpnam();
3184
3185 If possible, this form should be used to prevent possible
3186 race conditions.
3187
3188 See L<File::Spec/tmpdir> for information on the choice of temporary
3189 directory for a particular operating system.
3190
3191 Will croak() if there is an error.
3192
3193 Current API available since 0.05.
3194
3195 =item B<tmpfile>
3196
3197 Returns the filehandle of a temporary file.
3198
3199   $fh = tmpfile();
3200
3201 The file is removed when the filehandle is closed or when the program
3202 exits. No access to the filename is provided.
3203
3204 If the temporary file can not be created undef is returned.
3205 Currently this command will probably not work when the temporary
3206 directory is on an NFS file system.
3207
3208 Will croak() if there is an error.
3209
3210 Available since 0.05.
3211
3212 Returning undef if unable to create file added in 0.12.
3213
3214 =back
3215
3216 =head1 ADDITIONAL FUNCTIONS
3217
3218 These functions are provided for backwards compatibility
3219 with common tempfile generation C library functions.
3220
3221 They are not exported and must be addressed using the full package
3222 name.
3223
3224 =over 4
3225
3226 =item B<tempnam>
3227
3228 Return the name of a temporary file in the specified directory
3229 using a prefix. The file is guaranteed not to exist at the time
3230 the function was called, but such guarantees are good for one
3231 clock tick only.  Always use the proper form of C<sysopen>
3232 with C<O_CREAT | O_EXCL> if you must open such a filename.
3233
3234   $filename = File::Temp::tempnam( $dir, $prefix );
3235
3236 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
3237 (using unix file convention as an example)
3238
3239 Because this function uses mktemp(), it can suffer from race conditions.
3240
3241 Will croak() if there is an error.
3242
3243 Current API available since 0.05.
3244
3245 =back
3246
3247 =head1 UTILITY FUNCTIONS
3248
3249 Useful functions for dealing with the filehandle and filename.
3250
3251 =over 4
3252
3253 =item B<unlink0>
3254
3255 Given an open filehandle and the associated filename, make a safe
3256 unlink. This is achieved by first checking that the filename and
3257 filehandle initially point to the same file and that the number of
3258 links to the file is 1 (all fields returned by stat() are compared).
3259 Then the filename is unlinked and the filehandle checked once again to
3260 verify that the number of links on that file is now 0.  This is the
3261 closest you can come to making sure that the filename unlinked was the
3262 same as the file whose descriptor you hold.
3263
3264   unlink0($fh, $path)
3265      or die "Error unlinking file $path safely";
3266
3267 Returns false on error but croaks() if there is a security
3268 anomaly. The filehandle is not closed since on some occasions this is
3269 not required.
3270
3271 On some platforms, for example Windows NT, it is not possible to
3272 unlink an open file (the file must be closed first). On those
3273 platforms, the actual unlinking is deferred until the program ends and
3274 good status is returned. A check is still performed to make sure that
3275 the filehandle and filename are pointing to the same thing (but not at
3276 the time the end block is executed since the deferred removal may not
3277 have access to the filehandle).
3278
3279 Additionally, on Windows NT not all the fields returned by stat() can
3280 be compared. For example, the C<dev> and C<rdev> fields seem to be
3281 different.  Also, it seems that the size of the file returned by stat()
3282 does not always agree, with C<stat(FH)> being more accurate than
3283 C<stat(filename)>, presumably because of caching issues even when
3284 using autoflush (this is usually overcome by waiting a while after
3285 writing to the tempfile before attempting to C<unlink0> it).
3286
3287 Finally, on NFS file systems the link count of the file handle does
3288 not always go to zero immediately after unlinking. Currently, this
3289 command is expected to fail on NFS disks.
3290
3291 This function is disabled if the global variable $KEEP_ALL is true
3292 and an unlink on open file is supported. If the unlink is to be deferred
3293 to the END block, the file is still registered for removal.
3294
3295 This function should not be called if you are using the object oriented
3296 interface since the it will interfere with the object destructor deleting
3297 the file.
3298
3299 Available Since 0.05.
3300
3301 If can not unlink open file, defer removal until later available since 0.06.
3302
3303 =item B<cmpstat>
3304
3305 Compare C<stat> of filehandle with C<stat> of provided filename.  This
3306 can be used to check that the filename and filehandle initially point
3307 to the same file and that the number of links to the file is 1 (all
3308 fields returned by stat() are compared).
3309
3310   cmpstat($fh, $path)
3311      or die "Error comparing handle with file";
3312
3313 Returns false if the stat information differs or if the link count is
3314 greater than 1. Calls croak if there is a security anomaly.
3315
3316 On certain platforms, for example Windows, not all the fields returned by stat()
3317 can be compared. For example, the C<dev> and C<rdev> fields seem to be
3318 different in Windows.  Also, it seems that the size of the file
3319 returned by stat() does not always agree, with C<stat(FH)> being more
3320 accurate than C<stat(filename)>, presumably because of caching issues
3321 even when using autoflush (this is usually overcome by waiting a while
3322 after writing to the tempfile before attempting to C<unlink0> it).
3323
3324 Not exported by default.
3325
3326 Current API available since 0.14.
3327
3328 =item B<unlink1>
3329
3330 Similar to C<unlink0> except after file comparison using cmpstat, the
3331 filehandle is closed prior to attempting to unlink the file. This
3332 allows the file to be removed without using an END block, but does
3333 mean that the post-unlink comparison of the filehandle state provided
3334 by C<unlink0> is not available.
3335
3336   unlink1($fh, $path)
3337      or die "Error closing and unlinking file";
3338
3339 Usually called from the object destructor when using the OO interface.
3340
3341 Not exported by default.
3342
3343 This function is disabled if the global variable $KEEP_ALL is true.
3344
3345 Can call croak() if there is a security anomaly during the stat()
3346 comparison.
3347
3348 Current API available since 0.14.
3349
3350 =item B<cleanup>
3351
3352 Calling this function will cause any temp files or temp directories
3353 that are registered for removal to be removed. This happens automatically
3354 when the process exits but can be triggered manually if the caller is sure
3355 that none of the temp files are required. This method can be registered as
3356 an Apache callback.
3357
3358 Note that if a temp directory is your current directory, it cannot be
3359 removed.  C<chdir()> out of the directory first before calling
3360 C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
3361 is set, this happens automatically.)
3362
3363 On OSes where temp files are automatically removed when the temp file
3364 is closed, calling this function will have no effect other than to remove
3365 temporary directories (which may include temporary files).
3366
3367   File::Temp::cleanup();
3368
3369 Not exported by default.
3370
3371 Current API available since 0.15.
3372
3373 =back
3374
3375 =head1 PACKAGE VARIABLES
3376
3377 These functions control the global state of the package.
3378
3379 =over 4
3380
3381 =item B<safe_level>
3382
3383 Controls the lengths to which the module will go to check the safety of the
3384 temporary file or directory before proceeding.
3385 Options are:
3386
3387 =over 8
3388
3389 =item STANDARD
3390
3391 Do the basic security measures to ensure the directory exists and is
3392 writable, that temporary files are opened only if they do not already
3393 exist, and that possible race conditions are avoided.  Finally the
3394 L<unlink0|"unlink0"> function is used to remove files safely.
3395
3396 =item MEDIUM
3397
3398 In addition to the STANDARD security, the output directory is checked
3399 to make sure that it is owned either by root or the user running the
3400 program. If the directory is writable by group or by other, it is then
3401 checked to make sure that the sticky bit is set.
3402
3403 Will not work on platforms that do not support the C<-k> test
3404 for sticky bit.
3405
3406 =item HIGH
3407
3408 In addition to the MEDIUM security checks, also check for the
3409 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
3410 sysconf() function. If this is a possibility, each directory in the
3411 path is checked in turn for safeness, recursively walking back to the
3412 root directory.
3413
3414 For platforms that do not support the L<POSIX|POSIX>
3415 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
3416 assumed that ``chown() giveaway'' is possible and the recursive test
3417 is performed.
3418
3419 =back
3420
3421 The level can be changed as follows:
3422
3423   File::Temp->safe_level( File::Temp::HIGH );
3424
3425 The level constants are not exported by the module.
3426
3427 Currently, you must be running at least perl v5.6.0 in order to
3428 run with MEDIUM or HIGH security. This is simply because the
3429 safety tests use functions from L<Fcntl|Fcntl> that are not
3430 available in older versions of perl. The problem is that the version
3431 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
3432 they are different versions.
3433
3434 On systems that do not support the HIGH or MEDIUM safety levels
3435 (for example Win NT or OS/2) any attempt to change the level will
3436 be ignored. The decision to ignore rather than raise an exception
3437 allows portable programs to be written with high security in mind
3438 for the systems that can support this without those programs failing
3439 on systems where the extra tests are irrelevant.
3440
3441 If you really need to see whether the change has been accepted
3442 simply examine the return value of C<safe_level>.
3443
3444   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
3445   die "Could not change to high security"
3446       if $newlevel != File::Temp::HIGH;
3447
3448 Available since 0.05.
3449
3450 =item TopSystemUID
3451
3452 This is the highest UID on the current system that refers to a root
3453 UID. This is used to make sure that the temporary directory is
3454 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
3455 simply by root.
3456
3457 This is required since on many unix systems C</tmp> is not owned
3458 by root.
3459
3460 Default is to assume that any UID less than or equal to 10 is a root
3461 UID.
3462
3463   File::Temp->top_system_uid(10);
3464   my $topid = File::Temp->top_system_uid;
3465
3466 This value can be adjusted to reduce security checking if required.
3467 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
3468
3469 Available since 0.05.
3470
3471 =item B<$KEEP_ALL>
3472
3473 Controls whether temporary files and directories should be retained
3474 regardless of any instructions in the program to remove them
3475 automatically.  This is useful for debugging but should not be used in
3476 production code.
3477
3478   $File::Temp::KEEP_ALL = 1;
3479
3480 Default is for files to be removed as requested by the caller.
3481
3482 In some cases, files will only be retained if this variable is true
3483 when the file is created. This means that you can not create a temporary
3484 file, set this variable and expect the temp file to still be around
3485 when the program exits.
3486
3487 =item B<$DEBUG>
3488
3489 Controls whether debugging messages should be enabled.
3490
3491   $File::Temp::DEBUG = 1;
3492
3493 Default is for debugging mode to be disabled.
3494
3495 Available since 0.15.
3496
3497 =back
3498
3499 =head1 WARNING
3500
3501 For maximum security, endeavour always to avoid ever looking at,
3502 touching, or even imputing the existence of the filename.  You do not
3503 know that that filename is connected to the same file as the handle
3504 you have, and attempts to check this can only trigger more race
3505 conditions.  It's far more secure to use the filehandle alone and
3506 dispense with the filename altogether.
3507
3508 If you need to pass the handle to something that expects a filename
3509 then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
3510 arbitrary programs. Perl code that uses the 2-argument version of
3511 C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
3512 will need to pass the filename. You will have to clear the
3513 close-on-exec bit on that file descriptor before passing it to another
3514 process.
3515
3516     use Fcntl qw/F_SETFD F_GETFD/;
3517     fcntl($tmpfh, F_SETFD, 0)
3518         or die "Can't clear close-on-exec flag on temp fh: $!\n";
3519
3520 =head2 Temporary files and NFS
3521
3522 Some problems are associated with using temporary files that reside
3523 on NFS file systems and it is recommended that a local filesystem
3524 is used whenever possible. Some of the security tests will most probably
3525 fail when the temp file is not local. Additionally, be aware that
3526 the performance of I/O operations over NFS will not be as good as for
3527 a local disk.
3528
3529 =head2 Forking
3530
3531 In some cases files created by File::Temp are removed from within an
3532 END block. Since END blocks are triggered when a child process exits
3533 (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
3534 to only remove those temp files created by a particular process ID. This
3535 means that a child will not attempt to remove temp files created by the
3536 parent process.
3537
3538 If you are forking many processes in parallel that are all creating
3539 temporary files, you may need to reset the random number seed using
3540 srand(EXPR) in each child else all the children will attempt to walk
3541 through the same set of random file names and may well cause
3542 themselves to give up if they exceed the number of retry attempts.
3543
3544 =head2 Directory removal
3545
3546 Note that if you have chdir'ed into the temporary directory and it is
3547 subsequently cleaned up (either in the END block or as part of object
3548 destruction), then you will get a warning from File::Path::rmtree().
3549
3550 =head2 Taint mode
3551
3552 If you need to run code under taint mode, updating to the latest
3553 L<File::Spec> is highly recommended.  On Windows, if the directory
3554 given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
3555 to fallback to the user's local application data directory or croak
3556 with an error.
3557
3558 =head2 BINMODE
3559
3560 The file returned by File::Temp will have been opened in binary mode
3561 if such a mode is available. If that is not correct, use the C<binmode()>
3562 function to change the mode of the filehandle.
3563
3564 Note that you can modify the encoding of a file opened by File::Temp
3565 also by using C<binmode()>.
3566
3567 =head1 HISTORY
3568
3569 Originally began life in May 1999 as an XS interface to the system
3570 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
3571 translated to Perl for total control of the code's
3572 security checking, to ensure the presence of the function regardless of
3573 operating system and to help with portability. The module was shipped
3574 as a standard part of perl from v5.6.1.
3575
3576 Thanks to Tom Christiansen for suggesting that this module
3577 should be written and providing ideas for code improvements and
3578 security enhancements.
3579
3580 =head1 SEE ALSO
3581
3582 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
3583
3584 See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
3585 different implementations of temporary file handling.
3586
3587 See L<File::Tempdir> for an alternative object-oriented wrapper for
3588 the C<tempdir> function.
3589
3590 =for Pod::Coverage STRINGIFY NUMIFY top_system_uid
3591
3592 =head1 SUPPORT
3593
3594 Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=File-Temp>
3595 (or L<bug-File-Temp@rt.cpan.org|mailto:bug-File-Temp@rt.cpan.org>).
3596
3597 There is also a mailing list available for users of this distribution, at
3598 L<http://lists.perl.org/list/cpan-workers.html>.
3599
3600 There is also an irc channel available for users of this distribution, at
3601 L<C<#toolchain> on C<irc.perl.org>|irc://irc.perl.org/#toolchain>.
3602
3603 =head1 AUTHOR
3604
3605 Tim Jenness <tjenness@cpan.org>
3606
3607 =head1 CONTRIBUTORS
3608
3609 =for stopwords David Golden Karen Etheridge Olivier Mengue Peter Rabbitson Ben Tilly Kevin Ryde John Acklam Slaven Rezic James E. Keenan Brian Mowrey Dagfinn Ilmari MannsÃ¥ker Steinbrunner Ed Avis Guillem Jover
3610
3611 =over 4
3612
3613 =item *
3614
3615 David Golden <dagolden@cpan.org>
3616
3617 =item *
3618
3619 Karen Etheridge <ether@cpan.org>
3620
3621 =item *
3622
3623 Olivier Mengue <dolmen@cpan.org>
3624
3625 =item *
3626
3627 David Golden <xdg@xdg.me>
3628
3629 =item *
3630
3631 Peter Rabbitson <ribasushi@cpan.org>
3632
3633 =item *
3634
3635 Ben Tilly <btilly@gmail.com>
3636
3637 =item *
3638
3639 Kevin Ryde <user42@zip.com.au>
3640
3641 =item *
3642
3643 Peter John Acklam <pjacklam@online.no>
3644
3645 =item *
3646
3647 Slaven Rezic <slaven.rezic@idealo.de>
3648
3649 =item *
3650
3651 Slaven Rezic <slaven@rezic.de>
3652
3653 =item *
3654
3655 James E. Keenan <jkeen@verizon.net>
3656
3657 =item *
3658
3659 Brian Mowrey <brian@drlabs.org>
3660
3661 =item *
3662
3663 Dagfinn Ilmari MannsÃ¥ker <ilmari@ilmari.org>
3664
3665 =item *
3666
3667 David Steinbrunner <dsteinbrunner@pobox.com>
3668
3669 =item *
3670
3671 Ed Avis <eda@linux01.wcl.local>
3672
3673 =item *
3674
3675 Guillem Jover <guillem@hadrons.org>
3676
3677 =back
3678
3679 =head1 COPYRIGHT AND LICENSE
3680
3681 This software is copyright (c) 2018 by Tim Jenness and the UK Particle Physics and Astronomy Research Council.
3682
3683 This is free software; you can redistribute it and/or modify it under
3684 the same terms as the Perl 5 programming language system itself.
3685
3686 =cut