1package CuTmpdir;
2# create, then chdir into a temporary sub-directory
3
4# Copyright (C) 2007-2023 Free Software Foundation, Inc.
5
6# This program is free software: you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation, either version 3 of the License, or
9# (at your option) any later version.
10
11# This program is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15
16# You should have received a copy of the GNU General Public License
17# along with this program.  If not, see <https://www.gnu.org/licenses/>.
18
19use strict;
20use warnings;
21
22use File::Temp;
23use File::Find;
24
25our $ME = $0 || "<???>";
26
27my $dir;
28
29sub skip_test($)
30{
31  warn "$ME: skipping test: unsafe working directory name: '$_[0]'\n";
32  exit 77;
33}
34
35sub chmod_1
36{
37  my $name = $_;
38
39  # Skip symlinks and non-directories.
40  -l $name || !-d _
41    and return;
42
43  chmod 0700, $name;
44}
45
46sub chmod_tree
47{
48  # When tempdir fails, it croaks, which leaves $dir undefined.
49  defined $dir
50    or return;
51
52  # Perform the equivalent of find "$dir" -type d -print0|xargs -0 chmod -R 700.
53  my $options = {untaint => 1, wanted => \&chmod_1};
54  find ($options, $dir);
55}
56
57sub import {
58  my $prefix = $_[1];
59
60  $ME eq '-' && defined $prefix
61    and $ME = $prefix;
62
63  if ($prefix !~ /^\//)
64    {
65      eval 'use Cwd';
66      my $cwd = $@ ? '.' : Cwd::getcwd();
67      $prefix = "$cwd/$prefix";
68    }
69
70  # Untaint for the upcoming mkdir.
71  $prefix =~ m!^([-+\@\w./]+)$!
72    or skip_test $prefix;
73  $prefix = $1;
74
75  my $original_pid = $$;
76
77  my $on_sig_remove_tmpdir = sub {
78    my ($sig) = @_;
79    if ($$ == $original_pid and defined $dir)
80      {
81        chmod_tree;
82        # Older versions of File::Temp lack this method.
83        exists &File::Temp::cleanup
84          and &File::Temp::cleanup;
85      }
86    $SIG{$sig} = 'DEFAULT';
87    kill $sig, $$;
88  };
89
90  foreach my $sig (qw (INT TERM HUP))
91    {
92      $SIG{$sig} = $on_sig_remove_tmpdir;
93    }
94
95  $dir = File::Temp::tempdir("$prefix.tmp-XXXX", CLEANUP => 1 );
96  chdir $dir
97    or warn "$ME: failed to chdir to $dir: $!\n";
98}
99
100END {
101  # Move cwd out of the directory we're about to remove.
102  # This is required on some systems, and by some versions of File::Temp.
103  chdir '..'
104    or warn "$ME: failed to chdir to .. from $dir: $!\n";
105
106  my $saved_errno = $?;
107  chmod_tree;
108  $? = $saved_errno;
109}
110
1111;
112