1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183
|
#!../../../perl
# ------------------------------------------------------------------------ #
# Interactive test and demo script for the Perl Quota extension module
#
# Author: Tom Zoerner 1995-2005
#
# This program (test.pl) is in the public domain and can be used and
# redistributed without restrictions.
#
# 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.
# ------------------------------------------------------------------------ #
use blib;
use Quota;
if (! -t) {
print STDERR "\nThis is an interactive test script - input must be a tty\nExiting now.\n";
exit;
}
while(1) {
print "\nEnter path to get quota for (NFS possible; default '.'): ";
chomp($path = <STDIN>);
$path = "." unless $path =~ /\S/;
while(1) {
$dev = Quota::getqcarg($path);
if(!$dev) {
warn "$path: mount point not found\n";
if(-d $path && $path !~ m#/.$#) {
#
# try to append "/." to get past automounter fs
#
$path .= "/.";
warn "Trying $path instead...\n";
redo;
}
}
last;
}
redo if !$dev;
print "Using device/argument \"$dev\"\n";
##
## Check if quotas are present on this filesystem
##
if($dev =~ m#^[^/]+:#) {
print "Is a remote file system\n";
last;
}
elsif(Quota::sync($dev) && ($! != 1)) { # ignore EPERM
warn "Quota::sync: ".Quota::strerr."\n";
warn "Choose another file system - quotas not functional on this one\n";
}
else {
print "Quotas are present on this filesystem (sync ok)\n";
last;
}
}
##
## call with one argument (uid defaults to getuid()
##
print "\nQuery this fs with default uid (which is real uid) $>\n";
($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev);
if(defined($bc)) {
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($bt);
$bt = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $bt;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ft);
$ft = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $ft;
print "Your usage and limits are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
}
else {
warn "Quota::query($dev): ",Quota::strerr,"\n\n";
}
##
## call with two arguments
##
{
print "Enter a uid to get quota for: ";
chomp($uid = <STDIN>);
unless($uid =~ /^\d{1,5}$/) {
print "You have to enter a numerical uid in range 0..65535 here.\n";
redo;
}
}
($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev, $uid);
if(defined($bc)) {
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($bt);
$bt = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $bt;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ft);
$ft = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $ft;
print "Usage and limits for $uid are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
}
else {
warn "Quota::query($dev,$uid): ",Quota::strerr,"\n\n";
}
##
## get quotas via RPC
##
if($dev =~ m#^/#) {
print "Query localhost via RPC.\n";
($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path);
if(defined($bc)) {
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($bt);
$bt = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $bt;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ft);
$ft = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $ft;
print "Your Usage and limits are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
}
else {
warn Quota::strerr,"\n\n";
}
print "Query localhost via RPC for $uid.\n";
($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid);
if(!defined($bc)) {
warn Quota::strerr,"\n\n";
print "Retrying with fake authentication for UID $uid.\n";
Quota::rpcauth($uid);
($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid);
Quota::rpcauth();
}
if(defined($bc)) {
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($bt);
$bt = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $bt;
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ft);
$ft = sprintf("%04d-%02d-%02d/%02d:%02d", $year+1900,$mon+1,$mday,$hour,$min) if $ft;
print "Usage and limits for $uid are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
}
else {
warn Quota::strerr,"\n\n";
}
}
else {
print "Skipping RPC query test - already done above.\n\n";
}
##
## set quota block & file limits for user
##
print "Enter path to set quota (empty to skip): ";
chomp($path = <STDIN>);
if($path =~ /\S/) {
print "New quota limits bs,bh,fs,fh for $uid (empty to abort): ";
chomp($in = <STDIN>);
if($in =~ /\S/) {
$dev = Quota::getqcarg($path) || die "$path: $!\n";
unless(Quota::setqlim($dev, $uid, split(/\s*,\s*/, $in), 1)) {
print "Quota set for $uid\n";
}
else {
warn Quota::strerr,"\n";
}
}
}
##
## Force immediate update on disk
##
if($dev !~ m#^[^/]+:#) {
Quota::sync($dev) && ($! != 1) && die "Quota::sync: ".Quota::strerr."\n";
}
|