Current File : //usr/tmp/par-6c6566/cache-9ab9fe47781b3f807c8b3ee838b58c73318324f4/inc/lib/Quota.pm

#line 1 "Quota.pm"
# ------------------------------------------------------------------------ #
# Quota.pm - Copyright (C) 1995-2013 Tom 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.)
# For a copy of these licenses see <http://www.opensource.org/licenses/>.
#
# 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
# Perl Artistic License or GNU General Public License for more details.
# ------------------------------------------------------------------------ #

package Quota;

require Exporter;
use AutoLoader;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
@EXPORT = ();

$VERSION = '1.7.1';

bootstrap Quota;

use Carp;
use POSIX qw(:errno_h);
use strict;

##
##  Get block device for locally mounted file system
##  !! Do not use this to get the argument for the quota-functions in this
##  !! module, since not all operating systems use the device path for the
##  !! quotactl system call and e.g. Solaris doesn't even use a system call
##  !! Always use getqcarg() instead.
##

sub getdev {
  ($#_ > 0) && croak("Usage: Quota::getdev(path)");
  my($target) = (($#_ == -1) ? "." : $_[0]);
  my($dev) = (stat($target))[0];
  my($ret) = undef;
  my($fsname,$path);
 
  if($dev && ($target ne "") && !Quota::setmntent()) {
    while(($fsname,$path) = Quota::getmntent()) {
      ($ret=$fsname, last) if ($dev == (stat($path))[0]);
    }
    $! = 0;
  }
  Quota::endmntent();
  $ret;
}

##
##  Get "device" argument for this module's Quota-functions
##

sub getqcarg {
  ($#_ > 0) && croak("Usage: Quota::getqcarg(path)");
  my($target) = (($#_ == -1) ? "." : $_[0]);
  my($dev) = (stat($target))[0];
  my($ret) = undef;
  my($argtyp,$fsupp) = (Quota::getqcargtype() =~ /([^,]*)(,.*)?/);
  my($fsname,$path,$fstyp,$fsopt);

  if(defined($dev) && ($target ne "") && !Quota::setmntent()) {
    while(($fsname,$path,$fstyp,$fsopt) = Quota::getmntent()) {
      next if $fstyp =~ /^(lofs|ignore|auto.*|proc|rootfs)$/;
      my($pdev) = (stat($path))[0];
      if (defined($pdev) && ($dev == $pdev)) {
        if ($fsname =~ m|^[^/]+:/|) {
          $ret = $fsname;  #NFS host:/path
        } elsif (($fstyp =~ /^nfs/i) && ($fsname =~ m#^(/.*)\@([^/]+)$#)) {
          $ret = "$2:$1";  #NFS /path@host
        } elsif ($argtyp eq "dev") {
          if ($fsopt =~ m#(^|,)loop=(/dev/[^,]+)#) {
            $ret = $2;  # Linux mount -o loop
          } else {
            $ret = $fsname;
          }
        } elsif ($argtyp eq "qfile") {
          $ret = "$path/quotas";
        } elsif ($argtyp eq "any") {
          $ret = $target;
        } else { #($argtyp eq "mntpt")
          $ret = $path;
        }

        # XFS, VxFS and AFS quotas require separate access methods
        # (optional for VxFS: later versions use 'normal' quota interface)
        if   (($fstyp eq "xfs") && ($fsupp =~ /,XFS/)) { $ret = "(XFS)$ret" }
        elsif(($fstyp eq "vxfs") &&
              defined($fsupp) && ($fsupp =~ /,VXFS/)) { $ret = "(VXFS)$ret" }
        elsif((($fstyp eq "afs") || ($fsname eq "AFS")) &&
              ($fsupp =~ /,AFS/)) { $ret = "(AFS)$target"; }
        if   (($fstyp eq "jfs2") && ($fsupp =~ /,JFS2/)) { $ret = "(JFS2)$ret" }
        last;
      }
    }
    $! = 0;
  }
  Quota::endmntent();
  $ret;
}

##
##  Translate error codes of quotactl syscall and ioctl
##

sub strerr {
  ($#_ != -1) && croak("Usage: Quota::strerr()");
  my($str);

  eval {
    if(($! == &EINVAL) || ($! == &ENOTTY) || ($! == &ENOENT) || ($! == ENOSYS))
                         { $str = "No quotas on this system" }
    elsif($! == &ENODEV) { $str = "Not a standard file system" }
    elsif($! == &EPERM)  { $str = "Not privileged" }
    elsif($! == &EACCES) { $str = "Access denied" }
    elsif($! == &ESRCH)  { $str = "No quota for this user" }
    elsif($! == &EUSERS) { $str = "Quota table overflow" }
    else { die "unknown quota error\n" }
  };
  if($@) {
    my($err) = $! + 0;
    $str = "error #$err";
  };
  $str;
}

package Quota; # return to package Quota so AutoSplit is happy
1;
__END__

#line 403