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