diff options
| -rw-r--r-- | CHANGES | 13 | ||||
| -rw-r--r-- | INSTALL | 17 | ||||
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | META.yml | 2 | ||||
| -rw-r--r-- | Makefile.PL | 29 | ||||
| -rw-r--r-- | Quota.pm | 42 | ||||
| -rw-r--r-- | Quota.xs | 13 | ||||
| -rw-r--r-- | README | 55 | ||||
| -rw-r--r-- | hints/bsd.h | 4 | ||||
| -rw-r--r-- | hints/linux.h | 2 | ||||
| -rwxr-xr-x | test.pl | 144 |
11 files changed, 210 insertions, 112 deletions
@@ -1,3 +1,15 @@ +Changes in 1.7.4 (March 2020) +- Build fixes for NetBSD release > 6 and Apple/Darwin + based on failure reports of automated CPAN testing +- Added support for group quotas in test.pl; + Corrections to documentation of group quota handling + +Changes in 1.7.3 (March 2020) +- Added detection for missing header rpc/rpc.h; + automatically switch to using "tirpc", if present. + Issue reported by Michael Stauber via CPAN ticket 128302 +- Also fixed compiler warnings in ancient RPC code. + Changes in 1.7.2 (May 2015) - Adapted platform detection for Linux 4.* Thanks to C. Affolter for reporting the issue (CPAN ticket 104652) @@ -175,7 +187,6 @@ Changes in 1.3.3 (May 2001) and Brian Johnson (brian@dev.brianj.com). Changes in 1.3.2 (February 2001) -- please note my new email address: tomzo AT nefkom DOT net - fixed AFS detection in Makefile.PL for Perl 5.6 thanks to Wolfgang Friebel <friebel@ifh.de> - adapted getmntent for incompatible change of struct statfs in OpenBSD 2.7 @@ -31,6 +31,10 @@ Options: If your distribution doesn't include the package you can get it from <URL:http://sourceforge.net/projects/linuxquota>. See also (6) below. + Since 2019, SUN-RPC support has been split off from glibc in some + Linux distributions. If you run into compilation problems due to + missing header rpc/rpc.h, install package "libtirpc-dev" + 2) Link or create the hints file. a) Should be done by Makefile.PL for all supported systems. If not, and @@ -54,7 +58,8 @@ Options: 4) Compile the module: make 5) Run "make test" to check if the module routines do work correctly. - (Since release 1.0 you can test the module without installing) + For testing group quotas run script test-group.pl (GID and path + are hard-coded in this script, so you'll likely have to edit it.) 6) Linux specials: @@ -92,10 +97,8 @@ Options: 8) Before you start for another OS, type "make clean" -Please mail me any changes in the hints files or Makefile.PL you had to -apply to get the package to compile. Please remember to include in your -mail the name of used OS and version numbers of OS (uname -rs) and module. -Tom ---- -email: tomzo AT nefkom DOT net +Please submit a ticket at CPAN (https://metacpan.org/pod/Quota) for any +changes in the hints files or Makefile.PL you had to apply to get the +package to compile. Please remember to include the name of the OS and +version numbers of OS (uname -rs) and Quota module. @@ -7,6 +7,7 @@ Quota.pm Quota.xs linuxapi.c afsquota.c +vxquotactl.c stdio_wrap.c README test.pl @@ -1,7 +1,7 @@ --- #YAML:1.0 name: Quota abstract: Quota - Perl interface to file system quotas -version: 1.7.2 +version: 1.7.4 author: - Tom Zoerner <tomzo@users.sourceforge.net> license: perl diff --git a/Makefile.PL b/Makefile.PL index 36678c5..f3681e1 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -61,12 +61,33 @@ if ( $os =~ /^SunOS/ ) { # } } -# check whether wee are using the NetBSD quota library -if ( ($os =~ /^NetBSD 6/) || - (($os =~ /^NetBSD 5\.99\.(\d\d)/) && ($1 >= 59)) ) { +# check whether we are using the NetBSD quota library +if ( ($os =~ /^NetBSD (\d+)\.(\d+)\.(\d+)/) && + (($1 >= 6) || (($1 == 5) && ($2 == 99) && ($3 >= 59)) )) { $extralibs .= " -lquota"; } +# check whether RPCSVC is included within libc +# - SUN RPC/XDR support was split off from glibc, see: +# https://lists.fedoraproject.org/archives/list/devel@lists.fedoraproject.org/thread/F2NRCEXDDUF6WWNPSOMXRJS6BPMTEEVJ/ +# - in RHEL apparently the rpc/rpc.h header was moved too; +# Debian has libtirpc, but headers and implementation are still in glibc too +if (($os =~ /^Linux/) && (-d '/usr/include/tirpc')) { + print "Configured to use tirpc library instead of rpcsvc\n"; + $extrainc = "-I/usr/include/tirpc"; + $rpclibs .= "-ltirpc"; +} +else { + if (($os =~ /^Linux/) && (!-e '/usr/include/rpc/rpc.h')) { + print "WARNING: Header file /usr/include/rpc/rpc.h not present on this system.\n" . + " Likely compilation will fail. Recommend to either install package\n" . + " \"libtirpc-dev\", or disable RPC (network file system) support by\n" . + " adding the following switch to myconfig.h:\n" . + " #define NO_RPC\n"; + } + $rpclibs .= "-lrpcsvc"; +} + #-----------------------------------------------------------------------------# use ExtUtils::MakeMaker; @@ -76,7 +97,7 @@ use ExtUtils::MakeMaker; "$afsquota $picobj $extraobj ". $hint{'OBJ'}, 'INC' => $extrainc .' '. $hint{'INC'}, 'DEFINE' => "$hasafs $hasvxfs", - 'LIBS' => [ "-lrpcsvc $extralibs" ], + 'LIBS' => [ "$rpclibs $extralibs" ], 'H' => [ 'myconfig.h' ], 'VERSION_FROM' => 'Quota.pm', 'clean' => { FILES => 'myconfig.h' }, @@ -1,10 +1,10 @@ # ------------------------------------------------------------------------ # -# Quota.pm - Copyright (C) 1995-2013 Tom Zoerner +# Quota.pm - Copyright (C) 1995-2020 T. Zoerner # ------------------------------------------------------------------------ # # This program is free software: you can redistribute it and/or modify # it either under the terms of the Perl Artistic License or the GNU # General Public License as published by the Free Software Foundation. -# (Either version 2 of the GPL, or any later version.) +# (Either version 1 of the GPL, or any later version.) # For a copy of these licenses see <http://www.opensource.org/licenses/>. # # This program is distributed in the hope that it will be useful, @@ -22,7 +22,7 @@ require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT = (); -$VERSION = '1.7.2'; +$VERSION = '1.7.4'; bootstrap Quota; @@ -213,13 +213,13 @@ limits are zero, there is no limit for that user. On most systems Quota::query will return undef in that case and errno will be set to ESRCH. -When I<$kind> is given and set to 1, I<$uid> is taken as gid and -group quotas are queried. This is B<not> supported across RPC and -even locally only on a few architectures (e.g. Linux and other BSD -based Unix variants, OSF/1 and AIX - check the quotactl(2) man page -on your systems). When I<$kind> is set to 2, project quotas are -queried; this is currently only supported for XFS. When unsupported, -this flag is ignored. +When I<$kind> is given and set to 1, the value in I<$uid> is taken as +gid and group quotas are queried. Group quotas may not be supported +across all platforms (e.g. Linux and other BSD based Unix variants, +OSF/1 and AIX - check the quotactl(2) man page on your systems). + +When I<$kind> is set to 2, project quotas are queried; this is +currently only supported for XFS. When unsupported, this flag is ignored. =item I<Quota::setqlim($dev, $uid, $bs,$bh, $is,$ih, $tlo, $kind)> @@ -239,10 +239,10 @@ More alternatives (i.e. setting a specific time) aren't available in most implementations. When I<$kind> is given and set to 1, I<$uid> is taken as gid and -group quota limits are set. This is supported only on a few -architectures (see above). When I<$kind> is set to 2, project -quotas are modified; this is currently only supported for XFS. -When unsupported, this flag is ignored. +group quota limits are set. This is not supported on all platforms +(see above). When I<$kind> is set to 2, project quotas are modified; +this is currently only supported for XFS. When unsupported, this +flag is ignored. Note: if you want to set the quota of a particular user to zero, i.e. no write permission, you must not set all limits to zero, since that @@ -272,10 +272,12 @@ I<Quota::rpcquery($host,$path,$uid,$kind)> This is equivalent to B<Quota::query("$host:$path",$uid,$kind)>, i.e. query quota for a given user on a given remote host via RPC. I<$path> is the path of any file or directory inside the -file system on the remote host. Querying group quotas ($kind = 1) -is only recently supported on some platforms (e.g. on linux via -"extended" quota RPC, i.e. quota RPC version 2) so it may fail due -to lack of support either on client or server side, or both. +file system on the remote host. + +Querying group quotas ($kind = 1) is only recently supported on some +platforms (e.g. on Linux via "extended" quota RPC, i.e. quota RPC +version 2) so it may fail due to lack of support either on client or +server side, or both. =item I<Quota::rpcpeer($port,$use_tcp,timeout)> @@ -377,7 +379,7 @@ see INSTALL. =head1 AUTHORS -This module was created 1995 by Tom Zoerner +This module was created 1995 by T. Zoerner (email: tomzo AT users.sourceforge.net) and since then continually improved and ported to many operating- and file-systems. Numerous people @@ -385,7 +387,7 @@ have contributed to this process; for a complete list of names please see the CHANGES document. The quota module was in the public domain 1995-2001. Since 2001 it is -licensed under both the Perl Artistic License and version 2 or later of the +licensed under both the Perl Artistic License and version 1 or later of the GNU General Public License as published by the Free Software Foundation. For a copy of these licenses see <http://www.opensource.org/licenses/>. The respective authors of the source code are it's owner in regard to @@ -76,6 +76,7 @@ struct quota_xs_nfs_rslt { int callaurpc(host, prognum, versnum, procnum, inproc, in, outproc, out) char *host; + int prognum, versnum, procnum; xdrproc_t inproc, outproc; char *in, *out; { @@ -282,8 +283,8 @@ struct getquota_args *gqp; bool_t xdr_getquota_rslt(xdrs, gqp) -XDR *xdrs; -struct getquota_rslt *gqp; + XDR *xdrs; + struct getquota_rslt *gqp; { return (xdr_union(xdrs, (int *) &gqp->GQR_STATUS, (char *) &gqp->GQR_RQUOTA, @@ -292,8 +293,8 @@ struct getquota_rslt *gqp; bool_t xdr_rquota(xdrs, rqp) -XDR *xdrs; -struct rquota *rqp; + XDR *xdrs; + struct rquota *rqp; { return (xdr_int(xdrs, &rqp->rq_bsize) && xdr_bool(xdrs, &rqp->rq_active) && @@ -311,8 +312,8 @@ struct rquota *rqp; #ifdef USE_EXT_RQUOTA bool_t xdr_ext_getquota_args(xdrs, objp) -XDR *xdrs; -ext_getquota_args *objp; + XDR *xdrs; + ext_getquota_args *objp; { return xdr_string(xdrs, &objp->gqa_pathp, RQ_PATHLEN) && xdr_int(xdrs, &objp->gqa_type) && @@ -1,10 +1,10 @@ Quota extension module for Perl ------------------------------- -Author: Tom Zoerner (tomzo AT users.sourceforge.net) +Author: T. Zoerner (tomzo AT users.sourceforge.net) -Version: 1.7.2 -Date: May 2015 +Version: 1.7.4 +Date: March 2020 DLSIP-Code:Rcdfg - stable release - C compiler required for installation @@ -13,7 +13,7 @@ DLSIP-Code:Rcdfg - licensed under the Perl Artistic License or (at your option) version 2 or later of the GNU General Public License -Location: http://www.perl.com/CPAN/authors/Tom_Zoerner/ +Location: https://metacpan.org/pod/Quota Supported: SunOS 4.1.3, Solaris 2.4 - 2.10, @@ -21,8 +21,8 @@ Supported: SunOS 4.1.3, IRIX 5.2 & 5.3 & 6.2 - 6.5, OSF/1 & Digital Unix 4, BSDi 2, FreeBSD 3.x - 4.9, OpenBSD & NetBSD (no RPC), - Linux - kernel 2.0.30 and later, incl. Quota API v2 and XFS, - AIX 4.1, 4.2 and 5.3. + Linux - kernel 2.0.30 and later, incl. Quota API up to v3, + file systems XFS, AIX 4.1, 4.2 and 5.3. AFS (Andrew File System) on many of the above (see INSTALL), VxFS (Veritas File System) on Solaris 2. @@ -49,7 +49,7 @@ SYNOPSIS ($block_curr, $block_soft, $block_hard, $block_timelimit, $inode_curr, $inode_soft, $inode_hard, $inode_timelimit) = - Quota::rpcquery($host, $path [,$uid]); + Quota::rpcquery($host, $path [,$uid [,kind]]); Quota::rpcpeer([$port [,$use_tcp [,timeout]]]); @@ -113,13 +113,15 @@ DESCRIPTION systems Quota::query will return undef in that case and errno will be set to ESRCH. - When $kind is given and set to 1, $uid is taken as gid - and group quotas are queried. This is not supported across - RPC and even locally only on a few architectures (e.g. Linux - and other BSD based Unix variants, OSF/1 and AIX - check the - quotactl(2) man page on your systems). When $kind is set - to 2, project quotas are queried; this is currently only - supported for XFS. When unsupported, this flag is ignored. + When $kind is given and set to 1, the value in $uid is taken + as gid and group quotas are queried. Group quotas may not be + supported across all platforms (e.g. Linux and other BSD + based Unix variants, OSF/1 and AIX - check the quotactl(2) + man page on your systems). + + When $kind is set to 2, project quotas are queried; this is + currently only supported for XFS. When unsupported, this flag + is ignored. Quota::setqlim($dev, $uid, $bs,$bh, $is,$ih, $tlo, $kind) Sets quota limits for the given user. Meanings of $dev, @@ -137,11 +139,11 @@ DESCRIPTION are set to 7.0 days. More alternatives (i.e. setting a specific time) aren't available in most implementations. - When $kind is given and set to 1, $uid is taken as gid - and group quota limits are set. This is supported only on a - few architectures (see above). When I<$kind> is set to 2, - project quotas are modified; this is currently only supported - for XFS. When unsupported, this flag is ignored. + When $kind is given and set to 1, $uid is taken as gid and + group quota limits are set. This is not supported on all + platforms (see above). When $kind is set to 2, project quotas + are modified; this is currently only supported for XFS. When + unsupported, this flag is ignored. Note: if you want to set the quota of a particular user to zero, i.e. no write permission, you must not set all @@ -167,14 +169,19 @@ DESCRIPTION in this module; it's a limitation in certain kernels. ($bc,$bs,$bh,$bt, $ic,$is,$ih,$it) = - Quota::rpcquery($host,$path,$uid) + Quota::rpcquery($host,$path,$uid,$kind) - This is equivalent to Quota::query("$host:$path",$uid), + This is equivalent to Quota::query("$host:$path",$uid,$kind), i.e. query quota for a given user on a given remote host via RPC. $path is the path of any file or directory inside the wanted file system on the remote host. + Querying group quotas ($kind = 1) is only recently supported + on some platforms (e.g. on Linux via "extended" quota RPC, + i.e. quota RPC version 2) so it may fail due to lack of + support either on client or server side, or both. + Quota::rpcpeer($port,$use_tcp,timeout) Configure parameters for subsequent RPC queries; all parameters are optional. By default the portmapper on @@ -273,7 +280,7 @@ BUGS see INSTALL. AUTHORS - This module was created 1995 by Tom Zoerner + This module was created 1995 by T. Zoerner (email: tomzo AT users.sourceforge.net) and since then continually improved and ported to many operating- and file-systems. Numerous people @@ -281,11 +288,11 @@ AUTHORS list of names please see the CHANGES document. The quota module was in the public domain 1995-2001. Since 2001 - it is licensed under both the Perl Artistic License and version 2 + it is licensed under both the Perl Artistic License and version 1 or later of the GNU General Public License as published by the Free Software Foundation. For a copy of these licenses see <http://www.opensource.org/licenses/>. The respective authors - of the source code are it's owner in regard to copyright. + of the source code are its owner in regard to copyright. SEE ALSO perl(1), edquota(1m), quotactl(2) or quotactl(7I), diff --git a/hints/bsd.h b/hints/bsd.h index 255c8cd..13f3b77 100644 --- a/hints/bsd.h +++ b/hints/bsd.h @@ -27,9 +27,13 @@ /* defining this will force the XS to use the libquota API for all file systems * except RPC; defines below such as Q_CTL_V2 have no effect */ #define NETBSD_LIBQUOTA +#else /* !__NetBSD__ */ +#if defined(__APPLE__) +#include <sys/quota.h> #else #include <ufs/ufs/quota.h> #endif +#endif /* !__NetBSD__ */ #if defined(__NetBSD__) && (__NetBSD_Version__ >= 299000900) /* NetBSD 2.99.9 */ /* NetBSD 3.0 has no statfs anymore */ diff --git a/hints/linux.h b/hints/linux.h index ee95971..50ff01b 100644 --- a/hints/linux.h +++ b/hints/linux.h @@ -28,6 +28,8 @@ /* definitions from sys/quota.h */ #define USRQUOTA 0 /* element used for user quotas */ #define GRPQUOTA 1 /* element used for group quotas */ +extern int quotactl(int, const char *, uid_t, caddr_t); + /* * Command definitions for the 'quotactl' system call. @@ -2,7 +2,7 @@ # ------------------------------------------------------------------------ # # Interactive test and demo script for the Perl Quota extension module # -# Author: Tom Zoerner 1995-2005 +# Author: T. Zoerner 1995-2020 # # This program (test.pl) is in the public domain and can be used and # redistributed without restrictions. @@ -13,17 +13,39 @@ # ------------------------------------------------------------------------ # use blib; +use warnings; +use strict; use Quota; if (! -t STDIN || ! -t STDOUT) { - print STDERR "\nThis is an interactive test script - input and output must be a tty\nExiting now.\n"; - exit; + print STDERR "\nThis is an interactive test script - input and output must be a tty\nExiting now.\n"; + exit; } if ($ENV{AUTOMATED_TESTING}) { - print STDERR "\nNo tests available for AUTOMATED_TESTING - Exiting now.\n"; - exit; + print STDERR "\nNo tests available for AUTOMATED_TESTING - Exiting now.\n"; + exit; } +## +## Query "kind" parameter: user (=0) or group (=1) quota +## +my $quota_kind = 0; +while (1) { + print "\nQuery user [u] or group [g] quota? (default: user)? "; + if (<STDIN> =~ /^([ug]?)\s*$/) { + $quota_kind = 1 if ($1 eq "g"); + last; + } + warn "invalid response (not 'u' or 'g'), please try again\n"; +} + + +## +## Query "path" parameter and derive (pseudo) device +## +my $n_uid_gid= ($quota_kind ? "GID" : "UID"); # for use in print output +my ($dev, $path); + while(1) { print "\nEnter path to get quota for (NFS possible; default '.'): "; chomp($path = <STDIN>); @@ -47,16 +69,16 @@ while(1) { redo if !$dev; print "Using device/argument \"$dev\"\n"; -## -## Check if quotas are present on this filesystem -## + ## + ## 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 "Quota::sync: ".Quota::strerr()."\n"; warn "Choose another file system - quotas not functional on this one\n"; } else { @@ -66,11 +88,14 @@ while(1) { } ## -## call with one argument (uid defaults to getuid() +## Query with one argument (uid defaults to getuid(), "kind" to 0 = user) ## -print "\nQuery this fs with default uid (which is real uid) $>\n"; -($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev); +my $uid_val = ($quota_kind ? $) : $>); +print "\nQuery this fs with default (which is real $n_uid_gid) $>\n"; +my ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = ($quota_kind + ? Quota::query($dev,$uid_val,$quota_kind) + : 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; @@ -80,63 +105,70 @@ if(defined($bc)) { 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"; + warn "Quota::query($dev): ".Quota::strerr()."\n\n"; } ## -## call with two arguments +## Query 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"; + print "Enter a $n_uid_gid to get quota for: "; + chomp($uid_val = <STDIN>); + unless($uid_val =~ /^\d+$/) { + print "You have to enter a decimal 32-bit value here.\n"; redo; } } -($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev, $uid); +($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev, $uid_val, $quota_kind); 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"; + print "Usage and limits for $n_uid_gid $uid_val are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n"; } else { - warn "Quota::query($dev,$uid): ",Quota::strerr,"\n\n"; + warn "Quota::query($dev,$uid_val,$quota_kind): ".Quota::strerr()."\n\n"; } ## -## get quotas via RPC +## Query quotas via RPC ## if($dev =~ m#^/#) { - print "Query localhost via RPC.\n"; + print "Query localhost:$path via RPC.\n"; - ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path); + ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = ($quota_kind + ? Quota::rpcquery('localhost', $path, $uid_val, $quota_kind) + : 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"; + print "Your usage and limits are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n"; } else { - warn Quota::strerr,"\n\n"; + warn Quota::strerr()."\n\n"; } - print "Query localhost via RPC for $uid.\n"; + print "Query localhost via RPC for $n_uid_gid $uid_val.\n"; - ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid); + ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid_val, $quota_kind); 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(); + warn "Failed RPC query: ".Quota::strerr()."\n\n"; + print "Retrying with fake authentication for $n_uid_gid $uid_val.\n"; + if ($quota_kind == 1) { + Quota::rpcauth(-1, $uid_val); # GID + } + else { + Quota::rpcauth($uid_val); + } + ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid_val, $quota_kind); + Quota::rpcauth(); # reset to default } if(defined($bc)) { @@ -145,10 +177,10 @@ if($dev =~ m#^/#) { ($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"; + print "Usage and limits for $n_uid_gid $uid_val are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n"; } else { - warn Quota::strerr,"\n\n"; + warn "Failed RPC query: ".Quota::strerr()."\n\n"; } } @@ -157,22 +189,37 @@ else { } ## -## set quota block & file limits for user +## Set quota limits for a local path ## -print "Enter path to set quota (empty to skip): "; -chomp($path = <STDIN>); +while(1) { + print "Enter path to set quota (empty to skip): "; + chomp($path = <STDIN>); + last unless $path; -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"; + $dev = Quota::getqcarg($path); + warn "Heads-up: Trying to set quota for remote path will fail\n" if $dev && ($dev =~ m#^[^/]+:#); + last if $dev; + warn "$path: mount point not found\n"; +} + +if($path) { + my @lim; + while(1) { + print "Enter new quota limits bs,bh,fs,fh for $n_uid_gid $uid_val (empty to abort): "; + my $in = <STDIN>; + last unless $in =~ /\S/; + @lim = ($in =~ /^\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*$/); + last if scalar(@lim) == 4; + warn "Invalid parameters: expect 4 comma-separated numerical values\n"; + @lim=(); + } + if(@lim) { + unless(Quota::setqlim($dev, $uid_val, @lim, 1, $quota_kind)) { + print "Quota set successfully for $n_uid_gid $uid_val\n"; } else { - warn Quota::strerr,"\n"; + warn "Failed to set quota: ".Quota::strerr()."\n"; } } } @@ -181,7 +228,6 @@ if($path =~ /\S/) { ## Force immediate update on disk ## -if($dev !~ m#^[^/]+:#) { - Quota::sync($dev) && ($! != 1) && die "Quota::sync: ".Quota::strerr."\n"; +if($dev && ($dev !~ m#^[^/]+:#)) { + Quota::sync($dev) && ($! != 1) && die "Quota::sync: ".Quota::strerr()."\n"; } - |