cpan/File-Temp/lib/File/Temp.pm

   1 package File::Temp; # git description: v0.2308-7-g3bb4d88
   2 # ABSTRACT: return name and handle of a temporary file safely
   3
   4 our $VERSION = '0.2309';
   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 false.
 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" => 0,
 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 To open the temporary filehandle with O_EXLOCK (open with exclusive
1354 #pod file lock) use C<< EXLOCK=>1 >>. This is supported only by some
1355 #pod operating systems (most notably BSD derived systems). By default
1356 #pod EXLOCK will be false. Former C<File::Temp> versions set EXLOCK to
1357 #pod true, so to be sure to get an unlocked filehandle also with older
1358 #pod versions, explicitly set C<< EXLOCK=>0 >>.
1359 #pod
1360 #pod   ($fh, $filename) = tempfile($template, EXLOCK => 1);
1361 #pod
1362 #pod Options can be combined as required.
1363 #pod
1364 #pod Will croak() if there is an error.
1365 #pod
1366 #pod Available since 0.05.
1367 #pod
1368 #pod UNLINK flag available since 0.10.
1369 #pod
1370 #pod TMPDIR flag available since 0.19.
1371 #pod
1372 #pod EXLOCK flag available since 0.19.
1373 #pod
1374 #pod =cut
1375
1376 sub tempfile {
1377   if ( @_ && $_[0] eq 'File::Temp' ) {
1378       croak "'tempfile' can't be called as a method";
1379   }
1380   # Can not check for argument count since we can have any
1381   # number of args
1382
1383   # Default options
1384   my %options = (
1385                  "DIR"    => undef, # Directory prefix
1386                  "SUFFIX" => '',    # Template suffix
1387                  "UNLINK" => 0,     # Do not unlink file on exit
1388                  "OPEN"   => 1,     # Open file
1389                  "TMPDIR" => 0, # Place tempfile in tempdir if template specified
1390                  "EXLOCK" => 0, # Open file with O_EXLOCK
1391                 );
1392
1393   # Check to see whether we have an odd or even number of arguments
1394   my ($maybe_template, $args) = _parse_args(@_);
1395   my $template = @$maybe_template ? $maybe_template->[0] : undef;
1396
1397   # Read the options and merge with defaults
1398   %options = (%options, %$args);
1399
1400   # First decision is whether or not to open the file
1401   if (! $options{"OPEN"}) {
1402
1403     warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1404       if $^W;
1405
1406   }
1407
1408   if ($options{"DIR"} and $^O eq 'VMS') {
1409
1410     # on VMS turn []foo into [.foo] for concatenation
1411     $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1412   }
1413
1414   # Construct the template
1415
1416   # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1417   # functions or simply constructing a template and using _gettemp()
1418   # explicitly. Go for the latter
1419
1420   # First generate a template if not defined and prefix the directory
1421   # If no template must prefix the temp directory
1422   if (defined $template) {
1423     # End up with current directory if neither DIR not TMPDIR are set
1424     if ($options{"DIR"}) {
1425
1426       $template = File::Spec->catfile($options{"DIR"}, $template);
1427
1428     } elsif ($options{TMPDIR}) {
1429
1430       $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), $template );
1431
1432     }
1433
1434   } else {
1435
1436     if ($options{"DIR"}) {
1437
1438       $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1439
1440     } else {
1441
1442       $template = File::Spec->catfile(_wrap_file_spec_tmpdir(), TEMPXXX);
1443
1444     }
1445
1446   }
1447
1448   # Now add a suffix
1449   $template .= $options{"SUFFIX"};
1450
1451   # Determine whether we should tell _gettemp to unlink the file
1452   # On unix this is irrelevant and can be worked out after the file is
1453   # opened (simply by unlinking the open filehandle). On Windows or VMS
1454   # we have to indicate temporary-ness when we open the file. In general
1455   # we only want a true temporary file if we are returning just the
1456   # filehandle - if the user wants the filename they probably do not
1457   # want the file to disappear as soon as they close it (which may be
1458   # important if they want a child process to use the file)
1459   # For this reason, tie unlink_on_close to the return context regardless
1460   # of OS.
1461   my $unlink_on_close = ( wantarray ? 0 : 1);
1462
1463   # Create the file
1464   my ($fh, $path, $errstr);
1465   croak "Error in tempfile() using template $template: $errstr"
1466     unless (($fh, $path) = _gettemp($template,
1467                                     "open" => $options{'OPEN'},
1468                                     "mkdir"=> 0 ,
1469                                     "unlink_on_close" => $unlink_on_close,
1470                                     "suffixlen" => length($options{'SUFFIX'}),
1471                                     "ErrStr" => \$errstr,
1472                                     "use_exlock" => $options{EXLOCK},
1473                                    ) );
1474
1475   # Set up an exit handler that can do whatever is right for the
1476   # system. This removes files at exit when requested explicitly or when
1477   # system is asked to unlink_on_close but is unable to do so because
1478   # of OS limitations.
1479   # The latter should be achieved by using a tied filehandle.
1480   # Do not check return status since this is all done with END blocks.
1481   _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1482
1483   # Return
1484   if (wantarray()) {
1485
1486     if ($options{'OPEN'}) {
1487       return ($fh, $path);
1488     } else {
1489       return (undef, $path);
1490     }
1491
1492   } else {
1493
1494     # Unlink the file. It is up to unlink0 to decide what to do with
1495     # this (whether to unlink now or to defer until later)
1496     unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1497
1498     # Return just the filehandle.
1499     return $fh;
1500   }
1501
1502
1503 }
1504
1505 # On Windows under taint mode, File::Spec could suggest "C:\" as a tempdir
1506 # which might not be writable.  If that is the case, we fallback to a
1507 # user directory.  See https://rt.cpan.org/Ticket/Display.html?id=60340
1508
1509 {
1510   my ($alt_tmpdir, $checked);
1511
1512   sub _wrap_file_spec_tmpdir {
1513     return File::Spec->tmpdir unless $^O eq "MSWin32" && ${^TAINT};
1514
1515     if ( $checked ) {
1516       return $alt_tmpdir ? $alt_tmpdir : File::Spec->tmpdir;
1517     }
1518
1519     # probe what File::Spec gives and find a fallback
1520     my $xxpath = _replace_XX( "X" x 10, 0 );
1521
1522     # First, see if File::Spec->tmpdir is writable
1523     my $tmpdir = File::Spec->tmpdir;
1524     my $testpath = File::Spec->catdir( $tmpdir, $xxpath );
1525     if (mkdir( $testpath, 0700) ) {
1526       $checked = 1;
1527       rmdir $testpath;
1528       return $tmpdir;
1529     }
1530
1531     # Next, see if CSIDL_LOCAL_APPDATA is writable
1532     require Win32;
1533     my $local_app = File::Spec->catdir(
1534       Win32::GetFolderPath( Win32::CSIDL_LOCAL_APPDATA() ), 'Temp'
1535     );
1536     $testpath = File::Spec->catdir( $local_app, $xxpath );
1537     if ( -e $local_app or mkdir( $local_app, 0700 ) ) {
1538       if (mkdir( $testpath, 0700) ) {
1539         $checked = 1;
1540         rmdir $testpath;
1541         return $alt_tmpdir = $local_app;
1542       }
1543     }
1544
1545     # Can't find something writable
1546     croak << "HERE";
1547 Couldn't find a writable temp directory in taint mode. Tried:
1548   $tmpdir
1549   $local_app
1550
1551 Try setting and untainting the TMPDIR environment variable.
1552 HERE
1553
1554   }
1555 }
1556
1557 #pod =item B<tempdir>
1558 #pod
1559 #pod This is the recommended interface for creation of temporary
1560 #pod directories.  By default the directory will not be removed on exit
1561 #pod (that is, it won't be temporary; this behaviour can not be changed
1562 #pod because of issues with backwards compatibility). To enable removal
1563 #pod either use the CLEANUP option which will trigger removal on program
1564 #pod exit, or consider using the "newdir" method in the object interface which
1565 #pod will allow the directory to be cleaned up when the object goes out of
1566 #pod scope.
1567 #pod
1568 #pod The behaviour of the function depends on the arguments:
1569 #pod
1570 #pod   $tempdir = tempdir();
1571 #pod
1572 #pod Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1573 #pod
1574 #pod   $tempdir = tempdir( $template );
1575 #pod
1576 #pod Create a directory from the supplied template. This template is
1577 #pod similar to that described for tempfile(). `X' characters at the end
1578 #pod of the template are replaced with random letters to construct the
1579 #pod directory name. At least four `X' characters must be in the template.
1580 #pod
1581 #pod   $tempdir = tempdir ( DIR => $dir );
1582 #pod
1583 #pod Specifies the directory to use for the temporary directory.
1584 #pod The temporary directory name is derived from an internal template.
1585 #pod
1586 #pod   $tempdir = tempdir ( $template, DIR => $dir );
1587 #pod
1588 #pod Prepend the supplied directory name to the template. The template
1589 #pod should not include parent directory specifications itself. Any parent
1590 #pod directory specifications are removed from the template before
1591 #pod prepending the supplied directory.
1592 #pod
1593 #pod   $tempdir = tempdir ( $template, TMPDIR => 1 );
1594 #pod
1595 #pod Using the supplied template, create the temporary directory in
1596 #pod a standard location for temporary files. Equivalent to doing
1597 #pod
1598 #pod   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1599 #pod
1600 #pod but shorter. Parent directory specifications are stripped from the
1601 #pod template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1602 #pod explicitly.  Additionally, C<TMPDIR> is implied if neither a template
1603 #pod nor a directory are supplied.
1604 #pod
1605 #pod   $tempdir = tempdir( $template, CLEANUP => 1);
1606 #pod
1607 #pod Create a temporary directory using the supplied template, but
1608 #pod attempt to remove it (and all files inside it) when the program
1609 #pod exits. Note that an attempt will be made to remove all files from
1610 #pod the directory even if they were not created by this module (otherwise
1611 #pod why ask to clean it up?). The directory removal is made with
1612 #pod the rmtree() function from the L<File::Path|File::Path> module.
1613 #pod Of course, if the template is not specified, the temporary directory
1614 #pod will be created in tmpdir() and will also be removed at program exit.
1615 #pod
1616 #pod Will croak() if there is an error.
1617 #pod
1618 #pod Current API available since 0.05.
1619 #pod
1620 #pod =cut
1621
1622 # '
1623
1624 sub tempdir  {
1625   if ( @_ && $_[0] eq 'File::Temp' ) {
1626       croak "'tempdir' can't be called as a method";
1627   }
1628
1629   # Can not check for argument count since we can have any
1630   # number of args
1631
1632   # Default options
1633   my %options = (
1634                  "CLEANUP"    => 0, # Remove directory on exit
1635                  "DIR"        => '', # Root directory
1636                  "TMPDIR"     => 0,  # Use tempdir with template
1637                 );
1638
1639   # Check to see whether we have an odd or even number of arguments
1640   my ($maybe_template, $args) = _parse_args(@_);
1641   my $template = @$maybe_template ? $maybe_template->[0] : undef;
1642
1643   # Read the options and merge with defaults
1644   %options = (%options, %$args);
1645
1646   # Modify or generate the template
1647
1648   # Deal with the DIR and TMPDIR options
1649   if (defined $template) {
1650
1651     # Need to strip directory path if using DIR or TMPDIR
1652     if ($options{'TMPDIR'} || $options{'DIR'}) {
1653
1654       # Strip parent directory from the filename
1655       #
1656       # There is no filename at the end
1657       $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1658       my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1659
1660       # Last directory is then our template
1661       $template = (File::Spec->splitdir($directories))[-1];
1662
1663       # Prepend the supplied directory or temp dir
1664       if ($options{"DIR"}) {
1665
1666         $template = File::Spec->catdir($options{"DIR"}, $template);
1667
1668       } elsif ($options{TMPDIR}) {
1669
1670         # Prepend tmpdir
1671         $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), $template);
1672
1673       }
1674
1675     }
1676
1677   } else {
1678
1679     if ($options{"DIR"}) {
1680
1681       $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1682
1683     } else {
1684
1685       $template = File::Spec->catdir(_wrap_file_spec_tmpdir(), TEMPXXX);
1686
1687     }
1688
1689   }
1690
1691   # Create the directory
1692   my $tempdir;
1693   my $suffixlen = 0;
1694   if ($^O eq 'VMS') {           # dir names can end in delimiters
1695     $template =~ m/([\.\]:>]+)$/;
1696     $suffixlen = length($1);
1697   }
1698   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1699     # dir name has a trailing ':'
1700     ++$suffixlen;
1701   }
1702
1703   my $errstr;
1704   croak "Error in tempdir() using $template: $errstr"
1705     unless ((undef, $tempdir) = _gettemp($template,
1706                                          "open" => 0,
1707                                          "mkdir"=> 1 ,
1708                                          "suffixlen" => $suffixlen,
1709                                          "ErrStr" => \$errstr,
1710                                         ) );
1711
1712   # Install exit handler; must be dynamic to get lexical
1713   if ( $options{'CLEANUP'} && -d $tempdir) {
1714     _deferred_unlink(undef, $tempdir, 1);
1715   }
1716
1717   # Return the dir name
1718   return $tempdir;
1719
1720 }
1721
1722 #pod =back
1723 #pod
1724 #pod =head1 MKTEMP FUNCTIONS
1725 #pod
1726 #pod The following functions are Perl implementations of the
1727 #pod mktemp() family of temp file generation system calls.
1728 #pod
1729 #pod =over 4
1730 #pod
1731 #pod =item B<mkstemp>
1732 #pod
1733 #pod Given a template, returns a filehandle to the temporary file and the name
1734 #pod of the file.
1735 #pod
1736 #pod   ($fh, $name) = mkstemp( $template );
1737 #pod
1738 #pod In scalar context, just the filehandle is returned.
1739 #pod
1740 #pod The template may be any filename with some number of X's appended
1741 #pod to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1742 #pod with unique alphanumeric combinations.
1743 #pod
1744 #pod Will croak() if there is an error.
1745 #pod
1746 #pod Current API available since 0.05.
1747 #pod
1748 #pod =cut
1749
1750
1751
1752 sub mkstemp {
1753
1754   croak "Usage: mkstemp(template)"
1755     if scalar(@_) != 1;
1756
1757   my $template = shift;
1758
1759   my ($fh, $path, $errstr);
1760   croak "Error in mkstemp using $template: $errstr"
1761     unless (($fh, $path) = _gettemp($template,
1762                                     "open" => 1,
1763                                     "mkdir"=> 0 ,
1764                                     "suffixlen" => 0,
1765                                     "ErrStr" => \$errstr,
1766                                    ) );
1767
1768   if (wantarray()) {
1769     return ($fh, $path);
1770   } else {
1771     return $fh;
1772   }
1773
1774 }
1775
1776
1777 #pod =item B<mkstemps>
1778 #pod
1779 #pod Similar to mkstemp(), except that an extra argument can be supplied
1780 #pod with a suffix to be appended to the template.
1781 #pod
1782 #pod   ($fh, $name) = mkstemps( $template, $suffix );
1783 #pod
1784 #pod For example a template of C<testXXXXXX> and suffix of C<.dat>
1785 #pod would generate a file similar to F<testhGji_w.dat>.
1786 #pod
1787 #pod Returns just the filehandle alone when called in scalar context.
1788 #pod
1789 #pod Will croak() if there is an error.
1790 #pod
1791 #pod Current API available since 0.05.
1792 #pod
1793 #pod =cut
1794
1795 sub mkstemps {
1796
1797   croak "Usage: mkstemps(template, suffix)"
1798     if scalar(@_) != 2;
1799
1800
1801   my $template = shift;
1802   my $suffix   = shift;
1803
1804   $template .= $suffix;
1805
1806   my ($fh, $path, $errstr);
1807   croak "Error in mkstemps using $template: $errstr"
1808     unless (($fh, $path) = _gettemp($template,
1809                                     "open" => 1,
1810                                     "mkdir"=> 0 ,
1811                                     "suffixlen" => length($suffix),
1812                                     "ErrStr" => \$errstr,
1813                                    ) );
1814
1815   if (wantarray()) {
1816     return ($fh, $path);
1817   } else {
1818     return $fh;
1819   }
1820
1821 }
1822
1823 #pod =item B<mkdtemp>
1824 #pod
1825 #pod Create a directory from a template. The template must end in
1826 #pod X's that are replaced by the routine.
1827 #pod
1828 #pod   $tmpdir_name = mkdtemp($template);
1829 #pod
1830 #pod Returns the name of the temporary directory created.
1831 #pod
1832 #pod Directory must be removed by the caller.
1833 #pod
1834 #pod Will croak() if there is an error.
1835 #pod
1836 #pod Current API available since 0.05.
1837 #pod
1838 #pod =cut
1839
1840 #' # for emacs
1841
1842 sub mkdtemp {
1843
1844   croak "Usage: mkdtemp(template)"
1845     if scalar(@_) != 1;
1846
1847   my $template = shift;
1848   my $suffixlen = 0;
1849   if ($^O eq 'VMS') {           # dir names can end in delimiters
1850     $template =~ m/([\.\]:>]+)$/;
1851     $suffixlen = length($1);
1852   }
1853   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1854     # dir name has a trailing ':'
1855     ++$suffixlen;
1856   }
1857   my ($junk, $tmpdir, $errstr);
1858   croak "Error creating temp directory from template $template\: $errstr"
1859     unless (($junk, $tmpdir) = _gettemp($template,
1860                                         "open" => 0,
1861                                         "mkdir"=> 1 ,
1862                                         "suffixlen" => $suffixlen,
1863                                         "ErrStr" => \$errstr,
1864                                        ) );
1865
1866   return $tmpdir;
1867
1868 }
1869
1870 #pod =item B<mktemp>
1871 #pod
1872 #pod Returns a valid temporary filename but does not guarantee
1873 #pod that the file will not be opened by someone else.
1874 #pod
1875 #pod   $unopened_file = mktemp($template);
1876 #pod
1877 #pod Template is the same as that required by mkstemp().
1878 #pod
1879 #pod Will croak() if there is an error.
1880 #pod
1881 #pod Current API available since 0.05.
1882 #pod
1883 #pod =cut
1884
1885 sub mktemp {
1886
1887   croak "Usage: mktemp(template)"
1888     if scalar(@_) != 1;
1889
1890   my $template = shift;
1891
1892   my ($tmpname, $junk, $errstr);
1893   croak "Error getting name to temp file from template $template: $errstr"
1894     unless (($junk, $tmpname) = _gettemp($template,
1895                                          "open" => 0,
1896                                          "mkdir"=> 0 ,
1897                                          "suffixlen" => 0,
1898                                          "ErrStr" => \$errstr,
1899                                         ) );
1900
1901   return $tmpname;
1902 }
1903
1904 #pod =back
1905 #pod
1906 #pod =head1 POSIX FUNCTIONS
1907 #pod
1908 #pod This section describes the re-implementation of the tmpnam()
1909 #pod and tmpfile() functions described in L<POSIX>
1910 #pod using the mkstemp() from this module.
1911 #pod
1912 #pod Unlike the L<POSIX|POSIX> implementations, the directory used
1913 #pod for the temporary file is not specified in a system include
1914 #pod file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1915 #pod returned by L<File::Spec|File::Spec>. On some implementations this
1916 #pod location can be set using the C<TMPDIR> environment variable, which
1917 #pod may not be secure.
1918 #pod If this is a problem, simply use mkstemp() and specify a template.
1919 #pod
1920 #pod =over 4
1921 #pod
1922 #pod =item B<tmpnam>
1923 #pod
1924 #pod When called in scalar context, returns the full name (including path)
1925 #pod of a temporary file (uses mktemp()). The only check is that the file does
1926 #pod not already exist, but there is no guarantee that that condition will
1927 #pod continue to apply.
1928 #pod
1929 #pod   $file = tmpnam();
1930 #pod
1931 #pod When called in list context, a filehandle to the open file and
1932 #pod a filename are returned. This is achieved by calling mkstemp()
1933 #pod after constructing a suitable template.
1934 #pod
1935 #pod   ($fh, $file) = tmpnam();
1936 #pod
1937 #pod If possible, this form should be used to prevent possible
1938 #pod race conditions.
1939 #pod
1940 #pod See L<File::Spec/tmpdir> for information on the choice of temporary
1941 #pod directory for a particular operating system.
1942 #pod
1943 #pod Will croak() if there is an error.
1944 #pod
1945 #pod Current API available since 0.05.
1946 #pod
1947 #pod =cut
1948
1949 sub tmpnam {
1950
1951   # Retrieve the temporary directory name
1952   my $tmpdir = _wrap_file_spec_tmpdir();
1953
1954   # XXX I don't know under what circumstances this occurs, -- xdg 2016-04-02
1955   croak "Error temporary directory is not writable"
1956     if $tmpdir eq '';
1957
1958   # Use a ten character template and append to tmpdir
1959   my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1960
1961   if (wantarray() ) {
1962     return mkstemp($template);
1963   } else {
1964     return mktemp($template);
1965   }
1966
1967 }
1968
1969 #pod =item B<tmpfile>
1970 #pod
1971 #pod Returns the filehandle of a temporary file.
1972 #pod
1973 #pod   $fh = tmpfile();
1974 #pod
1975 #pod The file is removed when the filehandle is closed or when the program
1976 #pod exits. No access to the filename is provided.
1977 #pod
1978 #pod If the temporary file can not be created undef is returned.
1979 #pod Currently this command will probably not work when the temporary
1980 #pod directory is on an NFS file system.
1981 #pod
1982 #pod Will croak() if there is an error.
1983 #pod
1984 #pod Available since 0.05.
1985 #pod
1986 #pod Returning undef if unable to create file added in 0.12.
1987 #pod
1988 #pod =cut
1989
1990 sub tmpfile {
1991
1992   # Simply call tmpnam() in a list context
1993   my ($fh, $file) = tmpnam();
1994
1995   # Make sure file is removed when filehandle is closed
1996   # This will fail on NFS
1997   unlink0($fh, $file)
1998     or return undef;
1999
2000   return $fh;
2001
2002 }
2003
2004 #pod =back
2005 #pod
2006 #pod =head1 ADDITIONAL FUNCTIONS
2007 #pod
2008 #pod These functions are provided for backwards compatibility
2009 #pod with common tempfile generation C library functions.
2010 #pod
2011 #pod They are not exported and must be addressed using the full package
2012 #pod name.
2013 #pod
2014 #pod =over 4
2015 #pod
2016 #pod =item B<tempnam>
2017 #pod
2018 #pod Return the name of a temporary file in the specified directory
2019 #pod using a prefix. The file is guaranteed not to exist at the time
2020 #pod the function was called, but such guarantees are good for one
2021 #pod clock tick only.  Always use the proper form of C<sysopen>
2022 #pod with C<O_CREAT | O_EXCL> if you must open such a filename.
2023 #pod
2024 #pod   $filename = File::Temp::tempnam( $dir, $prefix );
2025 #pod
2026 #pod Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
2027 #pod (using unix file convention as an example)
2028 #pod
2029 #pod Because this function uses mktemp(), it can suffer from race conditions.
2030 #pod
2031 #pod Will croak() if there is an error.
2032 #pod
2033 #pod Current API available since 0.05.
2034 #pod
2035 #pod =cut
2036
2037 sub tempnam {
2038
2039   croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
2040
2041   my ($dir, $prefix) = @_;
2042
2043   # Add a string to the prefix
2044   $prefix .= 'XXXXXXXX';
2045
2046   # Concatenate the directory to the file
2047   my $template = File::Spec->catfile($dir, $prefix);
2048
2049   return mktemp($template);
2050
2051 }
2052
2053 #pod =back
2054 #pod
2055 #pod =head1 UTILITY FUNCTIONS
2056 #pod
2057 #pod Useful functions for dealing with the filehandle and filename.
2058 #pod
2059 #pod =over 4
2060 #pod
2061 #pod =item B<unlink0>
2062 #pod
2063 #pod Given an open filehandle and the associated filename, make a safe
2064 #pod unlink. This is achieved by first checking that the filename and
2065 #pod filehandle initially point to the same file and that the number of
2066 #pod links to the file is 1 (all fields returned by stat() are compared).
2067 #pod Then the filename is unlinked and the filehandle checked once again to
2068 #pod verify that the number of links on that file is now 0.  This is the
2069 #pod closest you can come to making sure that the filename unlinked was the
2070 #pod same as the file whose descriptor you hold.
2071 #pod
2072 #pod   unlink0($fh, $path)
2073 #pod      or die "Error unlinking file $path safely";
2074 #pod
2075 #pod Returns false on error but croaks() if there is a security
2076 #pod anomaly. The filehandle is not closed since on some occasions this is
2077 #pod not required.
2078 #pod
2079 #pod On some platforms, for example Windows NT, it is not possible to
2080 #pod unlink an open file (the file must be closed first). On those
2081 #pod platforms, the actual unlinking is deferred until the program ends and
2082 #pod good status is returned. A check is still performed to make sure that
2083 #pod the filehandle and filename are pointing to the same thing (but not at
2084 #pod the time the end block is executed since the deferred removal may not
2085 #pod have access to the filehandle).
2086 #pod
2087 #pod Additionally, on Windows NT not all the fields returned by stat() can
2088 #pod be compared. For example, the C<dev> and C<rdev> fields seem to be
2089 #pod different.  Also, it seems that the size of the file returned by stat()
2090 #pod does not always agree, with C<stat(FH)> being more accurate than
2091 #pod C<stat(filename)>, presumably because of caching issues even when
2092 #pod using autoflush (this is usually overcome by waiting a while after
2093 #pod writing to the tempfile before attempting to C<unlink0> it).
2094 #pod
2095 #pod Finally, on NFS file systems the link count of the file handle does
2096 #pod not always go to zero immediately after unlinking. Currently, this
2097 #pod command is expected to fail on NFS disks.
2098 #pod
2099 #pod This function is disabled if the global variable $KEEP_ALL is true
2100 #pod and an unlink on open file is supported. If the unlink is to be deferred
2101 #pod to the END block, the file is still registered for removal.
2102 #pod
2103 #pod This function should not be called if you are using the object oriented
2104 #pod interface since the it will interfere with the object destructor deleting
2105 #pod the file.
2106 #pod
2107 #pod Available Since 0.05.
2108 #pod
2109 #pod If can not unlink open file, defer removal until later available since 0.06.
2110 #pod
2111 #pod =cut
2112
2113 sub unlink0 {
2114
2115   croak 'Usage: unlink0(filehandle, filename)'
2116     unless scalar(@_) == 2;
2117
2118   # Read args
2119   my ($fh, $path) = @_;
2120
2121   cmpstat($fh, $path) or return 0;
2122
2123   # attempt remove the file (does not work on some platforms)
2124   if (_can_unlink_opened_file()) {
2125
2126     # return early (Without unlink) if we have been instructed to retain files.
2127     return 1 if $KEEP_ALL;
2128
2129     # XXX: do *not* call this on a directory; possible race
2130     #      resulting in recursive removal
2131     croak "unlink0: $path has become a directory!" if -d $path;
2132     unlink($path) or return 0;
2133
2134     # Stat the filehandle
2135     my @fh = stat $fh;
2136
2137     print "Link count = $fh[3] \n" if $DEBUG;
2138
2139     # Make sure that the link count is zero
2140     # - Cygwin provides deferred unlinking, however,
2141     #   on Win9x the link count remains 1
2142     # On NFS the link count may still be 1 but we can't know that
2143     # we are on NFS.  Since we can't be sure, we'll defer it
2144
2145     return 1 if $fh[3] == 0 || $^O eq 'cygwin';
2146   }
2147   # fall-through if we can't unlink now
2148   _deferred_unlink($fh, $path, 0);
2149   return 1;
2150 }
2151
2152 #pod =item B<cmpstat>
2153 #pod
2154 #pod Compare C<stat> of filehandle with C<stat> of provided filename.  This
2155 #pod can be used to check that the filename and filehandle initially point
2156 #pod to the same file and that the number of links to the file is 1 (all
2157 #pod fields returned by stat() are compared).
2158 #pod
2159 #pod   cmpstat($fh, $path)
2160 #pod      or die "Error comparing handle with file";
2161 #pod
2162 #pod Returns false if the stat information differs or if the link count is
2163 #pod greater than 1. Calls croak if there is a security anomaly.
2164 #pod
2165 #pod On certain platforms, for example Windows, not all the fields returned by stat()
2166 #pod can be compared. For example, the C<dev> and C<rdev> fields seem to be
2167 #pod different in Windows.  Also, it seems that the size of the file
2168 #pod returned by stat() does not always agree, with C<stat(FH)> being more
2169 #pod accurate than C<stat(filename)>, presumably because of caching issues
2170 #pod even when using autoflush (this is usually overcome by waiting a while
2171 #pod after writing to the tempfile before attempting to C<unlink0> it).
2172 #pod
2173 #pod Not exported by default.
2174 #pod
2175 #pod Current API available since 0.14.
2176 #pod
2177 #pod =cut
2178
2179 sub cmpstat {
2180
2181   croak 'Usage: cmpstat(filehandle, filename)'
2182     unless scalar(@_) == 2;
2183
2184   # Read args
2185   my ($fh, $path) = @_;
2186
2187   warn "Comparing stat\n"
2188     if $DEBUG;
2189
2190   # Stat the filehandle - which may be closed if someone has manually
2191   # closed the file. Can not turn off warnings without using $^W
2192   # unless we upgrade to 5.006 minimum requirement
2193   my @fh;
2194   {
2195     local ($^W) = 0;
2196     @fh = stat $fh;
2197   }
2198   return unless @fh;
2199
2200   if ($fh[3] > 1 && $^W) {
2201     carp "unlink0: fstat found too many links; SB=@fh" if $^W;
2202   }
2203
2204   # Stat the path
2205   my @path = stat $path;
2206
2207   unless (@path) {
2208     carp "unlink0: $path is gone already" if $^W;
2209     return;
2210   }
2211
2212   # this is no longer a file, but may be a directory, or worse
2213   unless (-f $path) {
2214     confess "panic: $path is no longer a file: SB=@fh";
2215   }
2216
2217   # Do comparison of each member of the array
2218   # On WinNT dev and rdev seem to be different
2219   # depending on whether it is a file or a handle.
2220   # Cannot simply compare all members of the stat return
2221   # Select the ones we can use
2222   my @okstat = (0..$#fh);       # Use all by default
2223   if ($^O eq 'MSWin32') {
2224     @okstat = (1,2,3,4,5,7,8,9,10);
2225   } elsif ($^O eq 'os2') {
2226     @okstat = (0, 2..$#fh);
2227   } elsif ($^O eq 'VMS') {      # device and file ID are sufficient
2228     @okstat = (0, 1);
2229   } elsif ($^O eq 'dos') {
2230     @okstat = (0,2..7,11..$#fh);
2231   } elsif ($^O eq 'mpeix') {
2232     @okstat = (0..4,8..10);
2233   }
2234
2235   # Now compare each entry explicitly by number
2236   for (@okstat) {
2237     print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
2238     # Use eq rather than == since rdev, blksize, and blocks (6, 11,
2239     # and 12) will be '' on platforms that do not support them.  This
2240     # is fine since we are only comparing integers.
2241     unless ($fh[$_] eq $path[$_]) {
2242       warn "Did not match $_ element of stat\n" if $DEBUG;
2243       return 0;
2244     }
2245   }
2246
2247   return 1;
2248 }
2249
2250 #pod =item B<unlink1>
2251 #pod
2252 #pod Similar to C<unlink0> except after file comparison using cmpstat, the
2253 #pod filehandle is closed prior to attempting to unlink the file. This
2254 #pod allows the file to be removed without using an END block, but does
2255 #pod mean that the post-unlink comparison of the filehandle state provided
2256 #pod by C<unlink0> is not available.
2257 #pod
2258 #pod   unlink1($fh, $path)
2259 #pod      or die "Error closing and unlinking file";
2260 #pod
2261 #pod Usually called from the object destructor when using the OO interface.
2262 #pod
2263 #pod Not exported by default.
2264 #pod
2265 #pod This function is disabled if the global variable $KEEP_ALL is true.
2266 #pod
2267 #pod Can call croak() if there is a security anomaly during the stat()
2268 #pod comparison.
2269 #pod
2270 #pod Current API available since 0.14.
2271 #pod
2272 #pod =cut
2273
2274 sub unlink1 {
2275   croak 'Usage: unlink1(filehandle, filename)'
2276     unless scalar(@_) == 2;
2277
2278   # Read args
2279   my ($fh, $path) = @_;
2280
2281   cmpstat($fh, $path) or return 0;
2282
2283   # Close the file
2284   close( $fh ) or return 0;
2285
2286   # Make sure the file is writable (for windows)
2287   _force_writable( $path );
2288
2289   # return early (without unlink) if we have been instructed to retain files.
2290   return 1 if $KEEP_ALL;
2291
2292   # remove the file
2293   return unlink($path);
2294 }
2295
2296 #pod =item B<cleanup>
2297 #pod
2298 #pod Calling this function will cause any temp files or temp directories
2299 #pod that are registered for removal to be removed. This happens automatically
2300 #pod when the process exits but can be triggered manually if the caller is sure
2301 #pod that none of the temp files are required. This method can be registered as
2302 #pod an Apache callback.
2303 #pod
2304 #pod Note that if a temp directory is your current directory, it cannot be
2305 #pod removed.  C<chdir()> out of the directory first before calling
2306 #pod C<cleanup()>. (For the cleanup at program exit when the CLEANUP flag
2307 #pod is set, this happens automatically.)
2308 #pod
2309 #pod On OSes where temp files are automatically removed when the temp file
2310 #pod is closed, calling this function will have no effect other than to remove
2311 #pod temporary directories (which may include temporary files).
2312 #pod
2313 #pod   File::Temp::cleanup();
2314 #pod
2315 #pod Not exported by default.
2316 #pod
2317 #pod Current API available since 0.15.
2318 #pod
2319 #pod =back
2320 #pod
2321 #pod =head1 PACKAGE VARIABLES
2322 #pod
2323 #pod These functions control the global state of the package.
2324 #pod
2325 #pod =over 4
2326 #pod
2327 #pod =item B<safe_level>
2328 #pod
2329 #pod Controls the lengths to which the module will go to check the safety of the
2330 #pod temporary file or directory before proceeding.
2331 #pod Options are:
2332 #pod
2333 #pod =over 8
2334 #pod
2335 #pod =item STANDARD
2336 #pod
2337 #pod Do the basic security measures to ensure the directory exists and is
2338 #pod writable, that temporary files are opened only if they do not already
2339 #pod exist, and that possible race conditions are avoided.  Finally the
2340 #pod L<unlink0|"unlink0"> function is used to remove files safely.
2341 #pod
2342 #pod =item MEDIUM
2343 #pod
2344 #pod In addition to the STANDARD security, the output directory is checked
2345 #pod to make sure that it is owned either by root or the user running the
2346 #pod program. If the directory is writable by group or by other, it is then
2347 #pod checked to make sure that the sticky bit is set.
2348 #pod
2349 #pod Will not work on platforms that do not support the C<-k> test
2350 #pod for sticky bit.
2351 #pod
2352 #pod =item HIGH
2353 #pod
2354 #pod In addition to the MEDIUM security checks, also check for the
2355 #pod possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2356 #pod sysconf() function. If this is a possibility, each directory in the
2357 #pod path is checked in turn for safeness, recursively walking back to the
2358 #pod root directory.
2359 #pod
2360 #pod For platforms that do not support the L<POSIX|POSIX>
2361 #pod C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2362 #pod assumed that ``chown() giveaway'' is possible and the recursive test
2363 #pod is performed.
2364 #pod
2365 #pod =back
2366 #pod
2367 #pod The level can be changed as follows:
2368 #pod
2369 #pod   File::Temp->safe_level( File::Temp::HIGH );
2370 #pod
2371 #pod The level constants are not exported by the module.
2372 #pod
2373 #pod Currently, you must be running at least perl v5.6.0 in order to
2374 #pod run with MEDIUM or HIGH security. This is simply because the
2375 #pod safety tests use functions from L<Fcntl|Fcntl> that are not
2376 #pod available in older versions of perl. The problem is that the version
2377 #pod number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2378 #pod they are different versions.
2379 #pod
2380 #pod On systems that do not support the HIGH or MEDIUM safety levels
2381 #pod (for example Win NT or OS/2) any attempt to change the level will
2382 #pod be ignored. The decision to ignore rather than raise an exception
2383 #pod allows portable programs to be written with high security in mind
2384 #pod for the systems that can support this without those programs failing
2385 #pod on systems where the extra tests are irrelevant.
2386 #pod
2387 #pod If you really need to see whether the change has been accepted
2388 #pod simply examine the return value of C<safe_level>.
2389 #pod
2390 #pod   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2391 #pod   die "Could not change to high security"
2392 #pod       if $newlevel != File::Temp::HIGH;
2393 #pod
2394 #pod Available since 0.05.
2395 #pod
2396 #pod =cut
2397
2398 {
2399   # protect from using the variable itself
2400   my $LEVEL = STANDARD;
2401   sub safe_level {
2402     my $self = shift;
2403     if (@_) {
2404       my $level = shift;
2405       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2406         carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2407       } else {
2408         # Don't allow this on perl 5.005 or earlier
2409         if ($] < 5.006 && $level != STANDARD) {
2410           # Cant do MEDIUM or HIGH checks
2411           croak "Currently requires perl 5.006 or newer to do the safe checks";
2412         }
2413         # Check that we are allowed to change level
2414         # Silently ignore if we can not.
2415         $LEVEL = $level if _can_do_level($level);
2416       }
2417     }
2418     return $LEVEL;
2419   }
2420 }
2421
2422 #pod =item TopSystemUID
2423 #pod
2424 #pod This is the highest UID on the current system that refers to a root
2425 #pod UID. This is used to make sure that the temporary directory is
2426 #pod owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2427 #pod simply by root.
2428 #pod
2429 #pod This is required since on many unix systems C</tmp> is not owned
2430 #pod by root.
2431 #pod
2432 #pod Default is to assume that any UID less than or equal to 10 is a root
2433 #pod UID.
2434 #pod
2435 #pod   File::Temp->top_system_uid(10);
2436 #pod   my $topid = File::Temp->top_system_uid;
2437 #pod
2438 #pod This value can be adjusted to reduce security checking if required.
2439 #pod The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2440 #pod
2441 #pod Available since 0.05.
2442 #pod
2443 #pod =cut
2444
2445 {
2446   my $TopSystemUID = 10;
2447   $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2448   sub top_system_uid {
2449     my $self = shift;
2450     if (@_) {
2451       my $newuid = shift;
2452       croak "top_system_uid: UIDs should be numeric"
2453         unless $newuid =~ /^\d+$/s;
2454       $TopSystemUID = $newuid;
2455     }
2456     return $TopSystemUID;
2457   }
2458 }
2459
2460 #pod =item B<$KEEP_ALL>
2461 #pod
2462 #pod Controls whether temporary files and directories should be retained
2463 #pod regardless of any instructions in the program to remove them
2464 #pod automatically.  This is useful for debugging but should not be used in
2465 #pod production code.
2466 #pod
2467 #pod   $File::Temp::KEEP_ALL = 1;
2468 #pod
2469 #pod Default is for files to be removed as requested by the caller.
2470 #pod
2471 #pod In some cases, files will only be retained if this variable is true
2472 #pod when the file is created. This means that you can not create a temporary
2473 #pod file, set this variable and expect the temp file to still be around
2474 #pod when the program exits.
2475 #pod
2476 #pod =item B<$DEBUG>
2477 #pod
2478 #pod Controls whether debugging messages should be enabled.
2479 #pod
2480 #pod   $File::Temp::DEBUG = 1;
2481 #pod
2482 #pod Default is for debugging mode to be disabled.
2483 #pod
2484 #pod Available since 0.15.
2485 #pod
2486 #pod =back
2487 #pod
2488 #pod =head1 WARNING
2489 #pod
2490 #pod For maximum security, endeavour always to avoid ever looking at,
2491 #pod touching, or even imputing the existence of the filename.  You do not
2492 #pod know that that filename is connected to the same file as the handle
2493 #pod you have, and attempts to check this can only trigger more race
2494 #pod conditions.  It's far more secure to use the filehandle alone and
2495 #pod dispense with the filename altogether.
2496 #pod
2497 #pod If you need to pass the handle to something that expects a filename
2498 #pod then on a unix system you can use C<"/dev/fd/" . fileno($fh)> for
2499 #pod arbitrary programs. Perl code that uses the 2-argument version of
2500 #pod C<< open >> can be passed C<< "+<=&" . fileno($fh) >>. Otherwise you
2501 #pod will need to pass the filename. You will have to clear the
2502 #pod close-on-exec bit on that file descriptor before passing it to another
2503 #pod process.
2504 #pod
2505 #pod     use Fcntl qw/F_SETFD F_GETFD/;
2506 #pod     fcntl($tmpfh, F_SETFD, 0)
2507 #pod         or die "Can't clear close-on-exec flag on temp fh: $!\n";
2508 #pod
2509 #pod =head2 Temporary files and NFS
2510 #pod
2511 #pod Some problems are associated with using temporary files that reside
2512 #pod on NFS file systems and it is recommended that a local filesystem
2513 #pod is used whenever possible. Some of the security tests will most probably
2514 #pod fail when the temp file is not local. Additionally, be aware that
2515 #pod the performance of I/O operations over NFS will not be as good as for
2516 #pod a local disk.
2517 #pod
2518 #pod =head2 Forking
2519 #pod
2520 #pod In some cases files created by File::Temp are removed from within an
2521 #pod END block. Since END blocks are triggered when a child process exits
2522 #pod (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2523 #pod to only remove those temp files created by a particular process ID. This
2524 #pod means that a child will not attempt to remove temp files created by the
2525 #pod parent process.
2526 #pod
2527 #pod If you are forking many processes in parallel that are all creating
2528 #pod temporary files, you may need to reset the random number seed using
2529 #pod srand(EXPR) in each child else all the children will attempt to walk
2530 #pod through the same set of random file names and may well cause
2531 #pod themselves to give up if they exceed the number of retry attempts.
2532 #pod
2533 #pod =head2 Directory removal
2534 #pod
2535 #pod Note that if you have chdir'ed into the temporary directory and it is
2536 #pod subsequently cleaned up (either in the END block or as part of object
2537 #pod destruction), then you will get a warning from File::Path::rmtree().
2538 #pod
2539 #pod =head2 Taint mode
2540 #pod
2541 #pod If you need to run code under taint mode, updating to the latest
2542 #pod L<File::Spec> is highly recommended.  On Windows, if the directory
2543 #pod given by L<File::Spec::tmpdir> isn't writable, File::Temp will attempt
2544 #pod to fallback to the user's local application data directory or croak
2545 #pod with an error.
2546 #pod
2547 #pod =head2 BINMODE
2548 #pod
2549 #pod The file returned by File::Temp will have been opened in binary mode
2550 #pod if such a mode is available. If that is not correct, use the C<binmode()>
2551 #pod function to change the mode of the filehandle.
2552 #pod
2553 #pod Note that you can modify the encoding of a file opened by File::Temp
2554 #pod also by using C<binmode()>.
2555 #pod
2556 #pod =head1 HISTORY
2557 #pod
2558 #pod Originally began life in May 1999 as an XS interface to the system
2559 #pod mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2560 #pod translated to Perl for total control of the code's
2561 #pod security checking, to ensure the presence of the function regardless of
2562 #pod operating system and to help with portability. The module was shipped
2563 #pod as a standard part of perl from v5.6.1.
2564 #pod
2565 #pod Thanks to Tom Christiansen for suggesting that this module
2566 #pod should be written and providing ideas for code improvements and
2567 #pod security enhancements.
2568 #pod
2569 #pod =head1 SEE ALSO
2570 #pod
2571 #pod L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2572 #pod
2573 #pod See L<IO::File> and L<File::MkTemp>, L<Apache::TempFile> for
2574 #pod different implementations of temporary file handling.
2575 #pod
2576 #pod See L<File::Tempdir> for an alternative object-oriented wrapper for
2577 #pod the C<tempdir> function.
2578 #pod
2579 #pod =cut
2580
2581 package ## hide from PAUSE
2582   File::Temp::Dir;
2583
2584 our $VERSION = '0.2309';
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.2309
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
2760 =over 4
2761
2762 =item *
2763
2764 Can the OS unlink an open file? If it can not then the
2765 C<_can_unlink_opened_file> method should be modified.
2766
2767 =item *
2768
2769 Are the return values from C<stat> reliable? By default all the
2770 return values from C<stat> are compared when unlinking a temporary
2771 file using the filename and the handle. Operating systems other than
2772 unix do not always have valid entries in all fields. If utility function
2773 C<File::Temp::unlink0> fails then the C<stat> comparison should be
2774 modified accordingly.
2775
2776 =item *
2777
2778 Security. Systems that can not support a test for the sticky bit
2779 on a directory can not use the MEDIUM and HIGH security tests.
2780 The C<_can_do_level> method should be modified accordingly.
2781
2782 =back
2783
2784 =end :__INTERNALS
2785
2786 =head1 OBJECT-ORIENTED INTERFACE
2787
2788 This is the primary interface for interacting with
2789 C<File::Temp>. Using the OO interface a temporary file can be created
2790 when the object is constructed and the file can be removed when the
2791 object is no longer required.
2792
2793 Note that there is no method to obtain the filehandle from the
2794 C<File::Temp> object. The object itself acts as a filehandle.  The object
2795 isa C<IO::Handle> and isa C<IO::Seekable> so all those methods are
2796 available.
2797
2798 Also, the object is configured such that it stringifies to the name of the
2799 temporary file and so can be compared to a filename directly.  It numifies
2800 to the C<refaddr> the same as other handles and so can be compared to other
2801 handles with C<==>.
2802
2803     $fh eq $filename       # as a string
2804     $fh != \*STDOUT        # as a number
2805
2806 Available since 0.14.
2807
2808 =over 4
2809
2810 =item B<new>
2811
2812 Create a temporary file object.
2813
2814   my $tmp = File::Temp->new();
2815
2816 by default the object is constructed as if C<tempfile>
2817 was called without options, but with the additional behaviour
2818 that the temporary file is removed by the object destructor
2819 if UNLINK is set to true (the default).
2820
2821 Supported arguments are the same as for C<tempfile>: UNLINK
2822 (defaulting to true), DIR, EXLOCK and SUFFIX. Additionally, the filename
2823 template is specified using the TEMPLATE option. The OPEN option
2824 is not supported (the file is always opened).
2825
2826  $tmp = File::Temp->new( TEMPLATE => 'tempXXXXX',
2827                         DIR => 'mydir',
2828                         SUFFIX => '.dat');
2829
2830 Arguments are case insensitive.
2831
2832 Can call croak() if an error occurs.
2833
2834 Available since 0.14.
2835
2836 TEMPLATE available since 0.23
2837
2838 =item B<newdir>
2839
2840 Create a temporary directory using an object oriented interface.
2841
2842   $dir = File::Temp->newdir();
2843
2844 By default the directory is deleted when the object goes out of scope.
2845
2846 Supports the same options as the C<tempdir> function. Note that directories
2847 created with this method default to CLEANUP => 1.
2848
2849   $dir = File::Temp->newdir( $template, %options );
2850
2851 A template may be specified either with a leading template or
2852 with a TEMPLATE argument.
2853
2854 Available since 0.19.
2855
2856 TEMPLATE available since 0.23.
2857
2858 =item B<filename>
2859
2860 Return the name of the temporary file associated with this object
2861 (if the object was created using the "new" constructor).
2862
2863   $filename = $tmp->filename;
2864
2865 This method is called automatically when the object is used as
2866 a string.
2867
2868 Current API available since 0.14
2869
2870 =item B<dirname>
2871
2872 Return the name of the temporary directory associated with this
2873 object (if the object was created using the "newdir" constructor).
2874
2875   $dirname = $tmpdir->dirname;
2876
2877 This method is called automatically when the object is used in string context.
2878
2879 =item B<unlink_on_destroy>
2880
2881 Control whether the file is unlinked when the object goes out of scope.
2882 The file is removed if this value is true and $KEEP_ALL is not.
2883
2884  $fh->unlink_on_destroy( 1 );
2885
2886 Default is for the file to be removed.
2887
2888 Current API available since 0.15
2889
2890 =item B<DESTROY>
2891
2892 When the object goes out of scope, the destructor is called. This
2893 destructor will attempt to unlink the file (using L<unlink1|"unlink1">)
2894 if the constructor was called with UNLINK set to 1 (the default state
2895 if UNLINK is not specified).
2896
2897 No error is given if the unlink fails.
2898
2899 If the object has been passed to a child process during a fork, the
2900 file will be deleted when the object goes out of scope in the parent.
2901
2902 For a temporary directory object the directory will be removed unless
2903 the CLEANUP argument was used in the constructor (and set to false) or
2904 C<unlink_on_destroy> was modified after creation.  Note that if a temp
2905 directory is your current directory, it cannot be removed - a warning
2906 will be given in this case.  C<chdir()> out of the directory before
2907 letting the object go out of scope.
2908
2909 If the global variable $KEEP_ALL is true, the file or directory
2910 will not be removed.
2911
2912 =back
2913
2914 =head1 FUNCTIONS
2915
2916 This section describes the recommended interface for generating
2917 temporary files and directories.
2918
2919 =over 4
2920
2921 =item B<tempfile>
2922
2923 This is the basic function to generate temporary files.
2924 The behaviour of the file can be changed using various options:
2925
2926   $fh = tempfile();
2927   ($fh, $filename) = tempfile();
2928
2929 Create a temporary file in  the directory specified for temporary
2930 files, as specified by the tmpdir() function in L<File::Spec>.
2931
2932   ($fh, $filename) = tempfile($template);
2933
2934 Create a temporary file in the current directory using the supplied
2935 template.  Trailing `X' characters are replaced with random letters to
2936 generate the filename.  At least four `X' characters must be present
2937 at the end of the template.
2938
2939   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
2940
2941 Same as previously, except that a suffix is added to the template
2942 after the `X' translation.  Useful for ensuring that a temporary
2943 filename has a particular extension when needed by other applications.
2944 But see the WARNING at the end.
2945
2946   ($fh, $filename) = tempfile($template, DIR => $dir);
2947
2948 Translates the template as before except that a directory name
2949 is specified.
2950
2951   ($fh, $filename) = tempfile($template, TMPDIR => 1);
2952
2953 Equivalent to specifying a DIR of "File::Spec->tmpdir", writing the file
2954 into the same temporary directory as would be used if no template was
2955 specified at all.
2956
2957   ($fh, $filename) = tempfile($template, UNLINK => 1);
2958
2959 Return the filename and filehandle as before except that the file is
2960 automatically removed when the program exits (dependent on
2961 $KEEP_ALL). Default is for the file to be removed if a file handle is
2962 requested and to be kept if the filename is requested. In a scalar
2963 context (where no filename is returned) the file is always deleted
2964 either (depending on the operating system) on exit or when it is
2965 closed (unless $KEEP_ALL is true when the temp file is created).
2966
2967 Use the object-oriented interface if fine-grained control of when
2968 a file is removed is required.
2969
2970 If the template is not specified, a template is always
2971 automatically generated. This temporary file is placed in tmpdir()
2972 (L<File::Spec>) unless a directory is specified explicitly with the
2973 DIR option.
2974
2975   $fh = tempfile( DIR => $dir );
2976
2977 If called in scalar context, only the filehandle is returned and the
2978 file will automatically be deleted when closed on operating systems
2979 that support this (see the description of tmpfile() elsewhere in this
2980 document).  This is the preferred mode of operation, as if you only
2981 have a filehandle, you can never create a race condition by fumbling
2982 with the filename. On systems that can not unlink an open file or can
2983 not mark a file as temporary when it is opened (for example, Windows
2984 NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
2985 the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
2986 flag is ignored if present.
2987
2988   (undef, $filename) = tempfile($template, OPEN => 0);
2989
2990 This will return the filename based on the template but
2991 will not open this file.  Cannot be used in conjunction with
2992 UNLINK set to true. Default is to always open the file
2993 to protect from possible race conditions. A warning is issued
2994 if warnings are turned on. Consider using the tmpnam()
2995 and mktemp() functions described elsewhere in this document
2996 if opening the file is not required.
2997
2998 To open the temporary filehandle with O_EXLOCK (open with exclusive
2999 file lock) use C<< EXLOCK=>1 >>. This is supported only by some
3000 operating systems (most notably BSD derived systems). By default
3001 EXLOCK will be false. Former C<File::Temp> versions set EXLOCK to
3002 true, so to be sure to get an unlocked filehandle also with older
3003 versions, explicitly set C<< EXLOCK=>0 >>.
3004
3005   ($fh, $filename) = tempfile($template, EXLOCK => 1);
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 Slaven Rezic Peter Rabbitson Olivier Mengue Kevin Ryde John Acklam James E. Keenan Brian Mowrey Dagfinn Ilmari Mannsåker Steinbrunner Ed Avis Guillem Jover Ben Tilly
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 Slaven Rezic <slaven@rezic.de>
3624
3625 =item *
3626
3627 Peter Rabbitson <ribasushi@cpan.org>
3628
3629 =item *
3630
3631 Olivier Mengue <dolmen@cpan.org>
3632
3633 =item *
3634
3635 David Golden <xdg@xdg.me>
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 James E. Keenan <jkeen@verizon.net>
3652
3653 =item *
3654
3655 Brian Mowrey <brian@drlabs.org>
3656
3657 =item *
3658
3659 Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
3660
3661 =item *
3662
3663 David Steinbrunner <dsteinbrunner@pobox.com>
3664
3665 =item *
3666
3667 Ed Avis <eda@linux01.wcl.local>
3668
3669 =item *
3670
3671 Guillem Jover <guillem@hadrons.org>
3672
3673 =item *
3674
3675 Ben Tilly <btilly@gmail.com>
3676
3677 =back
3678
3679 =head1 COPYRIGHT AND LICENSE
3680
3681 This software is copyright (c) 2019 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