lib/File/Temp.pm

   1 package File::Temp;
   2
   3 =head1 NAME
   4
   5 File::Temp - return name and handle of a temporary file safely
   6
   7 =begin __INTERNALS
   8
   9 =head1 PORTABILITY
  10
  11 This section is at the top in order to provide easier access to
  12 porters.  It is not expected to be rendered by a standard pod
  13 formatting tool. Please skip straight to the SYNOPSIS section if you
  14 are not trying to port this module to a new platform.
  15
  16 This module is designed to be portable across operating systems and it
  17 currently supports Unix, VMS, DOS, OS/2, Windows and Mac OS
  18 (Classic). When porting to a new OS there are generally three main
  19 issues that have to be solved:
  20
  21 =over 4
  22
  23 =item *
  24
  25 Can the OS unlink an open file? If it can not then the
  26 C<_can_unlink_opened_file> method should be modified.
  27
  28 =item *
  29
  30 Are the return values from C<stat> reliable? By default all the
  31 return values from C<stat> are compared when unlinking a temporary
  32 file using the filename and the handle. Operating systems other than
  33 unix do not always have valid entries in all fields. If C<unlink0> fails
  34 then the C<stat> comparison should be modified accordingly.
  35
  36 =item *
  37
  38 Security. Systems that can not support a test for the sticky bit
  39 on a directory can not use the MEDIUM and HIGH security tests.
  40 The C<_can_do_level> method should be modified accordingly.
  41
  42 =back
  43
  44 =end __INTERNALS
  45
  46 =head1 SYNOPSIS
  47
  48   use File::Temp qw/ tempfile tempdir /;
  49
  50   $fh = tempfile();
  51   ($fh, $filename) = tempfile();
  52
  53   ($fh, $filename) = tempfile( $template, DIR => $dir);
  54   ($fh, $filename) = tempfile( $template, SUFFIX => '.dat');
  55
  56
  57   $dir = tempdir( CLEANUP => 1 );
  58   ($fh, $filename) = tempfile( DIR => $dir );
  59
  60 Object interface:
  61
  62   require File::Temp;
  63   use File::Temp ();
  64
  65   $fh = new File::Temp($template);
  66   $fname = $fh->filename;
  67
  68   $tmp = new File::Temp( UNLINK => 0, SUFFIX => '.dat' );
  69   print $tmp "Some data\n";
  70   print "Filename is $tmp\n";
  71
  72 The following interfaces are provided for compatibility with
  73 existing APIs. They should not be used in new code.
  74
  75 MkTemp family:
  76
  77   use File::Temp qw/ :mktemp  /;
  78
  79   ($fh, $file) = mkstemp( "tmpfileXXXXX" );
  80   ($fh, $file) = mkstemps( "tmpfileXXXXXX", $suffix);
  81
  82   $tmpdir = mkdtemp( $template );
  83
  84   $unopened_file = mktemp( $template );
  85
  86 POSIX functions:
  87
  88   use File::Temp qw/ :POSIX /;
  89
  90   $file = tmpnam();
  91   $fh = tmpfile();
  92
  93   ($fh, $file) = tmpnam();
  94
  95 Compatibility functions:
  96
  97   $unopened_file = File::Temp::tempnam( $dir, $pfx );
  98
  99 =head1 DESCRIPTION
 100
 101 C<File::Temp> can be used to create and open temporary files in a safe
 102 way.  There is both a function interface and an object-oriented
 103 interface.  The File::Temp constructor or the tempfile() function can
 104 be used to return the name and the open filehandle of a temporary
 105 file.  The tempdir() function can be used to create a temporary
 106 directory.
 107
 108 The security aspect of temporary file creation is emphasized such that
 109 a filehandle and filename are returned together.  This helps guarantee
 110 that a race condition can not occur where the temporary file is
 111 created by another process between checking for the existence of the
 112 file and its opening.  Additional security levels are provided to
 113 check, for example, that the sticky bit is set on world writable
 114 directories.  See L<"safe_level"> for more information.
 115
 116 For compatibility with popular C library functions, Perl implementations of
 117 the mkstemp() family of functions are provided. These are, mkstemp(),
 118 mkstemps(), mkdtemp() and mktemp().
 119
 120 Additionally, implementations of the standard L<POSIX|POSIX>
 121 tmpnam() and tmpfile() functions are provided if required.
 122
 123 Implementations of mktemp(), tmpnam(), and tempnam() are provided,
 124 but should be used with caution since they return only a filename
 125 that was valid when function was called, so cannot guarantee
 126 that the file will not exist by the time the caller opens the filename.
 127
 128 =cut
 129
 130 # 5.6.0 gives us S_IWOTH, S_IWGRP, our and auto-vivifying filehandls
 131 # People would like a version on 5.005 so give them what they want :-)
 132 use 5.005;
 133 use strict;
 134 use Carp;
 135 use File::Spec 0.8;
 136 use File::Path qw/ rmtree /;
 137 use Fcntl 1.03;
 138 use Errno;
 139 require VMS::Stdio if $^O eq 'VMS';
 140
 141 # Need the Symbol package if we are running older perl
 142 require Symbol if $] < 5.006;
 143
 144 ### For the OO interface
 145 use base qw/ IO::Handle /;
 146 use overload '""' => "STRINGIFY";
 147
 148
 149 # use 'our' on v5.6.0
 150 use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG $KEEP_ALL);
 151
 152 $DEBUG = 0;
 153 $KEEP_ALL = 0;
 154
 155 # We are exporting functions
 156
 157 use base qw/Exporter/;
 158
 159 # Export list - to allow fine tuning of export table
 160
 161 @EXPORT_OK = qw{
 162               tempfile
 163               tempdir
 164               tmpnam
 165               tmpfile
 166               mktemp
 167               mkstemp
 168               mkstemps
 169               mkdtemp
 170               unlink0
 171               cleanup
 172                 };
 173
 174 # Groups of functions for export
 175
 176 %EXPORT_TAGS = (
 177                 'POSIX' => [qw/ tmpnam tmpfile /],
 178                 'mktemp' => [qw/ mktemp mkstemp mkstemps mkdtemp/],
 179                );
 180
 181 # add contents of these tags to @EXPORT
 182 Exporter::export_tags('POSIX','mktemp');
 183
 184 # Version number
 185
 186 $VERSION = '0.16';
 187
 188 # This is a list of characters that can be used in random filenames
 189
 190 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
 191                  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
 192                  0 1 2 3 4 5 6 7 8 9 _
 193              /);
 194
 195 # Maximum number of tries to make a temp file before failing
 196
 197 use constant MAX_TRIES => 1000;
 198
 199 # Minimum number of X characters that should be in a template
 200 use constant MINX => 4;
 201
 202 # Default template when no template supplied
 203
 204 use constant TEMPXXX => 'X' x 10;
 205
 206 # Constants for the security level
 207
 208 use constant STANDARD => 0;
 209 use constant MEDIUM   => 1;
 210 use constant HIGH     => 2;
 211
 212 # OPENFLAGS. If we defined the flag to use with Sysopen here this gives
 213 # us an optimisation when many temporary files are requested
 214
 215 my $OPENFLAGS = O_CREAT | O_EXCL | O_RDWR;
 216
 217 unless ($^O eq 'MacOS') {
 218   for my $oflag (qw/ NOFOLLOW BINARY LARGEFILE EXLOCK NOINHERIT /) {
 219     my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
 220     no strict 'refs';
 221     $OPENFLAGS |= $bit if eval {
 222       # Make sure that redefined die handlers do not cause problems
 223       # eg CGI::Carp
 224       local $SIG{__DIE__} = sub {};
 225       local $SIG{__WARN__} = sub {};
 226       $bit = &$func();
 227       1;
 228     };
 229   }
 230 }
 231
 232 # On some systems the O_TEMPORARY flag can be used to tell the OS
 233 # to automatically remove the file when it is closed. This is fine
 234 # in most cases but not if tempfile is called with UNLINK=>0 and
 235 # the filename is requested -- in the case where the filename is to
 236 # be passed to another routine. This happens on windows. We overcome
 237 # this by using a second open flags variable
 238
 239 my $OPENTEMPFLAGS = $OPENFLAGS;
 240 unless ($^O eq 'MacOS') {
 241   for my $oflag (qw/ TEMPORARY /) {
 242     my ($bit, $func) = (0, "Fcntl::O_" . $oflag);
 243     no strict 'refs';
 244     $OPENTEMPFLAGS |= $bit if eval {
 245       # Make sure that redefined die handlers do not cause problems
 246       # eg CGI::Carp
 247       local $SIG{__DIE__} = sub {};
 248       local $SIG{__WARN__} = sub {};
 249       $bit = &$func();
 250       1;
 251     };
 252   }
 253 }
 254
 255 # INTERNAL ROUTINES - not to be used outside of package
 256
 257 # Generic routine for getting a temporary filename
 258 # modelled on OpenBSD _gettemp() in mktemp.c
 259
 260 # The template must contain X's that are to be replaced
 261 # with the random values
 262
 263 #  Arguments:
 264
 265 #  TEMPLATE   - string containing the XXXXX's that is converted
 266 #           to a random filename and opened if required
 267
 268 # Optionally, a hash can also be supplied containing specific options
 269 #   "open" => if true open the temp file, else just return the name
 270 #             default is 0
 271 #   "mkdir"=> if true, we are creating a temp directory rather than tempfile
 272 #             default is 0
 273 #   "suffixlen" => number of characters at end of PATH to be ignored.
 274 #                  default is 0.
 275 #   "unlink_on_close" => indicates that, if possible,  the OS should remove
 276 #                        the file as soon as it is closed. Usually indicates
 277 #                        use of the O_TEMPORARY flag to sysopen.
 278 #                        Usually irrelevant on unix
 279
 280 # Optionally a reference to a scalar can be passed into the function
 281 # On error this will be used to store the reason for the error
 282 #   "ErrStr"  => \$errstr
 283
 284 # "open" and "mkdir" can not both be true
 285 # "unlink_on_close" is not used when "mkdir" is true.
 286
 287 # The default options are equivalent to mktemp().
 288
 289 # Returns:
 290 #   filehandle - open file handle (if called with doopen=1, else undef)
 291 #   temp name  - name of the temp file or directory
 292
 293 # For example:
 294 #   ($fh, $name) = _gettemp($template, "open" => 1);
 295
 296 # for the current version, failures are associated with
 297 # stored in an error string and returned to give the reason whilst debugging
 298 # This routine is not called by any external function
 299 sub _gettemp {
 300
 301   croak 'Usage: ($fh, $name) = _gettemp($template, OPTIONS);'
 302     unless scalar(@_) >= 1;
 303
 304   # the internal error string - expect it to be overridden
 305   # Need this in case the caller decides not to supply us a value
 306   # need an anonymous scalar
 307   my $tempErrStr;
 308
 309   # Default options
 310   my %options = (
 311                  "open" => 0,
 312                  "mkdir" => 0,
 313                  "suffixlen" => 0,
 314                  "unlink_on_close" => 0,
 315                  "ErrStr" => \$tempErrStr,
 316                 );
 317
 318   # Read the template
 319   my $template = shift;
 320   if (ref($template)) {
 321     # Use a warning here since we have not yet merged ErrStr
 322     carp "File::Temp::_gettemp: template must not be a reference";
 323     return ();
 324   }
 325
 326   # Check that the number of entries on stack are even
 327   if (scalar(@_) % 2 != 0) {
 328     # Use a warning here since we have not yet merged ErrStr
 329     carp "File::Temp::_gettemp: Must have even number of options";
 330     return ();
 331   }
 332
 333   # Read the options and merge with defaults
 334   %options = (%options, @_)  if @_;
 335
 336   # Make sure the error string is set to undef
 337   ${$options{ErrStr}} = undef;
 338
 339   # Can not open the file and make a directory in a single call
 340   if ($options{"open"} && $options{"mkdir"}) {
 341     ${$options{ErrStr}} = "doopen and domkdir can not both be true\n";
 342     return ();
 343   }
 344
 345   # Find the start of the end of the  Xs (position of last X)
 346   # Substr starts from 0
 347   my $start = length($template) - 1 - $options{"suffixlen"};
 348
 349   # Check that we have at least MINX x X (eg 'XXXX") at the end of the string
 350   # (taking suffixlen into account). Any fewer is insecure.
 351
 352   # Do it using substr - no reason to use a pattern match since
 353   # we know where we are looking and what we are looking for
 354
 355   if (substr($template, $start - MINX + 1, MINX) ne 'X' x MINX) {
 356     ${$options{ErrStr}} = "The template must end with at least ".
 357       MINX . " 'X' characters\n";
 358     return ();
 359   }
 360
 361   # Replace all the X at the end of the substring with a
 362   # random character or just all the XX at the end of a full string.
 363   # Do it as an if, since the suffix adjusts which section to replace
 364   # and suffixlen=0 returns nothing if used in the substr directly
 365   # and generate a full path from the template
 366
 367   my $path = _replace_XX($template, $options{"suffixlen"});
 368
 369
 370   # Split the path into constituent parts - eventually we need to check
 371   # whether the directory exists
 372   # We need to know whether we are making a temp directory
 373   # or a tempfile
 374
 375   my ($volume, $directories, $file);
 376   my $parent; # parent directory
 377   if ($options{"mkdir"}) {
 378     # There is no filename at the end
 379     ($volume, $directories, $file) = File::Spec->splitpath( $path, 1);
 380
 381     # The parent is then $directories without the last directory
 382     # Split the directory and put it back together again
 383     my @dirs = File::Spec->splitdir($directories);
 384
 385     # If @dirs only has one entry (i.e. the directory template) that means
 386     # we are in the current directory
 387     if ($#dirs == 0) {
 388       $parent = File::Spec->curdir;
 389     } else {
 390
 391       if ($^O eq 'VMS') {  # need volume to avoid relative dir spec
 392         $parent = File::Spec->catdir($volume, @dirs[0..$#dirs-1]);
 393         $parent = 'sys$disk:[]' if $parent eq '';
 394       } else {
 395
 396         # Put it back together without the last one
 397         $parent = File::Spec->catdir(@dirs[0..$#dirs-1]);
 398
 399         # ...and attach the volume (no filename)
 400         $parent = File::Spec->catpath($volume, $parent, '');
 401       }
 402
 403     }
 404
 405   } else {
 406
 407     # Get rid of the last filename (use File::Basename for this?)
 408     ($volume, $directories, $file) = File::Spec->splitpath( $path );
 409
 410     # Join up without the file part
 411     $parent = File::Spec->catpath($volume,$directories,'');
 412
 413     # If $parent is empty replace with curdir
 414     $parent = File::Spec->curdir
 415       unless $directories ne '';
 416
 417   }
 418
 419   # Check that the parent directories exist
 420   # Do this even for the case where we are simply returning a name
 421   # not a file -- no point returning a name that includes a directory
 422   # that does not exist or is not writable
 423
 424   unless (-d $parent) {
 425     ${$options{ErrStr}} = "Parent directory ($parent) is not a directory";
 426     return ();
 427   }
 428   unless (-w $parent) {
 429     ${$options{ErrStr}} = "Parent directory ($parent) is not writable\n";
 430       return ();
 431   }
 432
 433
 434   # Check the stickiness of the directory and chown giveaway if required
 435   # If the directory is world writable the sticky bit
 436   # must be set
 437
 438   if (File::Temp->safe_level == MEDIUM) {
 439     my $safeerr;
 440     unless (_is_safe($parent,\$safeerr)) {
 441       ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
 442       return ();
 443     }
 444   } elsif (File::Temp->safe_level == HIGH) {
 445     my $safeerr;
 446     unless (_is_verysafe($parent, \$safeerr)) {
 447       ${$options{ErrStr}} = "Parent directory ($parent) is not safe ($safeerr)";
 448       return ();
 449     }
 450   }
 451
 452
 453   # Now try MAX_TRIES time to open the file
 454   for (my $i = 0; $i < MAX_TRIES; $i++) {
 455
 456     # Try to open the file if requested
 457     if ($options{"open"}) {
 458       my $fh;
 459
 460       # If we are running before perl5.6.0 we can not auto-vivify
 461       if ($] < 5.006) {
 462         $fh = &Symbol::gensym;
 463       }
 464
 465       # Try to make sure this will be marked close-on-exec
 466       # XXX: Win32 doesn't respect this, nor the proper fcntl,
 467       #      but may have O_NOINHERIT. This may or may not be in Fcntl.
 468       local $^F = 2;
 469
 470       # Store callers umask
 471       my $umask = umask();
 472
 473       # Set a known umask
 474       umask(066);
 475
 476       # Attempt to open the file
 477       my $open_success = undef;
 478       if ( $^O eq 'VMS' and $options{"unlink_on_close"} && !$KEEP_ALL) {
 479         # make it auto delete on close by setting FAB$V_DLT bit
 480         $fh = VMS::Stdio::vmssysopen($path, $OPENFLAGS, 0600, 'fop=dlt');
 481         $open_success = $fh;
 482       } else {
 483         my $flags = ( ($options{"unlink_on_close"} && !$KEEP_ALL) ?
 484                       $OPENTEMPFLAGS :
 485                       $OPENFLAGS );
 486         $open_success = sysopen($fh, $path, $flags, 0600);
 487       }
 488       if ( $open_success ) {
 489
 490         # Reset umask
 491         umask($umask) if defined $umask;
 492
 493         # Opened successfully - return file handle and name
 494         return ($fh, $path);
 495
 496       } else {
 497         # Reset umask
 498         umask($umask) if defined $umask;
 499
 500         # Error opening file - abort with error
 501         # if the reason was anything but EEXIST
 502         unless ($!{EEXIST}) {
 503           ${$options{ErrStr}} = "Could not create temp file $path: $!";
 504           return ();
 505         }
 506
 507         # Loop round for another try
 508
 509       }
 510     } elsif ($options{"mkdir"}) {
 511
 512       # Store callers umask
 513       my $umask = umask();
 514
 515       # Set a known umask
 516       umask(066);
 517
 518       # Open the temp directory
 519       if (mkdir( $path, 0700)) {
 520         # created okay
 521         # Reset umask
 522         umask($umask) if defined $umask;
 523
 524         return undef, $path;
 525       } else {
 526
 527         # Reset umask
 528         umask($umask) if defined $umask;
 529
 530         # Abort with error if the reason for failure was anything
 531         # except EEXIST
 532         unless ($!{EEXIST}) {
 533           ${$options{ErrStr}} = "Could not create directory $path: $!";
 534           return ();
 535         }
 536
 537         # Loop round for another try
 538
 539       }
 540
 541     } else {
 542
 543       # Return true if the file can not be found
 544       # Directory has been checked previously
 545
 546       return (undef, $path) unless -e $path;
 547
 548       # Try again until MAX_TRIES
 549
 550     }
 551
 552     # Did not successfully open the tempfile/dir
 553     # so try again with a different set of random letters
 554     # No point in trying to increment unless we have only
 555     # 1 X say and the randomness could come up with the same
 556     # file MAX_TRIES in a row.
 557
 558     # Store current attempt - in principal this implies that the
 559     # 3rd time around the open attempt that the first temp file
 560     # name could be generated again. Probably should store each
 561     # attempt and make sure that none are repeated
 562
 563     my $original = $path;
 564     my $counter = 0;  # Stop infinite loop
 565     my $MAX_GUESS = 50;
 566
 567     do {
 568
 569       # Generate new name from original template
 570       $path = _replace_XX($template, $options{"suffixlen"});
 571
 572       $counter++;
 573
 574     } until ($path ne $original || $counter > $MAX_GUESS);
 575
 576     # Check for out of control looping
 577     if ($counter > $MAX_GUESS) {
 578       ${$options{ErrStr}} = "Tried to get a new temp name different to the previous value $MAX_GUESS times.\nSomething wrong with template?? ($template)";
 579       return ();
 580     }
 581
 582   }
 583
 584   # If we get here, we have run out of tries
 585   ${ $options{ErrStr} } = "Have exceeded the maximum number of attempts ("
 586     . MAX_TRIES . ") to open temp file/dir";
 587
 588   return ();
 589
 590 }
 591
 592 # Internal routine to return a random character from the
 593 # character list. Does not do an srand() since rand()
 594 # will do one automatically
 595
 596 # No arguments. Return value is the random character
 597
 598 # No longer called since _replace_XX runs a few percent faster if
 599 # I inline the code. This is important if we are creating thousands of
 600 # temporary files.
 601
 602 sub _randchar {
 603
 604   $CHARS[ int( rand( $#CHARS ) ) ];
 605
 606 }
 607
 608 # Internal routine to replace the XXXX... with random characters
 609 # This has to be done by _gettemp() every time it fails to
 610 # open a temp file/dir
 611
 612 # Arguments:  $template (the template with XXX),
 613 #             $ignore   (number of characters at end to ignore)
 614
 615 # Returns:    modified template
 616
 617 sub _replace_XX {
 618
 619   croak 'Usage: _replace_XX($template, $ignore)'
 620     unless scalar(@_) == 2;
 621
 622   my ($path, $ignore) = @_;
 623
 624   # Do it as an if, since the suffix adjusts which section to replace
 625   # and suffixlen=0 returns nothing if used in the substr directly
 626   # Alternatively, could simply set $ignore to length($path)-1
 627   # Don't want to always use substr when not required though.
 628
 629   if ($ignore) {
 630     substr($path, 0, - $ignore) =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
 631   } else {
 632     $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
 633   }
 634   return $path;
 635 }
 636
 637 # Internal routine to force a temp file to be writable after
 638 # it is created so that we can unlink it. Windows seems to occassionally
 639 # force a file to be readonly when written to certain temp locations
 640 sub _force_writable {
 641   my $file = shift;
 642   my $umask = umask();
 643   umask(066);
 644   chmod 0600, $file;
 645   umask($umask) if defined $umask;
 646 }
 647
 648
 649 # internal routine to check to see if the directory is safe
 650 # First checks to see if the directory is not owned by the
 651 # current user or root. Then checks to see if anyone else
 652 # can write to the directory and if so, checks to see if
 653 # it has the sticky bit set
 654
 655 # Will not work on systems that do not support sticky bit
 656
 657 #Args:  directory path to check
 658 #       Optionally: reference to scalar to contain error message
 659 # Returns true if the path is safe and false otherwise.
 660 # Returns undef if can not even run stat() on the path
 661
 662 # This routine based on version written by Tom Christiansen
 663
 664 # Presumably, by the time we actually attempt to create the
 665 # file or directory in this directory, it may not be safe
 666 # anymore... Have to run _is_safe directly after the open.
 667
 668 sub _is_safe {
 669
 670   my $path = shift;
 671   my $err_ref = shift;
 672
 673   # Stat path
 674   my @info = stat($path);
 675   unless (scalar(@info)) {
 676     $$err_ref = "stat(path) returned no values";
 677     return 0;
 678   };
 679   return 1 if $^O eq 'VMS';  # owner delete control at file level
 680
 681   # Check to see whether owner is neither superuser (or a system uid) nor me
 682   # Use the real uid from the $< variable
 683   # UID is in [4]
 684   if ($info[4] > File::Temp->top_system_uid() && $info[4] != $<) {
 685
 686     Carp::cluck(sprintf "uid=$info[4] topuid=%s \$<=$< path='$path'",
 687                 File::Temp->top_system_uid());
 688
 689     $$err_ref = "Directory owned neither by root nor the current user"
 690       if ref($err_ref);
 691     return 0;
 692   }
 693
 694   # check whether group or other can write file
 695   # use 066 to detect either reading or writing
 696   # use 022 to check writability
 697   # Do it with S_IWOTH and S_IWGRP for portability (maybe)
 698   # mode is in info[2]
 699   if (($info[2] & &Fcntl::S_IWGRP) ||   # Is group writable?
 700       ($info[2] & &Fcntl::S_IWOTH) ) {  # Is world writable?
 701     # Must be a directory
 702     unless (-d $path) {
 703       $$err_ref = "Path ($path) is not a directory"
 704       if ref($err_ref);
 705       return 0;
 706     }
 707     # Must have sticky bit set
 708     unless (-k $path) {
 709       $$err_ref = "Sticky bit not set on $path when dir is group|world writable"
 710         if ref($err_ref);
 711       return 0;
 712     }
 713   }
 714
 715   return 1;
 716 }
 717
 718 # Internal routine to check whether a directory is safe
 719 # for temp files. Safer than _is_safe since it checks for
 720 # the possibility of chown giveaway and if that is a possibility
 721 # checks each directory in the path to see if it is safe (with _is_safe)
 722
 723 # If _PC_CHOWN_RESTRICTED is not set, does the full test of each
 724 # directory anyway.
 725
 726 # Takes optional second arg as scalar ref to error reason
 727
 728 sub _is_verysafe {
 729
 730   # Need POSIX - but only want to bother if really necessary due to overhead
 731   require POSIX;
 732
 733   my $path = shift;
 734   print "_is_verysafe testing $path\n" if $DEBUG;
 735   return 1 if $^O eq 'VMS';  # owner delete control at file level
 736
 737   my $err_ref = shift;
 738
 739   # Should Get the value of _PC_CHOWN_RESTRICTED if it is defined
 740   # and If it is not there do the extensive test
 741   my $chown_restricted;
 742   $chown_restricted = &POSIX::_PC_CHOWN_RESTRICTED()
 743     if eval { &POSIX::_PC_CHOWN_RESTRICTED(); 1};
 744
 745   # If chown_resticted is set to some value we should test it
 746   if (defined $chown_restricted) {
 747
 748     # Return if the current directory is safe
 749     return _is_safe($path,$err_ref) if POSIX::sysconf( $chown_restricted );
 750
 751   }
 752
 753   # To reach this point either, the _PC_CHOWN_RESTRICTED symbol
 754   # was not avialable or the symbol was there but chown giveaway
 755   # is allowed. Either way, we now have to test the entire tree for
 756   # safety.
 757
 758   # Convert path to an absolute directory if required
 759   unless (File::Spec->file_name_is_absolute($path)) {
 760     $path = File::Spec->rel2abs($path);
 761   }
 762
 763   # Split directory into components - assume no file
 764   my ($volume, $directories, undef) = File::Spec->splitpath( $path, 1);
 765
 766   # Slightly less efficient than having a function in File::Spec
 767   # to chop off the end of a directory or even a function that
 768   # can handle ../ in a directory tree
 769   # Sometimes splitdir() returns a blank at the end
 770   # so we will probably check the bottom directory twice in some cases
 771   my @dirs = File::Spec->splitdir($directories);
 772
 773   # Concatenate one less directory each time around
 774   foreach my $pos (0.. $#dirs) {
 775     # Get a directory name
 776     my $dir = File::Spec->catpath($volume,
 777                                   File::Spec->catdir(@dirs[0.. $#dirs - $pos]),
 778                                   ''
 779                                   );
 780
 781     print "TESTING DIR $dir\n" if $DEBUG;
 782
 783     # Check the directory
 784     return 0 unless _is_safe($dir,$err_ref);
 785
 786   }
 787
 788   return 1;
 789 }
 790
 791
 792
 793 # internal routine to determine whether unlink works on this
 794 # platform for files that are currently open.
 795 # Returns true if we can, false otherwise.
 796
 797 # Currently WinNT, OS/2 and VMS can not unlink an opened file
 798 # On VMS this is because the O_EXCL flag is used to open the
 799 # temporary file. Currently I do not know enough about the issues
 800 # on VMS to decide whether O_EXCL is a requirement.
 801
 802 sub _can_unlink_opened_file {
 803
 804   if ($^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'VMS' || $^O eq 'dos' || $^O eq 'MacOS') {
 805     return 0;
 806   } else {
 807     return 1;
 808   }
 809
 810 }
 811
 812 # internal routine to decide which security levels are allowed
 813 # see safe_level() for more information on this
 814
 815 # Controls whether the supplied security level is allowed
 816
 817 #   $cando = _can_do_level( $level )
 818
 819 sub _can_do_level {
 820
 821   # Get security level
 822   my $level = shift;
 823
 824   # Always have to be able to do STANDARD
 825   return 1 if $level == STANDARD;
 826
 827   # Currently, the systems that can do HIGH or MEDIUM are identical
 828   if ( $^O eq 'MSWin32' || $^O eq 'os2' || $^O eq 'cygwin' || $^O eq 'dos' || $^O eq 'MacOS' || $^O eq 'mpeix') {
 829     return 0;
 830   } else {
 831     return 1;
 832   }
 833
 834 }
 835
 836 # This routine sets up a deferred unlinking of a specified
 837 # filename and filehandle. It is used in the following cases:
 838 #  - Called by unlink0 if an opened file can not be unlinked
 839 #  - Called by tempfile() if files are to be removed on shutdown
 840 #  - Called by tempdir() if directories are to be removed on shutdown
 841
 842 # Arguments:
 843 #   _deferred_unlink( $fh, $fname, $isdir );
 844 #
 845 #   - filehandle (so that it can be expclicitly closed if open
 846 #   - filename   (the thing we want to remove)
 847 #   - isdir      (flag to indicate that we are being given a directory)
 848 #                 [and hence no filehandle]
 849
 850 # Status is not referred to since all the magic is done with an END block
 851
 852 {
 853   # Will set up two lexical variables to contain all the files to be
 854   # removed. One array for files, another for directories They will
 855   # only exist in this block.
 856
 857   #  This means we only have to set up a single END block to remove
 858   #  all files.
 859
 860   # in order to prevent child processes inadvertently deleting the parent
 861   # temp files we use a hash to store the temp files and directories
 862   # created by a particular process id.
 863
 864   # %files_to_unlink contains values that are references to an array of
 865   # array references containing the filehandle and filename associated with
 866   # the temp file.
 867   my (%files_to_unlink, %dirs_to_unlink);
 868
 869   # Set up an end block to use these arrays
 870   END {
 871     cleanup();
 872   }
 873
 874   # Cleanup function. Always triggered on END but can be invoked
 875   # manually.
 876   sub cleanup {
 877     if (!$KEEP_ALL) {
 878       # Files
 879       my @files = (exists $files_to_unlink{$$} ?
 880                    @{ $files_to_unlink{$$} } : () );
 881       foreach my $file (@files) {
 882         # close the filehandle without checking its state
 883         # in order to make real sure that this is closed
 884         # if its already closed then I dont care about the answer
 885         # probably a better way to do this
 886         close($file->[0]);  # file handle is [0]
 887
 888         if (-f $file->[1]) {  # file name is [1]
 889           _force_writable( $file->[1] ); # for windows
 890           unlink $file->[1] or warn "Error removing ".$file->[1];
 891         }
 892       }
 893       # Dirs
 894       my @dirs = (exists $dirs_to_unlink{$$} ?
 895                   @{ $dirs_to_unlink{$$} } : () );
 896       foreach my $dir (@dirs) {
 897         if (-d $dir) {
 898           rmtree($dir, $DEBUG, 0);
 899         }
 900       }
 901
 902       # clear the arrays
 903       @{ $files_to_unlink{$$} } = ()
 904         if exists $files_to_unlink{$$};
 905       @{ $dirs_to_unlink{$$} } = ()
 906         if exists $dirs_to_unlink{$$};
 907     }
 908   }
 909
 910
 911   # This is the sub called to register a file for deferred unlinking
 912   # This could simply store the input parameters and defer everything
 913   # until the END block. For now we do a bit of checking at this
 914   # point in order to make sure that (1) we have a file/dir to delete
 915   # and (2) we have been called with the correct arguments.
 916   sub _deferred_unlink {
 917
 918     croak 'Usage:  _deferred_unlink($fh, $fname, $isdir)'
 919       unless scalar(@_) == 3;
 920
 921     my ($fh, $fname, $isdir) = @_;
 922
 923     warn "Setting up deferred removal of $fname\n"
 924       if $DEBUG;
 925
 926     # If we have a directory, check that it is a directory
 927     if ($isdir) {
 928
 929       if (-d $fname) {
 930
 931         # Directory exists so store it
 932         # first on VMS turn []foo into [.foo] for rmtree
 933         $fname = VMS::Filespec::vmspath($fname) if $^O eq 'VMS';
 934         $dirs_to_unlink{$$} = []
 935           unless exists $dirs_to_unlink{$$};
 936         push (@{ $dirs_to_unlink{$$} }, $fname);
 937
 938       } else {
 939         carp "Request to remove directory $fname could not be completed since it does not exist!\n" if $^W;
 940       }
 941
 942     } else {
 943
 944       if (-f $fname) {
 945
 946         # file exists so store handle and name for later removal
 947         $files_to_unlink{$$} = []
 948           unless exists $files_to_unlink{$$};
 949         push(@{ $files_to_unlink{$$} }, [$fh, $fname]);
 950
 951       } else {
 952         carp "Request to remove file $fname could not be completed since it is not there!\n" if $^W;
 953       }
 954
 955     }
 956
 957   }
 958
 959
 960 }
 961
 962 =head1 OBJECT-ORIENTED INTERFACE
 963
 964 This is the primary interface for interacting with
 965 C<File::Temp>. Using the OO interface a temporary file can be created
 966 when the object is constructed and the file can be removed when the
 967 object is no longer required.
 968
 969 Note that there is no method to obtain the filehandle from the
 970 C<File::Temp> object. The object itself acts as a filehandle. Also,
 971 the object is configured such that it stringifies to the name of the
 972 temporary file.
 973
 974 =over 4
 975
 976 =item B<new>
 977
 978 Create a temporary file object.
 979
 980   my $tmp = new File::Temp();
 981
 982 by default the object is constructed as if C<tempfile>
 983 was called without options, but with the additional behaviour
 984 that the temporary file is removed by the object destructor
 985 if UNLINK is set to true (the default).
 986
 987 Supported arguments are the same as for C<tempfile>: UNLINK
 988 (defaulting to true), DIR and SUFFIX. Additionally, the filename
 989 template is specified using the TEMPLATE option. The OPEN option
 990 is not supported (the file is always opened).
 991
 992  $tmp = new File::Temp( TEMPLATE => 'tempXXXXX',
 993                         DIR => 'mydir',
 994                         SUFFIX => '.dat');
 995
 996 Arguments are case insensitive.
 997
 998 =cut
 999
1000 sub new {
1001   my $proto = shift;
1002   my $class = ref($proto) || $proto;
1003
1004   # read arguments and convert keys to upper case
1005   my %args = @_;
1006   %args = map { uc($_), $args{$_} } keys %args;
1007
1008   # see if they are unlinking (defaulting to yes)
1009   my $unlink = (exists $args{UNLINK} ? $args{UNLINK} : 1 );
1010   delete $args{UNLINK};
1011
1012   # template (store it in an error so that it will
1013   # disappear from the arg list of tempfile
1014   my @template = ( exists $args{TEMPLATE} ? $args{TEMPLATE} : () );
1015   delete $args{TEMPLATE};
1016
1017   # Protect OPEN
1018   delete $args{OPEN};
1019
1020   # Open the file and retain file handle and file name
1021   my ($fh, $path) = tempfile( @template, %args );
1022
1023   print "Tmp: $fh - $path\n" if $DEBUG;
1024
1025   # Store the filename in the scalar slot
1026   ${*$fh} = $path;
1027
1028   # Store unlink information in hash slot (plus other constructor info)
1029   %{*$fh} = %args;
1030
1031   # create the object
1032   bless $fh, $class;
1033
1034   # final method-based configuration
1035   $fh->unlink_on_destroy( $unlink );
1036
1037   return $fh;
1038 }
1039
1040 =item B<filename>
1041
1042 Return the name of the temporary file associated with this object.
1043
1044   $filename = $tmp->filename;
1045
1046 This method is called automatically when the object is used as
1047 a string.
1048
1049 =cut
1050
1051 sub filename {
1052   my $self = shift;
1053   return ${*$self};
1054 }
1055
1056 sub STRINGIFY {
1057   my $self = shift;
1058   return $self->filename;
1059 }
1060
1061 =item B<unlink_on_destroy>
1062
1063 Control whether the file is unlinked when the object goes out of scope.
1064 The file is removed if this value is true and $KEEP_ALL is not.
1065
1066  $fh->unlink_on_destroy( 1 );
1067
1068 Default is for the file to be removed.
1069
1070 =cut
1071
1072 sub unlink_on_destroy {
1073   my $self = shift;
1074   if (@_) {
1075     ${*$self}{UNLINK} = shift;
1076   }
1077   return ${*$self}{UNLINK};
1078 }
1079
1080 =item B<DESTROY>
1081
1082 When the object goes out of scope, the destructor is called. This
1083 destructor will attempt to unlink the file (using C<unlink1>)
1084 if the constructor was called with UNLINK set to 1 (the default state
1085 if UNLINK is not specified).
1086
1087 No error is given if the unlink fails.
1088
1089 If the global variable $KEEP_ALL is true, the file will not be removed.
1090
1091 =cut
1092
1093 sub DESTROY {
1094   my $self = shift;
1095   if (${*$self}{UNLINK} && !$KEEP_ALL) {
1096     print "# --------->   Unlinking $self\n" if $DEBUG;
1097
1098     # The unlink1 may fail if the file has been closed
1099     # by the caller. This leaves us with the decision
1100     # of whether to refuse to remove the file or simply
1101     # do an unlink without test. Seems to be silly
1102     # to do this when we are trying to be careful
1103     # about security
1104     _force_writable( $self->filename ); # for windows
1105     unlink1( $self, $self->filename )
1106       or unlink($self->filename);
1107   }
1108 }
1109
1110 =back
1111
1112 =head1 FUNCTIONS
1113
1114 This section describes the recommended interface for generating
1115 temporary files and directories.
1116
1117 =over 4
1118
1119 =item B<tempfile>
1120
1121 This is the basic function to generate temporary files.
1122 The behaviour of the file can be changed using various options:
1123
1124   $fh = tempfile();
1125   ($fh, $filename) = tempfile();
1126
1127 Create a temporary file in  the directory specified for temporary
1128 files, as specified by the tmpdir() function in L<File::Spec>.
1129
1130   ($fh, $filename) = tempfile($template);
1131
1132 Create a temporary file in the current directory using the supplied
1133 template.  Trailing `X' characters are replaced with random letters to
1134 generate the filename.  At least four `X' characters must be present
1135 at the end of the template.
1136
1137   ($fh, $filename) = tempfile($template, SUFFIX => $suffix)
1138
1139 Same as previously, except that a suffix is added to the template
1140 after the `X' translation.  Useful for ensuring that a temporary
1141 filename has a particular extension when needed by other applications.
1142 But see the WARNING at the end.
1143
1144   ($fh, $filename) = tempfile($template, DIR => $dir);
1145
1146 Translates the template as before except that a directory name
1147 is specified.
1148
1149   ($fh, $filename) = tempfile($template, UNLINK => 1);
1150
1151 Return the filename and filehandle as before except that the file is
1152 automatically removed when the program exits (dependent on
1153 $KEEP_ALL). Default is for the file to be removed if a file handle is
1154 requested and to be kept if the filename is requested. In a scalar
1155 context (where no filename is returned) the file is always deleted
1156 either (depending on the operating system) on exit or when it is
1157 closed (unless $KEEP_ALL is true when the temp file is created).
1158
1159 Use the object-oriented interface if fine-grained control of when
1160 a file is removed is required.
1161
1162 If the template is not specified, a template is always
1163 automatically generated. This temporary file is placed in tmpdir()
1164 (L<File::Spec>) unless a directory is specified explicitly with the
1165 DIR option.
1166
1167   $fh = tempfile( $template, DIR => $dir );
1168
1169 If called in scalar context, only the filehandle is returned and the
1170 file will automatically be deleted when closed on operating systems
1171 that support this (see the description of tmpfile() elsewhere in this
1172 document).  This is the preferred mode of operation, as if you only
1173 have a filehandle, you can never create a race condition by fumbling
1174 with the filename. On systems that can not unlink an open file or can
1175 not mark a file as temporary when it is opened (for example, Windows
1176 NT uses the C<O_TEMPORARY> flag) the file is marked for deletion when
1177 the program ends (equivalent to setting UNLINK to 1). The C<UNLINK>
1178 flag is ignored if present.
1179
1180   (undef, $filename) = tempfile($template, OPEN => 0);
1181
1182 This will return the filename based on the template but
1183 will not open this file.  Cannot be used in conjunction with
1184 UNLINK set to true. Default is to always open the file
1185 to protect from possible race conditions. A warning is issued
1186 if warnings are turned on. Consider using the tmpnam()
1187 and mktemp() functions described elsewhere in this document
1188 if opening the file is not required.
1189
1190 Options can be combined as required.
1191
1192 =cut
1193
1194 sub tempfile {
1195
1196   # Can not check for argument count since we can have any
1197   # number of args
1198
1199   # Default options
1200   my %options = (
1201                  "DIR"    => undef,  # Directory prefix
1202                 "SUFFIX" => '',     # Template suffix
1203                 "UNLINK" => 0,      # Do not unlink file on exit
1204                 "OPEN"   => 1,      # Open file
1205                 );
1206
1207   # Check to see whether we have an odd or even number of arguments
1208   my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef);
1209
1210   # Read the options and merge with defaults
1211   %options = (%options, @_)  if @_;
1212
1213   # First decision is whether or not to open the file
1214   if (! $options{"OPEN"}) {
1215
1216     warn "tempfile(): temporary filename requested but not opened.\nPossibly unsafe, consider using tempfile() with OPEN set to true\n"
1217       if $^W;
1218
1219   }
1220
1221   if ($options{"DIR"} and $^O eq 'VMS') {
1222
1223       # on VMS turn []foo into [.foo] for concatenation
1224       $options{"DIR"} = VMS::Filespec::vmspath($options{"DIR"});
1225   }
1226
1227   # Construct the template
1228
1229   # Have a choice of trying to work around the mkstemp/mktemp/tmpnam etc
1230   # functions or simply constructing a template and using _gettemp()
1231   # explicitly. Go for the latter
1232
1233   # First generate a template if not defined and prefix the directory
1234   # If no template must prefix the temp directory
1235   if (defined $template) {
1236     if ($options{"DIR"}) {
1237
1238       $template = File::Spec->catfile($options{"DIR"}, $template);
1239
1240     }
1241
1242   } else {
1243
1244     if ($options{"DIR"}) {
1245
1246       $template = File::Spec->catfile($options{"DIR"}, TEMPXXX);
1247
1248     } else {
1249
1250       $template = File::Spec->catfile(File::Spec->tmpdir, TEMPXXX);
1251
1252     }
1253
1254   }
1255
1256   # Now add a suffix
1257   $template .= $options{"SUFFIX"};
1258
1259   # Determine whether we should tell _gettemp to unlink the file
1260   # On unix this is irrelevant and can be worked out after the file is
1261   # opened (simply by unlinking the open filehandle). On Windows or VMS
1262   # we have to indicate temporary-ness when we open the file. In general
1263   # we only want a true temporary file if we are returning just the
1264   # filehandle - if the user wants the filename they probably do not
1265   # want the file to disappear as soon as they close it (which may be
1266   # important if they want a child process to use the file)
1267   # For this reason, tie unlink_on_close to the return context regardless
1268   # of OS.
1269   my $unlink_on_close = ( wantarray ? 0 : 1);
1270
1271   # Create the file
1272   my ($fh, $path, $errstr);
1273   croak "Error in tempfile() using $template: $errstr"
1274     unless (($fh, $path) = _gettemp($template,
1275                                     "open" => $options{'OPEN'},
1276                                     "mkdir"=> 0 ,
1277                                     "unlink_on_close" => $unlink_on_close,
1278                                     "suffixlen" => length($options{'SUFFIX'}),
1279                                     "ErrStr" => \$errstr,
1280                                    ) );
1281
1282   # Set up an exit handler that can do whatever is right for the
1283   # system. This removes files at exit when requested explicitly or when
1284   # system is asked to unlink_on_close but is unable to do so because
1285   # of OS limitations.
1286   # The latter should be achieved by using a tied filehandle.
1287   # Do not check return status since this is all done with END blocks.
1288   _deferred_unlink($fh, $path, 0) if $options{"UNLINK"};
1289
1290   # Return
1291   if (wantarray()) {
1292
1293     if ($options{'OPEN'}) {
1294       return ($fh, $path);
1295     } else {
1296       return (undef, $path);
1297     }
1298
1299   } else {
1300
1301     # Unlink the file. It is up to unlink0 to decide what to do with
1302     # this (whether to unlink now or to defer until later)
1303     unlink0($fh, $path) or croak "Error unlinking file $path using unlink0";
1304
1305     # Return just the filehandle.
1306     return $fh;
1307   }
1308
1309
1310 }
1311
1312 =item B<tempdir>
1313
1314 This is the recommended interface for creation of temporary directories.
1315 The behaviour of the function depends on the arguments:
1316
1317   $tempdir = tempdir();
1318
1319 Create a directory in tmpdir() (see L<File::Spec|File::Spec>).
1320
1321   $tempdir = tempdir( $template );
1322
1323 Create a directory from the supplied template. This template is
1324 similar to that described for tempfile(). `X' characters at the end
1325 of the template are replaced with random letters to construct the
1326 directory name. At least four `X' characters must be in the template.
1327
1328   $tempdir = tempdir ( DIR => $dir );
1329
1330 Specifies the directory to use for the temporary directory.
1331 The temporary directory name is derived from an internal template.
1332
1333   $tempdir = tempdir ( $template, DIR => $dir );
1334
1335 Prepend the supplied directory name to the template. The template
1336 should not include parent directory specifications itself. Any parent
1337 directory specifications are removed from the template before
1338 prepending the supplied directory.
1339
1340   $tempdir = tempdir ( $template, TMPDIR => 1 );
1341
1342 Using the supplied template, create the temporary directory in
1343 a standard location for temporary files. Equivalent to doing
1344
1345   $tempdir = tempdir ( $template, DIR => File::Spec->tmpdir);
1346
1347 but shorter. Parent directory specifications are stripped from the
1348 template itself. The C<TMPDIR> option is ignored if C<DIR> is set
1349 explicitly.  Additionally, C<TMPDIR> is implied if neither a template
1350 nor a directory are supplied.
1351
1352   $tempdir = tempdir( $template, CLEANUP => 1);
1353
1354 Create a temporary directory using the supplied template, but
1355 attempt to remove it (and all files inside it) when the program
1356 exits. Note that an attempt will be made to remove all files from
1357 the directory even if they were not created by this module (otherwise
1358 why ask to clean it up?). The directory removal is made with
1359 the rmtree() function from the L<File::Path|File::Path> module.
1360 Of course, if the template is not specified, the temporary directory
1361 will be created in tmpdir() and will also be removed at program exit.
1362
1363 =cut
1364
1365 # '
1366
1367 sub tempdir  {
1368
1369   # Can not check for argument count since we can have any
1370   # number of args
1371
1372   # Default options
1373   my %options = (
1374                  "CLEANUP"    => 0,  # Remove directory on exit
1375                  "DIR"        => '', # Root directory
1376                  "TMPDIR"     => 0,  # Use tempdir with template
1377                 );
1378
1379   # Check to see whether we have an odd or even number of arguments
1380   my $template = (scalar(@_) % 2 == 1 ? shift(@_) : undef );
1381
1382   # Read the options and merge with defaults
1383   %options = (%options, @_)  if @_;
1384
1385   # Modify or generate the template
1386
1387   # Deal with the DIR and TMPDIR options
1388   if (defined $template) {
1389
1390     # Need to strip directory path if using DIR or TMPDIR
1391     if ($options{'TMPDIR'} || $options{'DIR'}) {
1392
1393       # Strip parent directory from the filename
1394       #
1395       # There is no filename at the end
1396       $template = VMS::Filespec::vmspath($template) if $^O eq 'VMS';
1397       my ($volume, $directories, undef) = File::Spec->splitpath( $template, 1);
1398
1399       # Last directory is then our template
1400       $template = (File::Spec->splitdir($directories))[-1];
1401
1402       # Prepend the supplied directory or temp dir
1403       if ($options{"DIR"}) {
1404
1405         $template = File::Spec->catdir($options{"DIR"}, $template);
1406
1407       } elsif ($options{TMPDIR}) {
1408
1409         # Prepend tmpdir
1410         $template = File::Spec->catdir(File::Spec->tmpdir, $template);
1411
1412       }
1413
1414     }
1415
1416   } else {
1417
1418     if ($options{"DIR"}) {
1419
1420       $template = File::Spec->catdir($options{"DIR"}, TEMPXXX);
1421
1422     } else {
1423
1424       $template = File::Spec->catdir(File::Spec->tmpdir, TEMPXXX);
1425
1426     }
1427
1428   }
1429
1430   # Create the directory
1431   my $tempdir;
1432   my $suffixlen = 0;
1433   if ($^O eq 'VMS') {  # dir names can end in delimiters
1434     $template =~ m/([\.\]:>]+)$/;
1435     $suffixlen = length($1);
1436   }
1437   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1438     # dir name has a trailing ':'
1439     ++$suffixlen;
1440   }
1441
1442   my $errstr;
1443   croak "Error in tempdir() using $template: $errstr"
1444     unless ((undef, $tempdir) = _gettemp($template,
1445                                     "open" => 0,
1446                                     "mkdir"=> 1 ,
1447                                     "suffixlen" => $suffixlen,
1448                                     "ErrStr" => \$errstr,
1449                                    ) );
1450
1451   # Install exit handler; must be dynamic to get lexical
1452   if ( $options{'CLEANUP'} && -d $tempdir) {
1453     _deferred_unlink(undef, $tempdir, 1);
1454   }
1455
1456   # Return the dir name
1457   return $tempdir;
1458
1459 }
1460
1461 =back
1462
1463 =head1 MKTEMP FUNCTIONS
1464
1465 The following functions are Perl implementations of the
1466 mktemp() family of temp file generation system calls.
1467
1468 =over 4
1469
1470 =item B<mkstemp>
1471
1472 Given a template, returns a filehandle to the temporary file and the name
1473 of the file.
1474
1475   ($fh, $name) = mkstemp( $template );
1476
1477 In scalar context, just the filehandle is returned.
1478
1479 The template may be any filename with some number of X's appended
1480 to it, for example F</tmp/temp.XXXX>. The trailing X's are replaced
1481 with unique alphanumeric combinations.
1482
1483 =cut
1484
1485
1486
1487 sub mkstemp {
1488
1489   croak "Usage: mkstemp(template)"
1490     if scalar(@_) != 1;
1491
1492   my $template = shift;
1493
1494   my ($fh, $path, $errstr);
1495   croak "Error in mkstemp using $template: $errstr"
1496     unless (($fh, $path) = _gettemp($template,
1497                                     "open" => 1,
1498                                     "mkdir"=> 0 ,
1499                                     "suffixlen" => 0,
1500                                     "ErrStr" => \$errstr,
1501                                    ) );
1502
1503   if (wantarray()) {
1504     return ($fh, $path);
1505   } else {
1506     return $fh;
1507   }
1508
1509 }
1510
1511
1512 =item B<mkstemps>
1513
1514 Similar to mkstemp(), except that an extra argument can be supplied
1515 with a suffix to be appended to the template.
1516
1517   ($fh, $name) = mkstemps( $template, $suffix );
1518
1519 For example a template of C<testXXXXXX> and suffix of C<.dat>
1520 would generate a file similar to F<testhGji_w.dat>.
1521
1522 Returns just the filehandle alone when called in scalar context.
1523
1524 =cut
1525
1526 sub mkstemps {
1527
1528   croak "Usage: mkstemps(template, suffix)"
1529     if scalar(@_) != 2;
1530
1531
1532   my $template = shift;
1533   my $suffix   = shift;
1534
1535   $template .= $suffix;
1536
1537   my ($fh, $path, $errstr);
1538   croak "Error in mkstemps using $template: $errstr"
1539     unless (($fh, $path) = _gettemp($template,
1540                                     "open" => 1,
1541                                     "mkdir"=> 0 ,
1542                                     "suffixlen" => length($suffix),
1543                                     "ErrStr" => \$errstr,
1544                                    ) );
1545
1546   if (wantarray()) {
1547     return ($fh, $path);
1548   } else {
1549     return $fh;
1550   }
1551
1552 }
1553
1554 =item B<mkdtemp>
1555
1556 Create a directory from a template. The template must end in
1557 X's that are replaced by the routine.
1558
1559   $tmpdir_name = mkdtemp($template);
1560
1561 Returns the name of the temporary directory created.
1562 Returns undef on failure.
1563
1564 Directory must be removed by the caller.
1565
1566 =cut
1567
1568 #' # for emacs
1569
1570 sub mkdtemp {
1571
1572   croak "Usage: mkdtemp(template)"
1573     if scalar(@_) != 1;
1574
1575   my $template = shift;
1576   my $suffixlen = 0;
1577   if ($^O eq 'VMS') {  # dir names can end in delimiters
1578     $template =~ m/([\.\]:>]+)$/;
1579     $suffixlen = length($1);
1580   }
1581   if ( ($^O eq 'MacOS') && (substr($template, -1) eq ':') ) {
1582     # dir name has a trailing ':'
1583     ++$suffixlen;
1584   }
1585   my ($junk, $tmpdir, $errstr);
1586   croak "Error creating temp directory from template $template\: $errstr"
1587     unless (($junk, $tmpdir) = _gettemp($template,
1588                                         "open" => 0,
1589                                         "mkdir"=> 1 ,
1590                                         "suffixlen" => $suffixlen,
1591                                         "ErrStr" => \$errstr,
1592                                        ) );
1593
1594   return $tmpdir;
1595
1596 }
1597
1598 =item B<mktemp>
1599
1600 Returns a valid temporary filename but does not guarantee
1601 that the file will not be opened by someone else.
1602
1603   $unopened_file = mktemp($template);
1604
1605 Template is the same as that required by mkstemp().
1606
1607 =cut
1608
1609 sub mktemp {
1610
1611   croak "Usage: mktemp(template)"
1612     if scalar(@_) != 1;
1613
1614   my $template = shift;
1615
1616   my ($tmpname, $junk, $errstr);
1617   croak "Error getting name to temp file from template $template: $errstr"
1618     unless (($junk, $tmpname) = _gettemp($template,
1619                                          "open" => 0,
1620                                          "mkdir"=> 0 ,
1621                                          "suffixlen" => 0,
1622                                          "ErrStr" => \$errstr,
1623                                          ) );
1624
1625   return $tmpname;
1626 }
1627
1628 =back
1629
1630 =head1 POSIX FUNCTIONS
1631
1632 This section describes the re-implementation of the tmpnam()
1633 and tmpfile() functions described in L<POSIX>
1634 using the mkstemp() from this module.
1635
1636 Unlike the L<POSIX|POSIX> implementations, the directory used
1637 for the temporary file is not specified in a system include
1638 file (C<P_tmpdir>) but simply depends on the choice of tmpdir()
1639 returned by L<File::Spec|File::Spec>. On some implementations this
1640 location can be set using the C<TMPDIR> environment variable, which
1641 may not be secure.
1642 If this is a problem, simply use mkstemp() and specify a template.
1643
1644 =over 4
1645
1646 =item B<tmpnam>
1647
1648 When called in scalar context, returns the full name (including path)
1649 of a temporary file (uses mktemp()). The only check is that the file does
1650 not already exist, but there is no guarantee that that condition will
1651 continue to apply.
1652
1653   $file = tmpnam();
1654
1655 When called in list context, a filehandle to the open file and
1656 a filename are returned. This is achieved by calling mkstemp()
1657 after constructing a suitable template.
1658
1659   ($fh, $file) = tmpnam();
1660
1661 If possible, this form should be used to prevent possible
1662 race conditions.
1663
1664 See L<File::Spec/tmpdir> for information on the choice of temporary
1665 directory for a particular operating system.
1666
1667 =cut
1668
1669 sub tmpnam {
1670
1671    # Retrieve the temporary directory name
1672    my $tmpdir = File::Spec->tmpdir;
1673
1674    croak "Error temporary directory is not writable"
1675      if $tmpdir eq '';
1676
1677    # Use a ten character template and append to tmpdir
1678    my $template = File::Spec->catfile($tmpdir, TEMPXXX);
1679
1680    if (wantarray() ) {
1681        return mkstemp($template);
1682    } else {
1683        return mktemp($template);
1684    }
1685
1686 }
1687
1688 =item B<tmpfile>
1689
1690 Returns the filehandle of a temporary file.
1691
1692   $fh = tmpfile();
1693
1694 The file is removed when the filehandle is closed or when the program
1695 exits. No access to the filename is provided.
1696
1697 If the temporary file can not be created undef is returned.
1698 Currently this command will probably not work when the temporary
1699 directory is on an NFS file system.
1700
1701 =cut
1702
1703 sub tmpfile {
1704
1705   # Simply call tmpnam() in a list context
1706   my ($fh, $file) = tmpnam();
1707
1708   # Make sure file is removed when filehandle is closed
1709   # This will fail on NFS
1710   unlink0($fh, $file)
1711     or return undef;
1712
1713   return $fh;
1714
1715 }
1716
1717 =back
1718
1719 =head1 ADDITIONAL FUNCTIONS
1720
1721 These functions are provided for backwards compatibility
1722 with common tempfile generation C library functions.
1723
1724 They are not exported and must be addressed using the full package
1725 name.
1726
1727 =over 4
1728
1729 =item B<tempnam>
1730
1731 Return the name of a temporary file in the specified directory
1732 using a prefix. The file is guaranteed not to exist at the time
1733 the function was called, but such guarantees are good for one
1734 clock tick only.  Always use the proper form of C<sysopen>
1735 with C<O_CREAT | O_EXCL> if you must open such a filename.
1736
1737   $filename = File::Temp::tempnam( $dir, $prefix );
1738
1739 Equivalent to running mktemp() with $dir/$prefixXXXXXXXX
1740 (using unix file convention as an example)
1741
1742 Because this function uses mktemp(), it can suffer from race conditions.
1743
1744 =cut
1745
1746 sub tempnam {
1747
1748   croak 'Usage tempnam($dir, $prefix)' unless scalar(@_) == 2;
1749
1750   my ($dir, $prefix) = @_;
1751
1752   # Add a string to the prefix
1753   $prefix .= 'XXXXXXXX';
1754
1755   # Concatenate the directory to the file
1756   my $template = File::Spec->catfile($dir, $prefix);
1757
1758   return mktemp($template);
1759
1760 }
1761
1762 =back
1763
1764 =head1 UTILITY FUNCTIONS
1765
1766 Useful functions for dealing with the filehandle and filename.
1767
1768 =over 4
1769
1770 =item B<unlink0>
1771
1772 Given an open filehandle and the associated filename, make a safe
1773 unlink. This is achieved by first checking that the filename and
1774 filehandle initially point to the same file and that the number of
1775 links to the file is 1 (all fields returned by stat() are compared).
1776 Then the filename is unlinked and the filehandle checked once again to
1777 verify that the number of links on that file is now 0.  This is the
1778 closest you can come to making sure that the filename unlinked was the
1779 same as the file whose descriptor you hold.
1780
1781   unlink0($fh, $path)
1782      or die "Error unlinking file $path safely";
1783
1784 Returns false on error. The filehandle is not closed since on some
1785 occasions this is not required.
1786
1787 On some platforms, for example Windows NT, it is not possible to
1788 unlink an open file (the file must be closed first). On those
1789 platforms, the actual unlinking is deferred until the program ends and
1790 good status is returned. A check is still performed to make sure that
1791 the filehandle and filename are pointing to the same thing (but not at
1792 the time the end block is executed since the deferred removal may not
1793 have access to the filehandle).
1794
1795 Additionally, on Windows NT not all the fields returned by stat() can
1796 be compared. For example, the C<dev> and C<rdev> fields seem to be
1797 different.  Also, it seems that the size of the file returned by stat()
1798 does not always agree, with C<stat(FH)> being more accurate than
1799 C<stat(filename)>, presumably because of caching issues even when
1800 using autoflush (this is usually overcome by waiting a while after
1801 writing to the tempfile before attempting to C<unlink0> it).
1802
1803 Finally, on NFS file systems the link count of the file handle does
1804 not always go to zero immediately after unlinking. Currently, this
1805 command is expected to fail on NFS disks.
1806
1807 This function is disabled if the global variable $KEEP_ALL is true
1808 and an unlink on open file is supported. If the unlink is to be deferred
1809 to the END block, the file is still registered for removal.
1810
1811 =cut
1812
1813 sub unlink0 {
1814
1815   croak 'Usage: unlink0(filehandle, filename)'
1816     unless scalar(@_) == 2;
1817
1818   # Read args
1819   my ($fh, $path) = @_;
1820
1821   cmpstat($fh, $path) or return 0;
1822
1823   # attempt remove the file (does not work on some platforms)
1824   if (_can_unlink_opened_file()) {
1825
1826     # return early (Without unlink) if we have been instructed to retain files.
1827     return 1 if $KEEP_ALL;
1828
1829     # XXX: do *not* call this on a directory; possible race
1830     #      resulting in recursive removal
1831     croak "unlink0: $path has become a directory!" if -d $path;
1832     unlink($path) or return 0;
1833
1834     # Stat the filehandle
1835     my @fh = stat $fh;
1836
1837     print "Link count = $fh[3] \n" if $DEBUG;
1838
1839     # Make sure that the link count is zero
1840     # - Cygwin provides deferred unlinking, however,
1841     #   on Win9x the link count remains 1
1842     # On NFS the link count may still be 1 but we cant know that
1843     # we are on NFS
1844     return ( $fh[3] == 0 or $^O eq 'cygwin' ? 1 : 0);
1845
1846   } else {
1847     _deferred_unlink($fh, $path, 0);
1848     return 1;
1849   }
1850
1851 }
1852
1853 =item B<cmpstat>
1854
1855 Compare C<stat> of filehandle with C<stat> of provided filename.  This
1856 can be used to check that the filename and filehandle initially point
1857 to the same file and that the number of links to the file is 1 (all
1858 fields returned by stat() are compared).
1859
1860   cmpstat($fh, $path)
1861      or die "Error comparing handle with file";
1862
1863 Returns false if the stat information differs or if the link count is
1864 greater than 1.
1865
1866 On certain platofms, eg Windows, not all the fields returned by stat()
1867 can be compared. For example, the C<dev> and C<rdev> fields seem to be
1868 different in Windows.  Also, it seems that the size of the file
1869 returned by stat() does not always agree, with C<stat(FH)> being more
1870 accurate than C<stat(filename)>, presumably because of caching issues
1871 even when using autoflush (this is usually overcome by waiting a while
1872 after writing to the tempfile before attempting to C<unlink0> it).
1873
1874 Not exported by default.
1875
1876 =cut
1877
1878 sub cmpstat {
1879
1880   croak 'Usage: cmpstat(filehandle, filename)'
1881     unless scalar(@_) == 2;
1882
1883   # Read args
1884   my ($fh, $path) = @_;
1885
1886   warn "Comparing stat\n"
1887     if $DEBUG;
1888
1889   # Stat the filehandle - which may be closed if someone has manually
1890   # closed the file. Can not turn off warnings without using $^W
1891   # unless we upgrade to 5.006 minimum requirement
1892   my @fh;
1893   {
1894     local ($^W) = 0;
1895     @fh = stat $fh;
1896   }
1897   return unless @fh;
1898
1899   if ($fh[3] > 1 && $^W) {
1900     carp "unlink0: fstat found too many links; SB=@fh" if $^W;
1901   }
1902
1903   # Stat the path
1904   my @path = stat $path;
1905
1906   unless (@path) {
1907     carp "unlink0: $path is gone already" if $^W;
1908     return;
1909   }
1910
1911   # this is no longer a file, but may be a directory, or worse
1912   unless (-f $path) {
1913     confess "panic: $path is no longer a file: SB=@fh";
1914   }
1915
1916   # Do comparison of each member of the array
1917   # On WinNT dev and rdev seem to be different
1918   # depending on whether it is a file or a handle.
1919   # Cannot simply compare all members of the stat return
1920   # Select the ones we can use
1921   my @okstat = (0..$#fh);  # Use all by default
1922   if ($^O eq 'MSWin32') {
1923     @okstat = (1,2,3,4,5,7,8,9,10);
1924   } elsif ($^O eq 'os2') {
1925     @okstat = (0, 2..$#fh);
1926   } elsif ($^O eq 'VMS') { # device and file ID are sufficient
1927     @okstat = (0, 1);
1928   } elsif ($^O eq 'dos') {
1929     @okstat = (0,2..7,11..$#fh);
1930   } elsif ($^O eq 'mpeix') {
1931     @okstat = (0..4,8..10);
1932   }
1933
1934   # Now compare each entry explicitly by number
1935   for (@okstat) {
1936     print "Comparing: $_ : $fh[$_] and $path[$_]\n" if $DEBUG;
1937     # Use eq rather than == since rdev, blksize, and blocks (6, 11,
1938     # and 12) will be '' on platforms that do not support them.  This
1939     # is fine since we are only comparing integers.
1940     unless ($fh[$_] eq $path[$_]) {
1941       warn "Did not match $_ element of stat\n" if $DEBUG;
1942       return 0;
1943     }
1944   }
1945
1946   return 1;
1947 }
1948
1949 =item B<unlink1>
1950
1951 Similar to C<unlink0> except after file comparison using cmpstat, the
1952 filehandle is closed prior to attempting to unlink the file. This
1953 allows the file to be removed without using an END block, but does
1954 mean that the post-unlink comparison of the filehandle state provided
1955 by C<unlink0> is not available.
1956
1957   unlink1($fh, $path)
1958      or die "Error closing and unlinking file";
1959
1960 Usually called from the object destructor when using the OO interface.
1961
1962 Not exported by default.
1963
1964 This function is disabled if the global variable $KEEP_ALL is true.
1965
1966 =cut
1967
1968 sub unlink1 {
1969   croak 'Usage: unlink1(filehandle, filename)'
1970     unless scalar(@_) == 2;
1971
1972   # Read args
1973   my ($fh, $path) = @_;
1974
1975   cmpstat($fh, $path) or return 0;
1976
1977   # Close the file
1978   close( $fh ) or return 0;
1979
1980   # Make sure the file is writable (for windows)
1981   _force_writable( $path );
1982
1983   # return early (without unlink) if we have been instructed to retain files.
1984   return 1 if $KEEP_ALL;
1985
1986   # remove the file
1987   return unlink($path);
1988 }
1989
1990 =item B<cleanup>
1991
1992 Calling this function will cause any temp files or temp directories
1993 that are registered for removal to be removed. This happens automatically
1994 when the process exits but can be triggered manually if the caller is sure
1995 that none of the temp files are required. This method can be registered as
1996 an Apache callback.
1997
1998 On OSes where temp files are automatically removed when the temp file
1999 is closed, calling this function will have no effect other than to remove
2000 temporary directories (which may include temporary files).
2001
2002   File::Temp::cleanup();
2003
2004 Not exported by default.
2005
2006 =back
2007
2008 =head1 PACKAGE VARIABLES
2009
2010 These functions control the global state of the package.
2011
2012 =over 4
2013
2014 =item B<safe_level>
2015
2016 Controls the lengths to which the module will go to check the safety of the
2017 temporary file or directory before proceeding.
2018 Options are:
2019
2020 =over 8
2021
2022 =item STANDARD
2023
2024 Do the basic security measures to ensure the directory exists and
2025 is writable, that the umask() is fixed before opening of the file,
2026 that temporary files are opened only if they do not already exist, and
2027 that possible race conditions are avoided.  Finally the L<unlink0|"unlink0">
2028 function is used to remove files safely.
2029
2030 =item MEDIUM
2031
2032 In addition to the STANDARD security, the output directory is checked
2033 to make sure that it is owned either by root or the user running the
2034 program. If the directory is writable by group or by other, it is then
2035 checked to make sure that the sticky bit is set.
2036
2037 Will not work on platforms that do not support the C<-k> test
2038 for sticky bit.
2039
2040 =item HIGH
2041
2042 In addition to the MEDIUM security checks, also check for the
2043 possibility of ``chown() giveaway'' using the L<POSIX|POSIX>
2044 sysconf() function. If this is a possibility, each directory in the
2045 path is checked in turn for safeness, recursively walking back to the
2046 root directory.
2047
2048 For platforms that do not support the L<POSIX|POSIX>
2049 C<_PC_CHOWN_RESTRICTED> symbol (for example, Windows NT) it is
2050 assumed that ``chown() giveaway'' is possible and the recursive test
2051 is performed.
2052
2053 =back
2054
2055 The level can be changed as follows:
2056
2057   File::Temp->safe_level( File::Temp::HIGH );
2058
2059 The level constants are not exported by the module.
2060
2061 Currently, you must be running at least perl v5.6.0 in order to
2062 run with MEDIUM or HIGH security. This is simply because the
2063 safety tests use functions from L<Fcntl|Fcntl> that are not
2064 available in older versions of perl. The problem is that the version
2065 number for Fcntl is the same in perl 5.6.0 and in 5.005_03 even though
2066 they are different versions.
2067
2068 On systems that do not support the HIGH or MEDIUM safety levels
2069 (for example Win NT or OS/2) any attempt to change the level will
2070 be ignored. The decision to ignore rather than raise an exception
2071 allows portable programs to be written with high security in mind
2072 for the systems that can support this without those programs failing
2073 on systems where the extra tests are irrelevant.
2074
2075 If you really need to see whether the change has been accepted
2076 simply examine the return value of C<safe_level>.
2077
2078   $newlevel = File::Temp->safe_level( File::Temp::HIGH );
2079   die "Could not change to high security"
2080       if $newlevel != File::Temp::HIGH;
2081
2082 =cut
2083
2084 {
2085   # protect from using the variable itself
2086   my $LEVEL = STANDARD;
2087   sub safe_level {
2088     my $self = shift;
2089     if (@_) {
2090       my $level = shift;
2091       if (($level != STANDARD) && ($level != MEDIUM) && ($level != HIGH)) {
2092         carp "safe_level: Specified level ($level) not STANDARD, MEDIUM or HIGH - ignoring\n" if $^W;
2093       } else {
2094         # Dont allow this on perl 5.005 or earlier
2095         if ($] < 5.006 && $level != STANDARD) {
2096           # Cant do MEDIUM or HIGH checks
2097           croak "Currently requires perl 5.006 or newer to do the safe checks";
2098         }
2099         # Check that we are allowed to change level
2100         # Silently ignore if we can not.
2101         $LEVEL = $level if _can_do_level($level);
2102       }
2103     }
2104     return $LEVEL;
2105   }
2106 }
2107
2108 =item TopSystemUID
2109
2110 This is the highest UID on the current system that refers to a root
2111 UID. This is used to make sure that the temporary directory is
2112 owned by a system UID (C<root>, C<bin>, C<sys> etc) rather than
2113 simply by root.
2114
2115 This is required since on many unix systems C</tmp> is not owned
2116 by root.
2117
2118 Default is to assume that any UID less than or equal to 10 is a root
2119 UID.
2120
2121   File::Temp->top_system_uid(10);
2122   my $topid = File::Temp->top_system_uid;
2123
2124 This value can be adjusted to reduce security checking if required.
2125 The value is only relevant when C<safe_level> is set to MEDIUM or higher.
2126
2127 =cut
2128
2129 {
2130   my $TopSystemUID = 10;
2131   $TopSystemUID = 197108 if $^O eq 'interix'; # "Administrator"
2132   sub top_system_uid {
2133     my $self = shift;
2134     if (@_) {
2135       my $newuid = shift;
2136       croak "top_system_uid: UIDs should be numeric"
2137         unless $newuid =~ /^\d+$/s;
2138       $TopSystemUID = $newuid;
2139     }
2140     return $TopSystemUID;
2141   }
2142 }
2143
2144 =item B<$KEEP_ALL>
2145
2146 Controls whether temporary files and directories should be retained
2147 regardless of any instructions in the program to remove them
2148 automatically.  This is useful for debugging but should not be used in
2149 production code.
2150
2151   $File::Temp::KEEP_ALL = 1;
2152
2153 Default is for files to be removed as requested by the caller.
2154
2155 In some cases, files will only be retained if this variable is true
2156 when the file is created. This means that you can not create a temporary
2157 file, set this variable and expect the temp file to still be around
2158 when the program exits.
2159
2160 =item B<$DEBUG>
2161
2162 Controls whether debugging messages should be enabled.
2163
2164   $File::Temp::DEBUG = 1;
2165
2166 Default is for debugging mode to be disabled.
2167
2168 =back
2169
2170 =head1 WARNING
2171
2172 For maximum security, endeavour always to avoid ever looking at,
2173 touching, or even imputing the existence of the filename.  You do not
2174 know that that filename is connected to the same file as the handle
2175 you have, and attempts to check this can only trigger more race
2176 conditions.  It's far more secure to use the filehandle alone and
2177 dispense with the filename altogether.
2178
2179 If you need to pass the handle to something that expects a filename
2180 then, on a unix system, use C<"/dev/fd/" . fileno($fh)> for arbitrary
2181 programs, or more generally C<< "+<=&" . fileno($fh) >> for Perl
2182 programs.  You will have to clear the close-on-exec bit on that file
2183 descriptor before passing it to another process.
2184
2185     use Fcntl qw/F_SETFD F_GETFD/;
2186     fcntl($tmpfh, F_SETFD, 0)
2187         or die "Can't clear close-on-exec flag on temp fh: $!\n";
2188
2189 =head2 Temporary files and NFS
2190
2191 Some problems are associated with using temporary files that reside
2192 on NFS file systems and it is recommended that a local filesystem
2193 is used whenever possible. Some of the security tests will most probably
2194 fail when the temp file is not local. Additionally, be aware that
2195 the performance of I/O operations over NFS will not be as good as for
2196 a local disk.
2197
2198 =head2 Forking
2199
2200 In some cases files created by File::Temp are removed from within an
2201 END block. Since END blocks are triggered when a child process exits
2202 (unless C<POSIX::_exit()> is used by the child) File::Temp takes care
2203 to only remove those temp files created by a particular process ID. This
2204 means that a child will not attempt to remove temp files created by the
2205 parent process.
2206
2207 =head2 BINMODE
2208
2209 The file returned by File::Temp will have been opened in binary mode
2210 if such a mode is available. If that is not correct, use the binmode()
2211 function to change the mode of the filehandle.
2212
2213 =head1 HISTORY
2214
2215 Originally began life in May 1999 as an XS interface to the system
2216 mkstemp() function. In March 2000, the OpenBSD mkstemp() code was
2217 translated to Perl for total control of the code's
2218 security checking, to ensure the presence of the function regardless of
2219 operating system and to help with portability. The module was shipped
2220 as a standard part of perl from v5.6.1.
2221
2222 =head1 SEE ALSO
2223
2224 L<POSIX/tmpnam>, L<POSIX/tmpfile>, L<File::Spec>, L<File::Path>
2225
2226 See L<IO::File> and L<File::MkTemp>, L<Apachae::TempFile> for
2227 different implementations of temporary file handling.
2228
2229 =head1 AUTHOR
2230
2231 Tim Jenness E<lt>tjenness@cpan.orgE<gt>
2232
2233 Copyright (C) 1999-2005 Tim Jenness and the UK Particle Physics and
2234 Astronomy Research Council. All Rights Reserved.  This program is free
2235 software; you can redistribute it and/or modify it under the same
2236 terms as Perl itself.
2237
2238 Original Perl implementation loosely based on the OpenBSD C code for
2239 mkstemp(). Thanks to Tom Christiansen for suggesting that this module
2240 should be written and providing ideas for code improvements and
2241 security enhancements.
2242
2243 =cut
2244
2245 1;