#!/bin/sh
# -*- perl -*-
# Ensure that rm gives the expected diagnostic when failing to remove a file
# owned by some other user in a directory with the sticky bit set.

# Copyright (C) 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301, USA.

if test "$VERBOSE" = yes; then
  set -x
  rm --version
fi

# FIXME-someday: when run as root we don't need all of the
# searching below.  root can simply create the required
# dir/files and run the test as someone else.

PRIV_CHECK_ARG=require-non-root . $srcdir/../priv-check

: ${PERL=perl}
: ${srcdir=.}

$PERL -e 1 > /dev/null 2>&1 || {
  echo 1>&2 "$0: configure didn't find a usable version of Perl," \
    "so can't run this test"
  (exit 77); exit 77
}

ARGV_0=$0
export ARGV_0

exec $PERL -Tw -- - << \EOP
require 5.003;
use strict;

(my $ME = $ENV{ARGV_0}) =~ s|.*/||;

my $verbose = $ENV{VERBOSE} && $ENV{VERBOSE} eq 'yes';

# Ensure that the diagnostics are in English.
$ENV{LC_ALL} = 'C';

# Set up a safe, well-known environment
delete @ENV{qw(BASH_ENV CDPATH ENV PATH)};
$ENV{IFS}  = '';

my @dir_list = qw(/tmp /var/tmp /usr/tmp);
my $rm = '../../src/rm';

# Find a directory with the sticky bit set.
my $found_dir;
my $found_file;
foreach my $dir (@dir_list)
  {
    if (-d $dir && -k _ && -r _ && -w _ && -x _)
      {
	$found_dir = 1;

	# Find a non-directory there that is owned by some other user.
	opendir DIR_HANDLE, $dir
	  or die "$ME: couldn't open $dir: $!\n";

	foreach my $f (readdir DIR_HANDLE)
	  {
	    # Consider only names containing "safe" characters.
	    $f =~ /^([-\@\w.]+)$/
	      or next;
	    $f = $1;    # untaint $f

	    my $target_file = "$dir/$f";
	    $verbose
	      and warn "$ME: considering $target_file\n";

	    # Skip files owned by self, symlinks, and directories.
	    # It's not technically necessary to skip symlinks, but it's simpler.
	    # SVR4-like systems (e.g., Solaris 9) let you unlink files that
	    # you can write, so skip writable files too.
	    -l $target_file || -o _ || -d _ || -w _
	      and next;

	    $found_file = 1;

	    # Invoke rm on this file and ensure that we get the
	    # expected exit code and diagnostic.
	    my $cmd = "$rm -f -- $target_file";
	    open RM, "$cmd 2>&1 |"
	      or die "$ME: cannot execute `$cmd'\n";

	    my $line = <RM>;

	    close RM;
	    my $rc = $?;
	    if (0x80 < $rc)
	      {
		my $status = $rc >> 8;
		$status == 1
		  or die "$ME: unexpected exit status from `$cmd';\n"
		    . "  got $status, expected 1\n";
	      }
	    else
	      {
		# Terminated by a signal.
		my $sig_num = $rc & 0x7F;
		die "$ME: command `$cmd' died with signal $sig_num\n";
	      }

	    my $exp = "rm: cannot remove `$target_file':";
	    $line
	      or die "$ME: no output from `$cmd';\n"
		. "expected something like `$exp ...'\n";

	    # Transform the actual diagnostic so that it starts with "rm:".
	    # Depending on your system, it might be "rm:" already, or
	    # "../../src/rm:".
	    $line =~ s,^\Q$rm\E:,rm:,;

	    my $regex = quotemeta $exp;
	    $line =~ /^$regex/
	      or die "$ME: unexpected diagnostic from `$cmd';\n"
		. "  got      $line"
		. "  expected $exp ...\n";

	    last;
	  }

	closedir DIR_HANDLE;
	$found_file
	  and last;
      }
  }

if ( ! $found_dir)
  {
    warn "$ME: couldn't find a directory with the sticky bit set;"
      . " skipping this test\n";
    exit 77;
  }

if ( ! $found_file)
  {
    warn "$ME: couldn't find a file not owned by you\n"
      . " in any of the following directories:\n  @dir_list\n"
      . "...so, skipping this test\n";
    exit 77;
  }
EOP