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