1#!/usr/bin/perl -Tw
2# Ensure that rm gives the expected diagnostic when failing to remove a file
3# owned by some other user in a directory with the sticky bit set.
4
5# Copyright (C) 2002-2023 Free Software Foundation, Inc.
6
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15# GNU General Public License for more details.
16
17# You should have received a copy of the GNU General Public License
18# along with this program.  If not, see <https://www.gnu.org/licenses/>.
19
20use strict;
21
22(my $ME = $0) =~ s|.*/||;
23
24my $uid = $<;
25# skip if root
26$uid == 0
27  and CuSkip::skip "$ME: can't run this test as root: skipping this test";
28
29my $verbose = $ENV{VERBOSE} && $ENV{VERBOSE} eq 'yes';
30
31# Ensure that the diagnostics are in English.
32$ENV{LC_ALL} = 'C';
33
34# Set up a safe, well-known environment
35$ENV{IFS}  = '';
36
37# Taint checking requires a sanitized $PATH.  This script performs no $PATH
38# search, so on most Unix-based systems, it is fine simply to clear $ENV{PATH}.
39# However, on Cygwin, it's used to find cygwin1.dll, so set it.
40$ENV{PATH} = '/bin:/usr/bin';
41
42my @dir_list = qw(/tmp /var/tmp /usr/tmp);
43my $rm = "$ENV{abs_top_builddir}/src/rm";
44
45# Untaint for upcoming popen.
46$rm =~ m!^([-+\@\w./]+)$!
47  or CuSkip::skip "$ME: unusual absolute builddir name; skipping this test\n";
48$rm = $1;
49
50# Find a directory with the sticky bit set.
51my $found_dir;
52my $found_file;
53foreach my $dir (@dir_list)
54  {
55    if (-d $dir && -k _ && -r _ && -w _ && -x _)
56      {
57        $found_dir = 1;
58
59        # Find a non-directory there that is owned by some other user.
60        opendir DIR_HANDLE, $dir
61          or die "$ME: couldn't open $dir: $!\n";
62
63        foreach my $f (readdir DIR_HANDLE)
64          {
65            # Consider only names containing "safe" characters.
66            $f =~ /^([-\@\w.]+)$/
67              or next;
68            $f = $1;    # untaint $f
69
70            my $target_file = "$dir/$f";
71            $verbose
72              and warn "$ME: considering $target_file\n";
73
74            # Skip files owned by self, symlinks, and directories.
75            # It's not technically necessary to skip symlinks, but it's simpler.
76            # SVR4-like systems (e.g., Solaris 9) let you unlink files that
77            # you can write, so skip writable files too.
78            -l $target_file || -o _ || -d _ || -w _
79              and next;
80
81            $found_file = 1;
82
83            # Invoke rm on this file and ensure that we get the
84            # expected exit code and diagnostic.
85            my $cmd = "$rm -f -- $target_file";
86            open RM, "$cmd 2>&1 |"
87              or die "$ME: cannot execute '$cmd'\n";
88
89            my $line = <RM>;
90
91            close RM;
92            my $rc = $?;
93            # This test opportunistically looks for files that can't
94            # be removed but those files may already have been removed
95            # by their owners by the time we get to them.  It is a
96            # race condition.  If so then the rm is successful and our
97            # test is thwarted.  Detect this case and ignore.
98            if ($rc == 0)
99              {
100                next if ! -e $target_file;
101                die "$ME: unexpected exit status from '$cmd';\n"
102                  . "  got 0, expected 1\n";
103              }
104            if (0x80 < $rc)
105              {
106                my $status = $rc >> 8;
107                $status == 1
108                  or die "$ME: unexpected exit status from '$cmd';\n"
109                    . "  got $status, expected 1\n";
110              }
111            else
112              {
113                # Terminated by a signal.
114                my $sig_num = $rc & 0x7F;
115                die "$ME: command '$cmd' died with signal $sig_num\n";
116              }
117
118            my $exp = "rm: cannot remove '$target_file':";
119            $line
120              or die "$ME: no output from '$cmd';\n"
121                . "expected something like '$exp ...'\n";
122
123            # Transform the actual diagnostic so that it starts with "rm:".
124            # Depending on your system, it might be "rm:" already, or
125            # "../../src/rm:".
126            $line =~ s,^\Q$rm\E:,rm:,;
127
128            my $regex = quotemeta $exp;
129            $line =~ /^$regex/
130              or die "$ME: unexpected diagnostic from '$cmd';\n"
131                . "  got      $line"
132                . "  expected $exp ...\n";
133
134            last;
135          }
136
137        closedir DIR_HANDLE;
138        $found_file
139          and last;
140      }
141  }
142
143$found_dir
144  or CuSkip::skip "$ME: couldn't find a directory with the sticky bit set;"
145    . " skipping this test\n";
146
147$found_file
148  or CuSkip::skip "$ME: couldn't find a file not owned by you\n"
149    . " in any of the following directories:\n  @dir_list\n"
150    . "...so, skipping this test\n";
151