New upstream version 1.8.1+dfsg

1 files changed, 187 insertions, 81 deletions

diff --git a/test.pl b/test.pl
index f242acc..beabc3f 100755
--- a/test.pl
+++ b/test.pl
@@ -1,11 +1,27 @@
 #!../../../perl
 # ------------------------------------------------------------------------ #
-# Interactive test and demo script for the Perl Quota extension module
+# Interactive test and smoke test for the Perl Quota extension module
+#
+# This script contains a number of tests that allow exercising most of
+# the functionality provided by the Quota module. However these are not
+# unit-tests per-se, because firstly, the module functionality depends
+# entirely on the environment (i.e. which file-systems are present, is
+# quota even enabled on any of these, which users/groups do have quota
+# limits set etc.) - so we cannot determine automatically which results
+# are correct; secondly, a large portion of the interface can only be
+# used in a meaningful way when run by a user with admin capabilities.
+#
+# Therefore the main test is interactive, which means it will ask you
+# for parameters and require you checking results manually. When
+# environment variable AUTOMATED_TESTING is set this script will run
+# a short smoke test, trying quota operations on all mounted file
+# systems; however results cannot be verified, so basically the only
+# way to fail that test is a crash in the C code.
 #
 # Author: T. Zoerner 1995-2020
 #
-# This program (test.pl) is in the public domain and can be used and
-# redistributed without restrictions.
+# This program 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
@@ -17,15 +33,128 @@ use warnings;
 use strict;
 use Quota;
 
+my $my_uid = $>;
+(my $my_gid = $)) =~ s/ .*//;  # $) may be a list of GIDs
+
+# ----------------------------------------------------------------------------
+
+if ($ENV{AUTOMATED_TESTING}) {
+  smoke_test();
+  exit(0);
+}
 if (! -t STDIN || ! -t STDOUT) {
   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;
+
+# ----------------------------------------------------------------------------
+#
+# Helper function for printing quota query result
+#
+sub print_quota_result
+{
+  my ($desc, $bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = @_;
+
+  if (defined $bc) {
+    if ($bt) {
+      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;
+    }
+    if ($ft) {
+      my($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 "$desc $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n";
+  }
+  else {
+    print "Query failed: ". Quota::strerr() ."\n";
+  }
 }
 
+# ----------------------------------------------------------------------------
+# Smoke-test for automated testing:
+# - iterate across mount table
+# - for each entry try to get quota device parameter
+# - when available, try sync and query UID twice, GID once
+# - note setqlim is omitted intentionally (usually will fail as no sane
+#   automation would run as root, but if so quotas would be corrupted)
+# - test may fail only upon crash or mismatch in repeated UID query;
+#   cannot verify failures or query results otherwise
+# - tester should manually compare output with that of "quota -v"
+
+sub smoke_test
+{
+  print "OS: ". `uname -rs` ."\n";
+  print "Quota arg type: ". Quota::getqcargtype() ."\n\n";
+
+  print "------------------------------------------------------------------\n".
+        "Output of quota -v:\n".
+        `quota -v`.
+        "------------------------------------------------------------------\n".
+        "Output of quota -v -g $my_gid:\n".
+        `quota -v -g $my_gid`.
+        "------------------------------------------------------------------\n";
+
+  my @Mtab;
+  if(!Quota::setmntent()) {
+    while(my @ent = Quota::getmntent())
+    {
+      push @Mtab, \@ent;
+    }
+  }
+  Quota::endmntent();
+
+  foreach my $ent (@Mtab)
+  {
+    my ($fsname,$path,$fstyp,$fsopt) = @$ent;
+
+    print "$path:\n- fsname/typ: $fsname, $fstyp\n- options: $fsopt\n";
+
+    my $dev = Quota::getdev($path);
+    $dev = "UNDEF" unless defined $dev;
+    print "- Quota::getdev: $dev\n";
+
+    my $qcarg = Quota::getqcarg($path);
+    if ($qcarg) {
+      print "- Quota::getqcarg: $qcarg\n";
+
+      if (Quota::sync($qcarg) == 0) {
+        print "- Quota::sync: OK\n";
+      } else {
+        print "- Quota::sync failed: ". Quota::strerr() ."\n";
+      }
+
+      my @qtup = Quota::query($qcarg);
+      if (@qtup) {
+        print "- Quota::query default (EUID): ".join(", ", @qtup)."\n";
+
+        my @qtup2 = Quota::query($qcarg, $my_uid, 0);
+        if (@qtup2) {
+          print "- Quota::query UID $my_uid: ".join(", ", @qtup2)."\n";
+          die "ERROR: mismatching query results\n" if "@qtup" ne "@qtup2";
+        } else {
+          print "- Quota::query UID $my_uid failed: ". Quota::strerr() ."\n";
+          die "ERROR: repeated query failed\n";
+        }
+      } else {
+        print "- Quota::query UID failed: ". Quota::strerr() ."\n";
+      }
+
+      @qtup = Quota::query($qcarg, $my_gid, 1);
+      if (@qtup) {
+        print "- Quota::query GID $my_gid: ".join(", ", @qtup)."\n";
+      } else {
+        print "- Quota::query GID $my_gid failed: ". Quota::strerr() ."\n";
+      }
+    } else {
+      print "- Quota::getqcarg: UNDEF\n";
+    }
+    print "\n";
+  }
+}
+
+# ----------------------------------------------------------------------------
 ##
 ##  Query "kind" parameter: user (=0) or group (=1) quota
 ##
@@ -38,12 +167,13 @@ while (1) {
   }
   warn "invalid response (not 'u' or 'g'), please try again\n";
 }
+my $n_uid_gid= ($quota_kind ? "GID" : "UID");  # for use in print output
 
 
+# ----------------------------------------------------------------------------
 ##
 ##  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) {
@@ -87,114 +217,89 @@ while(1) {
   }
 }
 
+# ----------------------------------------------------------------------------
 ##
 ##  Query with one argument (uid defaults to getuid(), "kind" to 0 = user)
 ##
 
-my $my_uid = $>;
-(my $my_gid = $)) =~ s/ .*//;  # $) may be a list of GIDs
-
 my $uid_val = ($quota_kind ? $my_gid : $my_uid);
 print "\nQuerying this fs with default (which is real $n_uid_gid) $uid_val\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;
-  ($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";
-}
+my @qtup = ($quota_kind ? Quota::query($dev,$uid_val,$quota_kind)
+                        : Quota::query($dev));
+print_quota_result("Your usage and limits are: ", @qtup);
 
 ##
 ##  Query with two arguments
 ##
 
 {
-  print "Enter a different $n_uid_gid to query quota for: ";
+  print "\nEnter a different $n_uid_gid to query quota for: ";
   chomp($uid_val = <STDIN>);
   unless($uid_val =~ /^\d+$/) {
     print "You have to enter a decimal 32-bit value here.\n";
     redo;
   }
 }
+print "Querying this fs for $n_uid_gid $uid_val\n";
+@qtup = Quota::query($dev, $uid_val, $quota_kind);
+print_quota_result("Usage and limits for $n_uid_gid $uid_val are:", @qtup);
 
-($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 $n_uid_gid $uid_val are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
-}
-else {
-  warn "Quota::query($dev,$uid_val,$quota_kind): ".Quota::strerr()."\n\n";
-}
-
+# ----------------------------------------------------------------------------
 ##
-##  Query quotas via RPC
+##  Query quotas via forced RPC
 ##
+my $remhost = 'localhost';
 if ($dev =~ m#^([^:]+):(/.*)$#) {
     # path is already mounted via NFS: get server-side mount point to avoid recursion
+    $remhost = $1;
     $path = $2;
 }
-print "Querying your quota from localhost:$path via forced RPC\n";
-
-($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = ($quota_kind
-                                       ? Quota::rpcquery('localhost', $path, $my_uid, $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";
-}
-else {
-  warn "Failed to query localhost: ". Quota::strerr(). "\n\n";
+print "\nEnter host:path for querying via forced RPC (default $remhost:$path)\n";
+while (1) {
+    print "Enter host:path, empty for default, or \":\" to skip: ";
+    chomp(my $hap = <STDIN>);
+    last unless $hap;  # use default
+    if (($hap eq ":") || ($hap eq ".")) {  # skip
+        $remhost = "";
+        last;
+    }
+    if ($hap =~ m#^([^:]+):(/.*)$#) {
+        $remhost = $1;
+        $path = $2;
+        last;
+    }
+    print "Invalid input: not in format \"host:/path\"\n";
 }
+if ($remhost) {
+  @qtup = ($quota_kind ? Quota::rpcquery($remhost, $path, $my_uid, $quota_kind)
+                       : Quota::rpcquery($remhost, $path));
+  print_quota_result("Your usage and limits are:", @qtup);
 
-print "Querying $n_uid_gid $uid_val from localhost:$path via RPC\n";
-
-($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid_val, $quota_kind);
-if(!defined($bc)) {
-  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);
+  print "Querying $n_uid_gid $uid_val from $remhost:$path via RPC\n";
+  @qtup = Quota::rpcquery($remhost, $path, $uid_val, $quota_kind);
+  if(!@qtup) {
+    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);
+    }
+    @qtup = Quota::rpcquery($remhost, $path, $uid_val, $quota_kind);
   }
-  ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::rpcquery('localhost', $path, $uid_val, $quota_kind);
-  Quota::rpcauth();  # reset to default
-}
+  print_quota_result("Usage and limits for $n_uid_gid $uid_val are:", @qtup);
 
-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 $n_uid_gid $uid_val are $bc ($bs,$bh,$bt) $fc ($fs,$fh,$ft)\n\n";
-}
-else {
-  warn "Failed RPC query: ".Quota::strerr()."\n\n";
+  Quota::rpcauth();  # reset to default (must be after strerr output)
 }
 
+# ----------------------------------------------------------------------------
 ##
 ##  Set quota limits for a local path
 ##
 
 while(1) {
-  print "Enter path to set quota (empty to skip): ";
+  print "\nEnter path to set quota (empty to skip): ";
   chomp($path = <STDIN>);
   last unless $path;
 
@@ -220,14 +325,14 @@ if($path) {
       print "Quota set successfully for $n_uid_gid $uid_val\n";
 
       print "Reading back modified limits\n";
-      ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev, $uid_val, $quota_kind);
+      my ($bc,$bs,$bh,$bt,$fc,$fs,$fh,$ft) = Quota::query($dev, $uid_val, $quota_kind);
       if(defined($bc)) {
         if (($bs == $lim[0]) && ($bh == $lim[1]) &&
             ($fs == $lim[2]) && ($fh == $lim[3])) {
           print "OK: results match\n";
         }
         else {
-          print "ERROR: results do not match\n";
+          print "ERROR: results do not match: $bs, $bh, $fs, $fh\n";
         }
       }
       else {
@@ -240,6 +345,7 @@ if($path) {
   }
 }
 
+# ----------------------------------------------------------------------------
 ##
 ##  Force immediate update on disk
 ##