unreadable.pl 1.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051
  1. #!/usr/bin/perl
  2. # Test "rm" and unreadable directories.
  3. # Copyright (C) 1998-2018 Free Software Foundation, Inc.
  4. # This program is free software: you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation, either version 3 of the License, or
  7. # (at your option) any later version.
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. # You should have received a copy of the GNU General Public License
  13. # along with this program. If not, see <https://www.gnu.org/licenses/>.
  14. use strict;
  15. (my $program_name = $0) =~ s|.*/||;
  16. # Turn off localization of executable's output.
  17. @ENV{qw(LANGUAGE LANG LC_ALL)} = ('C') x 3;
  18. my $d = "dir-$$";
  19. my $mkdir = {PRE => sub {mkdir $d,0100 or die "$d: $!\n"}};
  20. my $prog = 'rm';
  21. my $uid = $<;
  22. my @Tests =
  23. (
  24. # test-name options input expected-output
  25. #
  26. # Removing an empty, unwritable directory succeeds.
  27. ['unreadable-1', '-rf', $d, {EXIT => 0}, $mkdir],
  28. ['unreadable-2', '-rf', $d,
  29. {EXIT => $uid == 0 ? 0 : 1},
  30. {ERR => $uid == 0 ? ''
  31. : "$prog: cannot remove '$d': Permission denied\n"},
  32. {PRE => sub { (mkdir $d,0700 and mkdir "$d/x",0700 and chmod 0100,$d)
  33. or die "$d: $!\n"}} ],
  34. );
  35. my $save_temps = $ENV{SAVE_TEMPS};
  36. my $verbose = $ENV{VERBOSE};
  37. my $fail = run_tests ($program_name, $prog, \@Tests, $save_temps, $verbose);
  38. exit $fail;