VirtualBox

source: kBuild/vendor/grep/3.7/tests/CuTmpdir.pm

Last change on this file was 3529, checked in by bird, 3 years ago

Imported grep 3.7 from grep-3.7.tar.gz (sha256: c22b0cf2d4f6bbe599c902387e8058990e1eee99aef333a203829e5fd3dbb342), applying minimal auto-props.

File size: 2.5 KB
Line 
1package CuTmpdir;
2# create, then chdir into a temporary sub-directory
3
4# Copyright (C) 2007-2015, 2017-2021 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;
Note: See TracBrowser for help on using the repository browser.

© 2025 Oracle Support Privacy / Do Not Sell My Info Terms of Use Trademark Policy Automated Access Etiquette