228 lines
6.7 KiB
Perl
228 lines
6.7 KiB
Perl
#!/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);
|
|
}
|