#!/usr/bin/perl
#
# quotaget - display quota information in an easily parseable format
#
# see POD below for more details
#
# Author: Daniel Hermann
#
# DH-2010-06-18: first version
#

use strict;
use warnings;

use Getopt::Long;
use Pod::Usage;
use File::Basename qw\basename\;
use Quota;
use POSIX qw\getuid\;


my $CALLNAME=basename($0);

##
## Command Line Options
##

my $help = '';
my $debug = '';
my $legacy = 'yes';

my @users;
my @filesystems;

my $result = GetOptions("user=s" => \@users,
        "filesystem-list=s" => \@filesystems,
        "help" => \$help,
        "debug" => \$debug,
        "legacy!" => \$legacy)
    or pod2usage(2);

pod2usage(0) if ($help);

foreach my $arg (@ARGV) {
    push(@filesystems, $arg);
}

##
## Assemble mountpoint and user information
##

# find mountpoints with quotas from /proc/mounts
my %mountpoints;
open(my $mounts,"<","/proc/mounts") or die "$CALLNAME: cannot open /proc/mounts";
while(<$mounts>) {
    next if not /(usrquota|usrjquota)/;

    my ($dev, $mntpnt, $fstype, $rest) = split(" ");

    if (-e $mntpnt) { # ignore mountpoints that don't exist (e.g. in chroot)
        $mountpoints{$dev} = $mntpnt;
        $mountpoints{$mntpnt} = $mntpnt; # for failsafe mapping $mntpnt -> $dev
    }
    # if multiple lines for the same device exist in /proc/mounts,
    # only the last entry is registered in $mountpoints{$dev}
}
close($mounts);

# if no user was specified on the command line, we put the current uid
# in the array
my $no_user_specified;
if ($#users eq -1) {
    push(@users, getuid());
    $no_user_specified = 1;
}

# resolve user names to uids (if necessary)
my %uids;
foreach my $user (@users) {
    if ($user =~ /^\d*$/) {  # a uid was already given
        $uids{$user} = $user;
    } else {
        if (!($uids{$user} = getpwnam($user))) {
            print STDERR "$CALLNAME: user $user does not exist.\n";
            exit (($legacy)?1:2);
        }
    }
}

# Quota::query needs formatted device names
my @fs_queryargs;


if ($#filesystems eq -1) { # no filesystems provided on CL
    if ($#users eq -1) {
        # neither users nor filesystems were provided
        print STDERR "$CALLNAME: No filesystem specified.\n";
        exit (($legacy)?1:2);
    }
    
    # use all mountpoints with quota enabled
    foreach my $mntpnt (values %mountpoints) {
        if (my $qcarg = Quota::getqcarg($mntpnt)) {
            push(@fs_queryargs, $qcarg);
        } else {
            # ignore mountpoints that cannot be resolved with getqcarg()
        }
    }
} else { # filesystems given on CL
    foreach my $fs (@filesystems) {
        my $mntpnt = $mountpoints{$fs};
        if (defined $mntpnt) {
            if (my $qcarg =  Quota::getqcarg($mntpnt)) {
                push(@fs_queryargs, $qcarg);
            } else {
                print STDERR "No quota on $fs\n";
                exit 2;
            }
        }
    }
}

if ($#fs_queryargs eq -1) { # Quota::getqcarg was unable to resolve mntpnts
    print STDERR "$CALLNAME: No quota on specified filesystems.\n";
    exit 2;
}

# remove duplicate entries
@fs_queryargs = keys %{{ map { $_ => 1 } @fs_queryargs }};
## second possible way to remove duplicate entries
#undef %saw;
#my @fs_queryargs = grep { !$saw{$_}++ } @fs_queryargs;


if ($debug) {
    print "DEBUG: filesystem queryargs:";
    foreach my $fs (@fs_queryargs) {
        print " ", $fs;
    }
    print "\n";
    print "DEBUG: users:";
    foreach my $user (@users) {
        print " ", $user;
    }
    print "\n";
}

##
## Produce output
##

my $num_dev = $#fs_queryargs + 1;
my $over_quota = '';

# one line for each combination user<->fs
foreach my $fs (@fs_queryargs) {
    my $dev = $fs;
    $dev =~ s/\(.*\)//;
    foreach my $user (@users) {
        my $devformat = (($legacy)?"%15s":"%s:");
        printf("%s:", $user) unless ($legacy || $no_user_specified);
        printf($devformat, $dev) unless ($legacy && ($num_dev<2));
        my ($curblocks, $bsoft, $bhard, $btime,
            $curinodes, $isoft, $ihard, $itime)
            = Quota::query($fs, $uids{$user});
        if (!defined($curblocks)) {
            print Quota::strerr(), "\n";
        } else {
            printf("%Lu:%Lu:%Lu:%Lu:%Lu:%Lu:%Lu:%Lu\n",
                $bhard, $bsoft, $curblocks,
                $ihard,$isoft,$curinodes,
                $btime,$itime);
            if ($btime || $itime) { $over_quota = 1; }
}
    }
}

# Return 1 (over quota) or 0 (not over quota) (unless in legacy mode)
if ($over_quota) {
    if ($legacy && $no_user_specified) { exit 0 }
    else { exit 1; }
}

1;

__END__

=head1 NAME

quotaget - display quota information in an easily parseable format

=head1 SYNOPSIS

 quotaget [options] [-u|--user user]
                    [[--filesystem-list|-f] filesystem] ...

    -u, --user              display quota for user
    -f, --filesystem-list   display quota information only for given
                            filesystem

 Options:
    -h, --help          brief help message
    --legacy|nolegacy   do (not) mimic old quotaget (default: legacy)
    --debug		print out some debug messages
    
=head1 DESCRIPTION

B<This tool> displays quota information (similarly available with
B<quota>) in such a way that it is more easily parseable in scripts
than the output of B<quota>.

If only one or more filesystems are specified using B<-f>, the quota
are printed for the current process' real userid. A different userid
can be specified with B<-u>.

In legacy mode (which is the default), this tool tries to reproduce
the behaviour of the old quotaget implementation as close as possible.

=head1 EXIT STATUS

B<quotaget> returns 0 if everything is okay (no errors, not over
quota). If the user is over quota on one or more filesystems, 1 is
returned. In case of an error, the return value is >=2.

Note: In legacy mode (which currently is the default mode), the error
code may be 0 even if an overquota condition is detected. It may also
be 1 not only in cases of overquota but also in some error
conditions. Not nice.

=head1 AUTHOR

Written by Daniel Hermann <daniel.hermann@1und1.de>.

=head1 COPYRIGHT

(C) 2010, 1&1 Internet AG

=cut