<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/usr/bin/perl

# A Perl wrapper for setquota utility which updates LDAP accordingly.

# /etc/fstab: usrquota,grpquota
# mount -o remount /f/s
# touch /f/s/aquota.{user,group}
# chmod 600 /f/s/aquota.{user,group}
# quotacheck -cguvamf

use strict;
use warnings;
use Net::LDAP;
use Net::LDAP::Entry;
use Getopt::Long;
Getopt::Long::Configure ("bundling");

my $help = $#ARGV &gt;= 0 ? 0 : 1;
my $ldaphost = 'localhost';
my $passwordfile = '';
my $password = '';
my $binddn = $ENV{BINDDN};
my $basedn = $ENV{BASEDN};
my $oc = 'systemQuotas';
my $attr = 'quota';
my %Q = ();
my $F = 'cn=*';
GetOptions(
        'help|?' =&gt; \$help,
        'oc|o=s' =&gt; \$oc,
        'attr|a=s' =&gt; \$attr,
        'quota|Q=s' =&gt; \%Q,
        'filter|F=s' =&gt; \$F,
        'ldaphost|h=s' =&gt; \$ldaphost,
        'basedn|b=s' =&gt; \$basedn,
        'binddn|D=s' =&gt; \$binddn,
        'password|w=s' =&gt; \$password,
        'passwordfile|W=s' =&gt; \$passwordfile,
);
die "Usage: $0 -b basedn [-o objectClass] [-a attr] [-F '(extrafilter)'] [-Q
/f/s=sb:hb:gb:sf:hf:gf ...]\n" if $help;
%Q = checkQ(%Q);

my ($ldap, $bind);
if ( $ldap = Net::LDAP-&gt;new($ldaphost, version =&gt; 3, timeout =&gt; 3) ) {
        if ( $binddn &amp;&amp; $password ) {
                $bind = $ldap-&gt;bind($binddn, password=&gt;$password);
        } elsif ( $binddn &amp;&amp; $passwordfile ){
                $bind = $ldap-&gt;bind($binddn, password=&gt;bindpw($passwordfile));
        } else {
                $bind = $ldap-&gt;bind();
        }
        die "Unable to connect to LDAP\n" if $bind-&gt;code;
        undef $passwordfile;
} else {
        die "Unable to connect to LDAP\n";
}

my $search = $ARGV[0] ? $ldap-&gt;search(base=&gt;$basedn, filter=&gt;"uid=$ARGV[0]") : $ldap-&gt;search(base=&gt;$basedn, filter=&gt;$F);
if ( $search-&gt;code ) {
        die "LDAP Error: ", error($search), "\n";
} elsif ( $search-&gt;count &lt;= 0 ) {
        die "0 results found in LDAP\n";
} else {
        my $i = 0;
        for ( $i=0; $i&lt;$search-&gt;count; $i++ ) {
                my $entry = $search-&gt;entry($i);
                my @oc = $entry-&gt;get_value('objectClass');
                # objectClass: $oc
                unless ( grep { /^$oc$/ } @oc ) {
                        my $modify = $ldap-&gt;modify($entry-&gt;dn, add =&gt; {objectClass =&gt; $oc});
                        if ( $modify-&gt;code ) {
                                print STDERR "Failed to add objectClass $oc:", error($modify), "\n";
                        }
                }
                # $attr: /f/s=sb:hb:sf:hf
                if ( $entry-&gt;exists($attr) ) {
                        my @attr = $entry-&gt;get_value($attr);
                        if ( keys %Q ) {
                                foreach my $fs ( keys %Q ) {
                                        foreach ( @attr ) {
                                                next unless /^$fs=/;
                                                my $modify = $ldap-&gt;modify($entry-&gt;dn, delete =&gt; {$attr =&gt; "$_"});
                                                if ( $modify-&gt;code ) {
                                                        print STDERR "Failed to delete $attr: $_: ", error($modify), "\n";
                                                }
                                        }
                                        my $modify = $ldap-&gt;modify($entry-&gt;dn, add =&gt; {$attr =&gt; "$fs=$Q{$fs}"});
                                        if ( $modify-&gt;code ) {
                                                print STDERR "Failed to add $attr: $fs=$Q{$fs}: ", error($modify), "\n";
                                        } else {
                                                print STDERR "Failed to setquota: $fs=$Q{$fs}\n" if setquota($entry-&gt;get_value('uid'), $fs, $Q{$fs});
                                        }
                                }
                        } else {
                                my $modify = $ldap-&gt;modify($entry-&gt;dn, delete =&gt; [($attr)]);
                                if ( $modify-&gt;code ) {
                                        print STDERR "Failed to delete $attr: ", error($modify), "\n";
                                } else {
                                        foreach ( @attr ) {
                                                my ($fs) = m!^(/[^=]*)!;
                                                $Q{$fs} = '0:0:0:0:0:0';
                                                print STDERR "Failed to setquota: $fs=$Q{$fs}\n" if setquota($entry-&gt;get_value('uid'), $fs, $Q{$fs});
                                        }
                                }
                        }
                } else {
                        if ( keys %Q ) {
                                foreach my $fs ( keys %Q ) {
                                        my $modify = $ldap-&gt;modify($entry-&gt;dn, add =&gt; {$attr =&gt; "$fs=$Q{$fs}"});
                                        if ( $modify-&gt;code ) {
                                                print STDERR "Failed to add $attr: $fs=$Q{$fs}: ", error($modify), "\n";
                                        } else {
                                                print STDERR "Failed to setquota: $fs=$Q{$fs}\n" if setquota($entry-&gt;get_value('uid'), $fs, $Q{$fs});
                                        }
                                }
                        }
                }
        }
}

sub setquota {
        $_[2] = '0:0:0:0:0:0' unless $_[2];
        $_[2] =~ /^(\d+):(\d+):(\d+):(\d+):(\d+):(\d+)$/;
        qx{/usr/sbin/setquota -u $_[0] $1 $2 $4 $5 $_[1]};
        qx{/usr/sbin/setquota -T -u $_[0] $3 $6 $_[1]};
        return 0;
}

sub checkQ {
        my (%Q) = @_;
        foreach ( keys %Q ) {
                die "$_: invalid format\n" unless m!^(/[^=]*)! &amp;&amp; $Q{$_} =~ /^(\d+):(\d+):(\d+):(\d+):(\d+):(\d+)$/;
        }
        return %Q;
}

sub bindpw {
        my ($passwordfile) = @_;
        open P, $passwordfile or die "Can't open passwordfile: $!";
        chomp(my $password = &lt;P&gt;);
        close P;
        return $password;
}

sub error {
        return $_[0]-&gt;error, "(", $_[0]-&gt;code, ")";
}
</pre></body></html>