mca1001: bin/du-priv.pl

I did indeed mean 5.008

#! /usr/bin/perl -T

use strict;
use warnings;

$ENV{PATH} = "/bin:/usr/bin";
my @du = ("du");

use 5.008; # or thereabouts, maybe, for open(fh, "-|", @cmd)


=head1 NAME

du-priv.pl - trim du output for privacy

=head1 SYNOPSIS

 du -x /home | du-priv.pl | xdiskusage

 ssh place 'du -x /home | du-priv.pl' | xdiskusage

 du-priv.pl -- -x /home | xdiskusage

=head1 DESCRIPTION

I tend to run (the equivalent of)

 ssh root@fullbox du -x /foofs | xdiskusage

when the filesystem fills.  This is effective but I prefer not to use
the power to peek inside private directories.

This script solves the problem by omitting lines from the C<du> output
when the directory is not publicly readable.  The totals will still
add up, but any subdirectory structure is hidden.

Run with no args to operate in filter mode.  If args are given after
C<-->, du will be run with them; the space before the separator is
reserved for bells and whistles.

=head2 Assumptions

=over 4

=item - un*x filenames

=item - access to the same filesystem as the du

=item - relative filenames start in the same place

The first element of a relative filename is "visible".  This is
convenient for "/", "./" and the non-file "total", but makes it
unsuitable for accepting attacker-chosen input.

=back

=head1 AUTHOR

Copyright (C) 2006 Matthew Astley, all rights reserved.

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.

[I cheerfully assume you already have a copy of the GPL]

=cut

# $Id: du-priv.pl,v 1.2 2006/10/01 07:44:47 mca1001 Exp $


my ($stream, $piped);

# Deal with ARGV.  Anything before "--" is not yet supported.
if (0 == @ARGV) {
    $stream = \*STDIN;
} elsif ($ARGV[0] eq "--") {
    shift;
    open $stream, "-|", @du, @ARGV
      or die "$0: Failed to pipe from '@du @ARGV': $!";
    $piped = 1;
} else {
    die "Syntax: $0 [-- <du arguments>]\n";
}

filter($stream);


# Tidy up the stream, pick a suitable exit code
my $exit = close $stream ? 0 : 1;
if ($piped) {
    my $sig = $? & 0x7f;
    warn "$0: du caught signal $sig\n" if $sig;
    $exit = $sig ? 2 : $? >> 8;
}

exit $exit;


{
    my %visible; # cache: key = directory name, value = true if OK to see inside
    sub visible {
	my ($path, $recursed) = @_;
	xcimate(\%visible, 3) if !$recursed && keys %visible > 10000;
	return $visible{$path} ||= _visible($path);
    }
}


sub _visible {
    my @path = split "/", (shift);

    return 1 if @path < 2; # Always see the top level

    # Consider the parent
    pop @path;
    my $parent = join "/", @path;
    $parent = "/" if @path < 2 && $path[0] eq '';
    return visible($parent, 1) && public($parent);
}


# A generalisation of decimating a hash.
#
# Deletes the first and subsequent ($mod)th items, in the [untested]
# hope that this will adequately approximate removing a random
# selection.
#
# Doing this during an ||= element assignment will segfault in Perl
# v5.8.4 , see ../doodles/perlbug.delete-during.pl
sub xcimate {
    my ($hashref, $mod) = @_;
    my $num = 0;
    my $k;
    while (defined ($k = each %$hashref)) {
	delete $$hashref{$k} if 0 == $num % $mod;
	$num ++;
    }
}


sub public {
    my $path = shift;
    die "$0: '$path' not found (running on the wrong box?)"
      unless -e $path;
    my @S = stat $path;
    return 05 == ($S[2] & 05);	# symbolically, require o+rx
}


sub filter {
    my $fh = shift;
    while (<$fh>) {
	die "Didn't understand du output '$_'"
	  unless /^\d+\S*\s+(\S.*)$/;
	print if visible($1);
    }
}

Repository owner Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help