1	#!/usr/bin/perl -T
     2
     3	# Perl wrapper around du to only allow du on directories owned by the
     4	# user.  This prevents du sessions of (for example) a 2 terabyte raid
     5	# filesystem, which takes hours to finish.
     6
     7	# I started this in bash but switched to perl because you can't do
     8	# setgid shell scripts on linux.  This script must be installed setgid
     9	# root.  That should be reasonably secure.
    10
    11	# You better set /usr/bin/du to not be executable by other, otherwise
    12	# this is pretty pointless.
    13
    14	# Phil Hollenback, philiph@pobox.com 9/22/05
    15
    16	use Getopt::Std;
    17	use Cwd;
    18	use POSIX qw(getuid);
    19
    20	# Have to set the path because we are in taint mode.
    21	$ENV{"PATH"} = "/bin:/usr/bin";
    22	$ENV{"BASH_ENV"} = "";
    23
    24	# how long do we allow du to run before killing it (in seconds)?
    25	$TimeOut=600;
    26
    27	$RealDu="/usr/bin/unsafe-du";
    28	-x $RealDu or die "can't execute $RealDu";
    29
    30	# Save the original command-line args.
    31	@ORGARGS=@ARGV;
    32
    33	# use getopt just to remove all options (so we are left with just path
    34	# arguments).
    35	getopt ":";
    36
    37	# Untaint the arguments.
    38	foreach (@ORGARGS)
    39	{
    40	    ($arg) = ($_ =~ /(.*)/);
    41	    push @NEWARGS,$arg;
    42	}
    43
    44	# Determine if user is in wheel group.
    45	$uid = getuid;
    46	$username = getpwuid($uid);
    47	# get the members of group wheel...
    48	($name,$passwd,$gid,$members) = getgrnam("wheel");
    49	# now see if our username is in the members list or our uid is 0.
    50	if (( $members =~ m|$username|) || ($uid == 0))
    51	{
    52	    # run the real du no questions asked.
    53	    exec("$RealDu @NEWARGS");
    54	    ### NOTREACHED ###
    55	}
    56
    57	# Now @ARGV contains _only_ non-option arguments.
    58	@PathList=@ARGV;
    59
    60	# Special case: if there aren't any arguments left, that means the
    61	# user ran du without a path specification.  Thus du should be run on
    62	# the current directory.  Push the current dir into the list to force
    63	# this.
    64	if ( $#PathList == -1 )
    65	{
    66	    push @PathList, getcwd;
    67	  }
    68
    69	# go through each remaining command-line argument (path) and see if it
    70	# is owned by the user.
    71	foreach (@PathList)
    72	{
    73	    -O $_ or die "you don't own $_";
    74	}
    75
    76	# Set a timer and run the real du.
    77	eval {
    78	local $SIG{ALRM} =
    79	    sub {
    80		# ignore SIGHUP here so the kill only affects children.
    81		local $SIG{HUP} = 'IGNORE';
    82		kill 1,(-$$);
    83		print STDERR "du terminated, max run time of $TimeOut seconds exceeded.\n";
    84	    };
    85	alarm $TimeOut;
    86	system ("$RealDu @NEWARGS") || die "failed to run $RealDu: $!";
    87	alarm 0;
    88	};
    89	$SIG{HUP} = 'DEFAULT';
    90
    91	exit 0;