tests/rm/fail-eperm.xpl

   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-2012 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 <http://www.gnu.org/licenses/>.
  19
  20 use strict;
  21
  22 (my $ME = $0) =~ s|.*/||;
  23
  24 my $uid = $<;
  25 # skip if root
  26 $uid == 0
  27   and CuSkip::skip "$ME: can't run this test as root: skipping this test";
  28
  29 my $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 delete @ENV{qw(BASH_ENV CDPATH ENV)};
  36 $ENV{IFS}  = '';
  37
  38 # Taint checking requires a sanitized $PATH.  This script performs no $PATH
  39 # search, so on most Unix-based systems, it is fine simply to clear $ENV{PATH}.
  40 # However, on Cygwin, it's used to find cygwin1.dll, so set it.
  41 $ENV{PATH} = '/bin:/usr/bin';
  42
  43 my @dir_list = qw(/tmp /var/tmp /usr/tmp);
  44 my $rm = "$ENV{abs_top_builddir}/src/rm";
  45
  46 # Untaint for upcoming popen.
  47 $rm =~ m!^([-+\@\w./]+)$!
  48   or CuSkip::skip "$ME: unusual absolute builddir name; skipping this test\n";
  49 $rm = $1;
  50
  51 # Find a directory with the sticky bit set.
  52 my $found_dir;
  53 my $found_file;
  54 foreach my $dir (@dir_list)
  55   {
  56     if (-d $dir && -k _ && -r _ && -w _ && -x _)
  57       {
  58         $found_dir = 1;
  59
  60         # Find a non-directory there that is owned by some other user.
  61         opendir DIR_HANDLE, $dir
  62           or die "$ME: couldn't open $dir: $!\n";
  63
  64         foreach my $f (readdir DIR_HANDLE)
  65           {
  66             # Consider only names containing "safe" characters.
  67             $f =~ /^([-\@\w.]+)$/
  68               or next;
  69             $f = $1;    # untaint $f
  70
  71             my $target_file = "$dir/$f";
  72             $verbose
  73               and warn "$ME: considering $target_file\n";
  74
  75             # Skip files owned by self, symlinks, and directories.
  76             # It's not technically necessary to skip symlinks, but it's simpler.
  77             # SVR4-like systems (e.g., Solaris 9) let you unlink files that
  78             # you can write, so skip writable files too.
  79             -l $target_file || -o _ || -d _ || -w _
  80               and next;
  81
  82             $found_file = 1;
  83
  84             # Invoke rm on this file and ensure that we get the
  85             # expected exit code and diagnostic.
  86             my $cmd = "$rm -f -- $target_file";
  87             open RM, "$cmd 2>&1 |"
  88               or die "$ME: cannot execute '$cmd'\n";
  89
  90             my $line = <RM>;
  91
  92             close RM;
  93             my $rc = $?;
  94             # This test opportunistically looks for files that can't
  95             # be removed but those files may already have been removed
  96             # by their owners by the time we get to them.  It is a
  97             # race condition.  If so then the rm is successful and our
  98             # test is thwarted.  Detect this case and ignore.
  99             if ($rc == 0)
 100               {
 101                 next if ! -e $target_file;
 102                 die "$ME: unexpected exit status from '$cmd';\n"
 103                   . "  got 0, expected 1\n";
 104               }
 105             if (0x80 < $rc)
 106               {
 107                 my $status = $rc >> 8;
 108                 $status == 1
 109                   or die "$ME: unexpected exit status from '$cmd';\n"
 110                     . "  got $status, expected 1\n";
 111               }
 112             else
 113               {
 114                 # Terminated by a signal.
 115                 my $sig_num = $rc & 0x7F;
 116                 die "$ME: command '$cmd' died with signal $sig_num\n";
 117               }
 118
 119             my $exp = "rm: cannot remove '$target_file':";
 120             $line
 121               or die "$ME: no output from '$cmd';\n"
 122                 . "expected something like '$exp ...'\n";
 123
 124             # Transform the actual diagnostic so that it starts with "rm:".
 125             # Depending on your system, it might be "rm:" already, or
 126             # "../../src/rm:".
 127             $line =~ s,^\Q$rm\E:,rm:,;
 128
 129             my $regex = quotemeta $exp;
 130             $line =~ /^$regex/
 131               or die "$ME: unexpected diagnostic from '$cmd';\n"
 132                 . "  got      $line"
 133                 . "  expected $exp ...\n";
 134
 135             last;
 136           }
 137
 138         closedir DIR_HANDLE;
 139         $found_file
 140           and last;
 141       }
 142   }
 143
 144 $found_dir
 145   or CuSkip::skip "$ME: couldn't find a directory with the sticky bit set;"
 146     . " skipping this test\n";
 147
 148 $found_file
 149   or CuSkip::skip "$ME: couldn't find a file not owned by you\n"
 150     . " in any of the following directories:\n  @dir_list\n"
 151     . "...so, skipping this test\n";