#!/usr/bin/perl -w
#----------------------------------------------------------------------
# copyright (C) 2002 Mitel Networks Corporation
#
# 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# Technical support for this program is available from Mitel Networks
# Please visit our web site www.mitel.com/sme/ for details.
#----------------------------------------------------------------------
package esmith;
use strict;
use Errno;
use Quota;
use esmith::AccountsDB;
my $accounts = esmith::AccountsDB->open;
my @users = ();
my $event = $ARGV [0];
if ($event eq "bootstrap-console-save")
{
# For bootstrap-console-save, make sure that quota entries are
# set for each user
@users = $accounts->users;
}
else
{
# Otherwise just set quota for the named user.
my $userName = $ARGV [1];
#------------------------------------------------------------
# Check the Unix account
#------------------------------------------------------------
=begin testing
use esmith::TestUtils qw(simulate_perl_program);
my $exit = simulate_perl_program($Original_File, 'wibble-event',
'user_that_doesnt_exist');
is( $exit, 255 * 256, 'non-existent user - exit code' );
like( $@, qr{^Account "user_that_doesnt_exist" is not a user account},
' failure message');
$exit = simulate_perl_program($Original_File, 'wibble-event' );
is( $exit, 255 * 256, 'forgotten user - exit code' );
like( $@, qr{^Username argument missing},
' failure message');
=end testing
=cut
die "Username argument missing.\n" unless defined ($userName);
my $user = $accounts->get($userName);
if( !$user or $user->prop('type') ne 'user' )
{
die qq{Account "$userName" is not a user account; modify } .
"user quota failed.\n";
}
@users = ($user);
}
=begin testing
my $a_tmp = '50-e-smith-quota/accounts.conf';
$ENV{ESMITH_ACCOUNT_DB} = $a_tmp;
END { unlink $a_tmp };
open(TMP, ">$a_tmp") || die $!;
print TMP <<'OUT';
root=system|Gid|0|Uid|0
server-manager=url
server-manual=url
shared=system|Gid|500|Visible|internal
shutdown=system
slocate=system|Gid|21
user_quota=user|Gid|1000|Uid|1000|MaxBlocksSoftLim|10000|MaxBlocks|20000|MaxFilesSoftLim|1000|MaxFiles|2000
user_partial=user|Gid|1001|Uid|1001|MaxBlocksSoftLim|123456|MaxFiles|321
user_no_quota=user|Gid|1002|Uid|1002
OUT
close TMP;
# Quota properties in the order setqlim likes.
my @QProps = qw(MaxBlocksSoftLim MaxBlocks MaxFilesSoftLim MaxFiles);
my %curr_quota = (
1000 => { MaxFilesSoftLim => 100 },
1001 => { MaxBlocks => 30000, MaxBlocksSoftLim => 20000 },
1002 => { MaxFiles => 2 },
);
# What we expect the new quotas to be
my %expect_quotas = (
1000 => { MaxBlocksSoftLim => 10000, MaxBlocks => 20000,
MaxFilesSoftLim => 1000, MaxFiles => 2000 },
1001 => { MaxBlocksSoftLim => 123456, MaxBlocks => 30000,
MaxFilesSoftLim => 0, MaxFiles => 321 },
1002 => { MaxBlocksSoftLim => 0, MaxBlocks => 0,
MaxFilesSoftLim => 0, MaxFiles => 2 },
);
{
# Since these users don't really exist, we have to fool getpwnam
# into using the Uid from the dummy accounts DB.
no warnings 'once';
local *CORE::GLOBAL::getpwnam = sub {
esmith::AccountsDB->open->get($_[0])->prop('Uid');
};
# Override the Quota query and set functions since
# 1) these users probably don't exist
# 2) if they did, we don't want to screw with their quotas
# 3) we need to know how each Quota function is called
use Quota;
no warnings 'redefine';
my %query;
sub Quota::query {
my($dev, $uid, $isgrp) = @_;
$query{$uid} = { isgrp => $isgrp };
return (0,
$curr_quota{$uid}{MaxBlocksSoftLim} || 0,
$curr_quota{$uid}{MaxBlocks} || 0,
0,
0,
$curr_quota{$uid}{MaxFilesSoftLim} || 0,
$curr_quota{$uid}{MaxFiles} || 0,
0
);
}
my %set_quota = ();
sub Quota::setqlim {
my($dev, $uid) = (shift, shift);
my(@limits) = splice(@_, 0, 4);
my($tlo) = shift;
my %limits = ();
@limits{@QProps} = @limits;
$set_quota{$uid}{limits} = \%limits;
$set_quota{$uid}{tlo} = $tlo;
return 1;
}
$_STDOUT_ = '';
$_STDERR_ = '';
my $exit = simulate_perl_program($Original_File, 'bootstrap-console-save');
is( $exit, 0, 'bootstrap-console-save - exit code' );
is( $_STDOUT_, '' );
is( $_STDERR_, '' );
is( $@, '' );
is_deeply( [sort keys %set_quota], [sort qw(1000 1001 1002)] );
foreach my $uid (keys %set_quota)
{
is_deeply( $set_quota{$uid}{limits}, $expect_quotas{$uid},
"setqlim for $uid");
}
}
=end testing
=cut
# Quota properties in the order setqlim likes.
my @QProps = qw(MaxBlocksSoftLim MaxBlocks MaxFilesSoftLim MaxFiles);
foreach my $user (@users)
{
my $userName = $user->key;
my $uid = getpwnam($userName);
die qq{Could not get uid for user named "$userName"\n} unless $uid;
my(%uquota, %curr_quota);
foreach my $qprop (@QProps)
{
$uquota{$qprop} = $user->prop($qprop);
}
# Get a $dev value appropriate for use in Quota::query call.
my $dev = Quota::getqcarg("/home/e-smith/files");
# Get current quota settings.
@curr_quota{@QProps} = (Quota::query($dev, $uid, 0))[1,2,5,6];
if( !defined $curr_quota{MaxBlocks} ) # Quota::query failed
{
warn "Cannot query your quota for '$userName' on '$dev'\n";
warn "Quota error (are you using NFS?): ", Quota::strerr(), "\n";
next;
}
# Keep old values unless there are values defined in the account record
foreach my $qprop (@QProps)
{
$uquota{$qprop} = $curr_quota{$qprop}
unless defined $uquota{$qprop};
}
# Set the new quota
Quota::setqlim($dev, $uid, @uquota{@QProps}, 0);
}